diff --git a/src/analysis/expansion.lisp b/src/analysis/expansion.lisp index 4635597e..095a60d0 100644 --- a/src/analysis/expansion.lisp +++ b/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)) diff --git a/src/ast.lisp b/src/ast.lisp index 93b086e7..59df4c15 100644 --- a/src/ast.lisp +++ b/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/~}" diff --git a/src/cl-quil.lisp b/src/cl-quil.lisp index 7f4c3c79..ec53d256 100644 --- a/src/cl-quil.lisp +++ b/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 diff --git a/src/parser.lisp b/src/parser.lisp index 82402b39..729fcc60 100644 --- a/src/parser.lisp +++ b/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 "(?{{IDENT}})\\[(?{{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