Add: CALL instruction

src/analysis/expansion.lisp

@@ -283,6 +283,9 @@ An instruction is unitary if it is of type APPLICATION, whether that be INSTR it
   (:method ((instr pragma) param-value arg-value)
     instr)
 
+  (:method ((instr call) param-value arg-value)
+    instr)
+
   (:method ((instr unary-classical-instruction) param-value arg-value)
     (let ((addr (classical-target instr)))
       (if (not (is-formal addr))

src/ast.lisp

@@ -1122,6 +1122,22 @@ Each addressing mode will be a vector of symbols:
   (bit real    real)
   (bit real    immediate))
 
+
+(defclass call (classical-instruction)
+  ((extern
+    :initarg :extern
+    :reader call-extern)
+   (arguments
+    :initarg :arguments
+    :reader call-arguments)))
+
+(defmethod mnemonic ((call call))
+  (declare (ignore call))
+  (values "CALL" 'call))
+
+(defmethod arguments ((call call))
+  (map 'vector #'identity (cons (call-extern call) (call-arguments call))))
+
 (defclass jump (instruction)
   ((label :initarg :label
           :accessor jump-label))
@@ -1672,6 +1688,11 @@ For example,
   (:method ((instr extern) (stream stream))
     (format stream "EXTERN ~A" (extern-name instr)))
 
+  (:method ((instr call) (stream stream))
+    (format stream "CALL ~A ~{~/cl-quil:instruction-fmt/~^ ~}"
+            (extern-name (call-extern instr))
+            (call-arguments instr)))
+
   (:method ((instr application) (stream stream))
     (print-operator-description (application-operator instr) stream)
     (format stream "~@[(~{~/cl-quil:instruction-fmt/~^, ~})~]~{ ~/cl-quil:instruction-fmt/~}"

src/cl-quil.lisp

@@ -147,8 +147,7 @@ This also signals ambiguous definitions, which may be handled as needed."
                                         ambiguous-definition-handler)))
     (let ((*current-file* originating-file)
           (*parser-extensions* parser-extensions)
-          (*lexer-extensions* lexer-extensions)
-          (*names-declared-extern* +builtin-externs+))
+          (*lexer-extensions* lexer-extensions))
       (let* ((raw-quil (parse-quil-into-raw-program string))
              (pp (resolve-objects
                   (funcall build-parsed-program
@@ -224,6 +223,7 @@ In the presence of multiple definitions with a common signature, a signal is rai
   "Parse a string STRING into a list of raw Quil syntax objects."
   (check-type string string)
   (let* ((*memory-region-names* nil)
+         (*names-declared-extern* +builtin-externs+)
          (tok-lines (tokenize string)))
     (loop :with parsed-program := nil
           :until (endp tok-lines) :do

src/parser.lisp

@@ -37,7 +37,7 @@
     :NEG :NOT :AND :IOR :XOR :MOVE :EXCHANGE :CONVERT :ADD :SUB :MUL :DIV
     :LOAD :STORE :EQ :GT :GE :LT :LE :DEFGATE :DEFCIRCUIT :RESET
     :HALT :WAIT :LABEL :NOP :CONTROLLED :DAGGER :FORKED
-    :DECLARE :SHARING :OFFSET :PRAGMA :STUB :EXTERN
+    :DECLARE :SHARING :OFFSET :PRAGMA :STUB :EXTERN :CALL
     :AS :MATRIX :PERMUTATION :PAULI-SUM :SEQUENCE))
 
 (deftype token-type ()
@@ -148,7 +148,7 @@ Each lexer extension is a function mapping strings to tokens. They are used to h
    (return (tok ':CONTROLLED)))
   ((eager #.(string #\OCR_FORK))
    (return (tok ':FORKED)))
-  ("INCLUDE|DEFCIRCUIT|DEFGATE|MEASURE|LABEL|WAIT|NOP|HALT|RESET|JUMP\\-WHEN|JUMP\\-UNLESS|JUMP|PRAGMA|NOT|AND|IOR|MOVE|EXCHANGE|SHARING|DECLARE|OFFSET|XOR|NEG|LOAD|STORE|CONVERT|ADD|SUB|MUL|DIV|EQ|GT|GE|LT|LE|CONTROLLED|DAGGER|FORKED|AS|MATRIX|PERMUTATION|PAULI-SUM|SEQUENCE|STUB|EXTERN"
+  ("INCLUDE|DEFCIRCUIT|DEFGATE|MEASURE|LABEL|WAIT|NOP|HALT|RESET|JUMP\\-WHEN|JUMP\\-UNLESS|JUMP|PRAGMA|NOT|AND|IOR|MOVE|EXCHANGE|SHARING|DECLARE|OFFSET|XOR|NEG|LOAD|STORE|CONVERT|ADD|SUB|MUL|DIV|EQ|GT|GE|LT|LE|CONTROLLED|DAGGER|FORKED|AS|MATRIX|PERMUTATION|PAULI-SUM|SEQUENCE|STUB|EXTERN|CALL"
    (return (tok (intern $@ :keyword))))
   ((eager "(?<NAME>{{IDENT}})\\[(?<OFFSET>{{INT}})\\]")
    (assert (not (null $NAME)))
@@ -431,14 +431,18 @@ If the parser does not match, then it should return NIL.")
        (let ((*formal-arguments-allowed* t))
          (parse-memory-descriptor tok-lines)))
 
-      ;; Stub Statement
+      ;; STUB DECLARATION
       ((:STUB)
        (parse-stub tok-lines))
 
-      ;; Extern Declaration
+      ;; EXTERN DECLARATION
       ((:EXTERN)
        (parse-extern tok-lines))
 
+      ;; CALL INSTRUCTION
+      ((:CALL)
+       (parse-call tok-lines))
+
       ;; Pragma
       ((:PRAGMA)
        (parse-pragma tok-lines))
@@ -751,12 +755,6 @@ in an arithmetic expression when parsing.  A simple boolean.")
 (setf (documentation '*memory-region-names* 'variable)
       "A special variable to collect the names of declared memory regions.")
 
-(defvar *names-declared-extern*)
-(setf (documentation '*names-declared-extern* 'variable)
-      "A special variable that collects the names of functions declared
-extern so that they can be recognized as valid function names during
-expression and CALL application parsing.")
-
 (defvar *shadowing-formals* nil
   "A special variable which indicates formal parameters (as a list of
 FORMAL objects) which shadow memory names.")
@@ -838,20 +836,61 @@ FORMAL objects) which shadow memory names.")
             (t
              (quil-parse-error "Formal parameters found in a place they're not allowed.")))))))
 
+(defun parse-call (tok-lines)
+  "Parse a CALL instruction"
+  (match-line ((instr :CALL) (func :NAME) &rest rest-toks) tok-lines
+    (let ((fname (token-payload func)))
+     (unless (declared-extern-p fname)
+       (quil-parse-error "Cannot call unknown extern ~s" fname))
+      (unless rest-toks
+        (quil-parse-error "Called externs require at least one argument."))
+      (make-instance 'call
+        :extern (make-instance 'extern :name fname)
+        :arguments (parse-extern-arguments rest-toks)))))
+
+(defun check-memory-region-name (name &key (ensure-valid t))
+  (when (and ensure-valid
+             (not (find name *memory-region-names* :test #'string=)))
+       (quil-parse-error "Bad memory region name \"~A\"~@[ in ~A~]. This is probably due to either:
+    * a missing DECLARE for this memory,
+    * a misspelling of the memory reference, or
+    * a misspelling of the DECLAREd memory."
+                         name
+                         *parse-context*)))
+
+(defun parse-extern-arguments (toks)
+  (flet ((parse-extern-arg (tok)
+           (with-slots (type payload) tok 
+             (case type
+               ((:NAME)
+                (check-memory-region-name payload)
+                (mref payload 0))
+               ((:COMPLEX)
+                payload)
+               ((:INTEGER)
+                (constant payload quil-integer))
+               ((:AREF)
+                (check-memory-region-name (car payload))
+                (mref (car payload) (cdr payload)))
+               (otherwise
+                (disappointing-token-error tok "an extern argument"))))))
+    (mapcar #'parse-extern-arg toks)))
+
+
 (defun parse-application (tok-lines)
   "Parse a gate or circuit application out of the lines of tokens TOK-LINES, returning an UNRESOLVED-APPLICATION."
   (match-line ((op :NAME) &rest rest-toks) tok-lines
     (if (endp rest-toks)
         (make-instance 'unresolved-application
-                       :operator (named-operator (token-payload op)))
+          :operator (named-operator (token-payload op)))
         (multiple-value-bind (params args)
             (parse-parameters rest-toks :allow-expressions t)
 
           ;; Parse out the rest of the arguments and return.
           (make-instance 'unresolved-application
-                         :operator (named-operator (token-payload op))
-                         :parameters params
-                         :arguments (mapcar #'parse-argument args))))))
+            :operator (named-operator (token-payload op))
+            :parameters params
+            :arguments (mapcar #'parse-argument args))))))
 
 (defun parse-measurement (tok-lines)
   "Parse a measurement out of the lines of tokens TOK-LINES."
@@ -1650,6 +1689,11 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a
                   (token-payload tok))))))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *names-declared-extern*)
+  (setf (documentation '*names-declared-extern* 'variable)
+        "A special variable that collects the names of functions declared
+extern so that they can be recognized as valid function names during
+expression and CALL application parsing.")
 
 
   (defvar *quil<->lisp-functions* nil)
@@ -1777,9 +1821,12 @@ name a Lisp function. "
       (declare (ignore i0))
       (list head a b)))
 
+
+
+
   (defun declared-extern-p (name)
     "Checks that a function has been declared extern."
-    (find name *names-declared-extern* :test #'equal))
+    (find name *names-declared-extern* :test #'string-equal))
 
   (defun validate-function (func-name)
     "Return the lisp symbol that corresponds to the Quil function named