diff --git a/cl-quil-tests.asd b/cl-quil-tests.asd index 314b3c5f9..28ef8cd78 100644 --- a/cl-quil-tests.asd +++ b/cl-quil-tests.asd @@ -53,4 +53,5 @@ (:file "linear-reversible-circuit-tests") (:file "permutation-tests") (:file "sqisw-decomp-tests") + (:file "stub-tests") (:file "extern-tests"))) diff --git a/src/addresser/logical-schedule.lisp b/src/addresser/logical-schedule.lisp index 55de5720c..e5711c3bc 100644 --- a/src/addresser/logical-schedule.lisp +++ b/src/addresser/logical-schedule.lisp @@ -118,6 +118,13 @@ (address-resources (classical-right-operand inst)) (address-resources (classical-target inst))))) +(defmethod instruction-resources ((inst call)) + (loop :with union := (address-resources nil) + :for arg :in (cl-quil.frontend::call-arguments inst) + :when (typep arg 'memory-ref) + :do (setf union (resource-union union (address-resources arg))) + :finally (return union))) + (defmethod instruction-resources ((inst measurement)) (qubit-resources (measurement-qubit inst))) @@ -152,7 +159,8 @@ (defun local-classical-instruction-p (instr) (or (typep instr 'unary-classical-instruction) (typep instr 'binary-classical-instruction) - (typep instr 'trinary-classical-instruction))) + (typep instr 'trinary-classical-instruction) + (typep instr 'call))) (defun local-classical-quantum-instruction-p (instr) (or (typep instr 'measure))) diff --git a/src/addresser/rewiring.lisp b/src/addresser/rewiring.lisp index 43dce698b..901076a1a 100644 --- a/src/addresser/rewiring.lisp +++ b/src/addresser/rewiring.lisp @@ -190,7 +190,7 @@ Returns NIL. This mutates the instruction." :assert-wired t))) (application-arguments instr)))) - (extern-application + (stub-application (setf (application-arguments instr) (mapcar (lambda (q) (qubit (apply-rewiring-l2p rewiring (qubit-index q) :assert-wired t))) diff --git a/src/analysis/expansion.lisp b/src/analysis/expansion.lisp index 4635597e4..095a60d0a 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/analysis/resolve-objects.lisp b/src/analysis/resolve-objects.lisp index d57fc3adb..394437ee5 100644 --- a/src/analysis/resolve-objects.lisp +++ b/src/analysis/resolve-objects.lisp @@ -21,7 +21,7 @@ (let* ((operator (application-operator instr)) (addl-qubits (operator-description-additional-qubits operator)) (name (operator-description-root-name operator)) - (found-extern (gethash name (parsed-program-extern-operations parsed-program))) + (found-stub (gethash name (parsed-program-stub-operations parsed-program))) (found-gate-defn (or (find name (parsed-program-gate-definitions parsed-program) :test #'string= :key #'gate-definition-name) @@ -30,9 +30,9 @@ :test #'string= :key #'circuit-definition-name))) (cond - ;; externs take priority over defined operators - (found-extern - (change-class instr 'extern-application)) + ;; stubs take priority over defined operators + (found-stub + (change-class instr 'stub-application)) ;; Gate application (found-gate-defn diff --git a/src/analysis/type-safety.lisp b/src/analysis/type-safety.lisp index 7e2db2e57..fd660f0e6 100644 --- a/src/analysis/type-safety.lisp +++ b/src/analysis/type-safety.lisp @@ -233,6 +233,12 @@ (when (typep right-mref 'memory-ref) (enforce-mref-bounds right-mref (find-descriptor-for-mref right-mref memory-regions))))) + (:method ((instr call) memory-regions) + (loop :for arg :in (call-arguments instr) + :when (typep arg 'memory-ref) + :do (enforce-mref-bounds arg (find-descriptor-for-mref arg memory-regions)))) + + ;; NEG needs to be INT or REAL (:method ((instr classical-negate) memory-regions) (check-mref (classical-target instr)) diff --git a/src/ast.lisp b/src/ast.lisp index 7cc97b139..59df4c156 100644 --- a/src/ast.lisp +++ b/src/ast.lisp @@ -421,20 +421,27 @@ If no exit rewiring is found, return NIL." (:documentation "A directive to include another file in a Quil file.")) -(defclass extern () - ((name :reader extern-name +(defclass stub () + ((name :reader stub-name :initarg :name - :documentation "The name of the operation being marked as an EXTERN")) - (:documentation "A directive to mark a particular operation as an extern. I.e. an -operation that does not have a definition. Names marked as EXTERN can + :documentation "The name of the operation being marked as a stub")) + (:documentation "A directive to mark a particular operation as a stub. I.e. an +operation that does not have a definition. Names marked as STUB can be parsed as they appear, and are protected from the optimizing compiler, similar to the effect of a PRESERVE_BLOCK pragma. -NB: A name marked as an EXTERN will take priority over all other +NB: A name marked as a stub will take priority over all other names. Meaning if, for example, a DEFCIRCUIT is defined with name -marked as EXTERN, that circuit will be totally ignored by +marked as STUB, that circuit will be totally ignored by compilation passes.")) +(defclass extern () + ((name :reader extern-name + :initarg :name + :documentation "The name of the function.")) + (:documentation "A function that operates on classical memory and values, declared to +be available in the underlying system.")) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Gate Definitions @@ -1115,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)) @@ -1316,17 +1339,17 @@ consists of a CONTROLLED-OPERATOR acting on a NAMED-OPERATOR." * Application is a circuit application. - * Application is an extern application. + * Application is a stub application. * Application is an invalid application. Determining this requires the context of the surrounding program.")) -(defclass extern-application (application) +(defclass stub-application (application) () - (:documentation "Represents the application of an extern operation. Externs allow the user to bypass the parsing and compilation stages for particular operations that are meant to receive specific definition at the backend compilation stage. + (:documentation "Represents the application of a stub operation. Stubs allow the user to bypass the parsing and compilation stages for particular operations that are meant to receive specific definition at the backend compilation stage. -Externs are similar to instances of UNRESOLVED-APPLICATION. They are semantically empty from the perspective of the quantum abstract virtual machine, and cannot be simulated or executed.")) +Stubs are similar to instances of UNRESOLVED-APPLICATION. They are semantically empty from the perspective of the quantum abstract virtual machine, and cannot be simulated or executed.")) (declaim (inline gate-application-p)) (defun gate-application-p (x) @@ -1568,15 +1591,17 @@ For example, (cond ((eql 'mref (first expr)) (format stream "~A[~A]" (second expr) (third expr))) - ((= (length expr) 3) + ((and (= (length expr) 3) + (lisp-symbol->quil-infix-operator (first expr))) (format stream "(~A~A~A)" (print-delayed-expression (second expr) nil) (lisp-symbol->quil-infix-operator (first expr)) (print-delayed-expression (third expr) nil))) - ((= (length expr) 2) - (format stream "~A(~A)" + (t + (format stream "~A(~{~A~^,~})" (lisp-symbol->quil-function-or-prefix-operator (first expr)) - (print-delayed-expression (second expr) nil))))) + (loop :for ex :in (rest expr) + :collect (print-delayed-expression ex nil)))))) (number (format stream "(~/cl-quil:complex-fmt/)" expr)) (symbol @@ -1657,9 +1682,17 @@ For example, (format stream "MEASURE ~/cl-quil:instruction-fmt/" (measurement-qubit instr))) + (:method ((instr stub) (stream stream)) + (format stream "STUB ~A" (stub-name instr))) + (: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/~}" @@ -1766,33 +1799,46 @@ For example, ;;; simply a list of AST objects. (defclass parsed-program (transformable) - ((gate-definitions :initarg :gate-definitions - :accessor parsed-program-gate-definitions - :type list - :documentation "The gate definitions introduced by DEFGATE.") - (circuit-definitions :initarg :circuit-definitions - :accessor parsed-program-circuit-definitions - :type list - :documentation "The circuit definitions introduced by DEFCIRCUIT.") - (memory-definitions :initarg :memory-definitions - :accessor parsed-program-memory-definitions - :type list - :documentation "The memory definitions introduced by DECLARE.") - (executable-program :initarg :executable-code - :accessor parsed-program-executable-code - :type (vector instruction) - :documentation "A vector of executable Quil instructions.") - (extern-operations :initarg :extern-operations - :accessor parsed-program-extern-operations - :type hash-table - :documentation "A hash table mapping string NAMEs to generalized booleans, indicating that an operation so named is an extern.")) + ((gate-definitions + :initarg :gate-definitions + :accessor parsed-program-gate-definitions + :type list + :documentation "The gate definitions introduced by DEFGATE.") + (circuit-definitions + :initarg :circuit-definitions + :accessor parsed-program-circuit-definitions + :type list + :documentation "The circuit definitions introduced by DEFCIRCUIT.") + (memory-definitions + :initarg :memory-definitions + :accessor parsed-program-memory-definitions + :type list + :documentation "The memory definitions introduced by DECLARE.") + (executable-program + :initarg :executable-code + :accessor parsed-program-executable-code + :type (vector instruction) + :documentation "A vector of executable Quil instructions.") + (extern-declarations + :initarg :extern-declarations + :accessor parsed-program-extern-declarations + :type hash-table + :documentation "A hash table mapping string to booleans.") + (stub-operations + :initarg :stub-operations + :accessor parsed-program-stub-operations + :type hash-table + :documentation "A hash table mapping string names to booleans.")) (:default-initargs :gate-definitions '() :circuit-definitions '() :memory-definitions '() :executable-code #() - :extern-operations (make-hash-table :test #'equal)) - (:documentation "A representation of a parsed Quil program, in which instructions have been duly sorted into their various categories (e.g. definitions vs executable code), and internal references have been resolved.")) + :extern-declarations (make-hash-table :test #'equal) + :stub-operations (make-hash-table :test #'equal)) + (:documentation "A representation of a parsed Quil program, in which instructions have +been duly sorted into their various categories (e.g. definitions vs +executable code), and internal references have been resolved.")) (defmethod copy-instance ((parsed-program parsed-program)) (let ((pp (make-instance 'parsed-program))) @@ -1808,15 +1854,10 @@ For example, (setf (parsed-program-executable-code pp) (map 'vector #'copy-instance (parsed-program-executable-code parsed-program))) - (setf (parsed-program-extern-operations pp) - (let ((new-table - (make-hash-table :test #'equal)) - (old-table - (parsed-program-extern-operations parsed-program))) - (loop :for key :being :the :hash-key :of old-table - :using (:hash-value value) - :do (setf (gethash key new-table) value)) - new-table)) + (setf (parsed-program-stub-operations pp) + (a:copy-hash-table (parsed-program-stub-operations parsed-program))) + (setf (parsed-program-extern-declarations pp) + (a:copy-hash-table (parsed-program-extern-declarations parsed-program))) pp)) (defvar *print-parsed-program-text* nil diff --git a/src/cfg.lisp b/src/cfg.lisp index 7b5f3888a..81c14cd27 100644 --- a/src/cfg.lisp +++ b/src/cfg.lisp @@ -175,19 +175,19 @@ Return the following values: (vector-push-extend instr (basic-block-code blk)) (values blk nil nil)) -(defmethod process-instruction (cfg blk (instr extern-application)) +(defmethod process-instruction (cfg blk (instr stub-application)) (assert (not (null blk)) (blk)) - ;; extern applications should be preserved from nativization and optimization - (let ((extern-blk - (find-or-make-block-from-label cfg (label (princ-to-string (gensym "EXTERN-"))))) + ;; stub applications should be preserved from nativization and optimization + (let ((stub-blk + (find-or-make-block-from-label cfg (label (princ-to-string (gensym "STUB-"))))) (new-blk (make-instance 'basic-block))) - (change-class extern-blk 'preserved-block) - (vector-push-extend instr (basic-block-code extern-blk)) - (link-blocks blk (unconditional-edge extern-blk)) - (link-blocks extern-blk (unconditional-edge new-blk)) + (change-class stub-blk 'preserved-block) + (vector-push-extend instr (basic-block-code stub-blk)) + (link-blocks blk (unconditional-edge stub-blk)) + (link-blocks stub-blk (unconditional-edge new-blk)) ;; we finish with the old block, return a new empty block, and the - ;; extern is isolated in a preserved block linked between these + ;; stub is isolated in a preserved block linked between these ;; two. (values new-blk blk nil))) diff --git a/src/cl-quil.lisp b/src/cl-quil.lisp index c5868de66..5998f1c86 100644 --- a/src/cl-quil.lisp +++ b/src/cl-quil.lisp @@ -89,6 +89,7 @@ This also signals ambiguous definitions, which may be handled as needed." (circ-defs '()) (memory-defs '()) (exec-code '()) + (stubs (make-hash-table :test #'equal)) (externs (make-hash-table :test #'equal)) ;; The following maps definition signatures to a list of (filename . defn) pairs (all-seen-defns (make-hash-table :test 'equalp))) @@ -112,7 +113,9 @@ This also signals ambiguous definitions, which may be handled as needed." (gate-definition (push instr gate-defs)) (circuit-definition (push instr circ-defs)) (memory-descriptor (push instr memory-defs)) - (extern + (stub + (setf (gethash (stub-name instr) stubs) t)) + (extern (setf (gethash (extern-name instr) externs) t)) (t (push instr exec-code))))) (mapc #'bin code) @@ -120,7 +123,8 @@ This also signals ambiguous definitions, which may be handled as needed." :gate-definitions (nreverse gate-defs) :circuit-definitions (nreverse circ-defs) :memory-definitions (nreverse memory-defs) - :extern-operations externs + :stub-operations stubs + :extern-declarations externs :executable-code (coerce (nreverse exec-code) 'simple-vector))))) @@ -219,6 +223,8 @@ 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+) + (*expression-externs* +builtin-externs+) (tok-lines (tokenize string))) (loop :with parsed-program := nil :until (endp tok-lines) :do diff --git a/src/compiler-hook.lisp b/src/compiler-hook.lisp index f75a11670..06604f15b 100644 --- a/src/compiler-hook.lisp +++ b/src/compiler-hook.lisp @@ -324,11 +324,16 @@ Returns a value list: (processed-program, of type parsed-program (parsed-program-circuit-definitions parsed-program)) (setf (parsed-program-memory-definitions processed-program) (parsed-program-memory-definitions parsed-program)) - ;; retain the old extern operations table - (setf (parsed-program-extern-operations processed-program) - (parsed-program-extern-operations parsed-program)) + ;; retain the old stub operations table + (setf (parsed-program-stub-operations processed-program) + (parsed-program-stub-operations parsed-program)) ;; ... and output the results. + (setf (cl-quil.frontend::parsed-program-extern-declarations processed-program) + (cl-quil.frontend::parsed-program-extern-declarations parsed-program)) + (values processed-program topological-swaps unpreserved-duration)))))) + + diff --git a/src/package.lisp b/src/package.lisp index b985bbf76..1b7a23a2d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -400,8 +400,13 @@ #:unresolved-application ; CLASS + #:stub ; CLASS + #:stub-application ; CLASS + + #:call ; CLASS #:extern ; CLASS - #:extern-application ; CLASS + + #:register-classical-function ; FUNCTION #:gate-application ; CLASS #:gate-application-gate ; GENERIC, READER @@ -439,7 +444,8 @@ #:parsed-program-circuit-definitions ; READER #:parsed-program-memory-definitions ; READER #:parsed-program-executable-code ; ACCESSOR - #:parsed-program-extern-operations ; ACCESSOR + + #:parsed-program-stub-operations ; ACCESSOR #:print-parsed-program ; FUNCTION #:*print-parsed-program-text* ; PARAMETER diff --git a/src/parser.lisp b/src/parser.lisp index 6742203a6..9adcfc585 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 :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|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,22 @@ If the parser does not match, then it should return NIL.") (let ((*formal-arguments-allowed* t)) (parse-memory-descriptor tok-lines))) - ;; Extern Statement - ((:EXTERN) - (parse-extern tok-lines)) + ;; STUB DECLARATION + ((:STUB) + (parse-stub tok-lines)) + + ;; CALL INSTRUCTION + ((:CALL) + (parse-call tok-lines)) ;; Pragma ((:PRAGMA) (parse-pragma tok-lines)) + ;; EXTERN DECLARATION + ((:EXTERN) + (parse-extern tok-lines)) + ;; Measurement ((:MEASURE) (parse-measurement tok-lines)) @@ -734,18 +742,22 @@ If ENSURE-VALID is T (default), then a memory reference such as 'foo[0]' will re ;; Robert (& Eric) (defvar *arithmetic-parameters*) (setf (documentation '*arithmetic-parameters* 'variable) - "A special variable to detect and collect the parameters found in an arithmetic expression when parsing. An alist mapping formal parameters to generated symbols.") + "A special variable to detect and collect the parameters found in an +arithmetic expression when parsing. An alist mapping formal parameters +to generated symbols.") (defvar *segment-encountered*) (setf (documentation '*segment-encountered* 'variable) - "A special variable to detect the presence of a segment address found in an arithmetic expression when parsing. A simple boolean.") + "A special variable to detect the presence of a segment address found +in an arithmetic expression when parsing. A simple boolean.") (defvar *memory-region-names*) (setf (documentation '*memory-region-names* 'variable) "A special variable to collect the names of declared memory regions.") (defvar *shadowing-formals* nil - "A special variable which indicates formal parameters (as a list of FORMAL objects) which shadow memory names.") + "A special variable which indicates formal parameters (as a list of +FORMAL objects) which shadow memory names.") (defun gate-modifier-token-p (tok) (member (token-type tok) '(:CONTROLLED :DAGGER :FORKED))) @@ -787,9 +799,14 @@ If ENSURE-VALID is T (default), then a memory reference such as 'foo[0]' will re (application-operator app))) (return (values app rest-lines))))))) +(defun parse-stub (tok-lines) + (match-line ((stub :STUB) (op :NAME)) tok-lines + (make-instance 'stub :name (token-payload op)))) + (defun parse-extern (tok-lines) - (match-line ((extern :EXTERN) (op :NAME)) tok-lines - (make-instance 'extern :name (token-payload op)))) + (match-line ((extern :EXTERN) (fn :NAME)) tok-lines + (push (token-payload fn) *names-declared-extern*) + (make-instance 'extern :name (token-payload fn)))) (defun parse-parameter-or-expression (toks) "Parse a parameter, which may possibly be a compound arithmetic expression. Consumes all tokens given." @@ -819,20 +836,61 @@ If ENSURE-VALID is T (default), then a memory reference such as 'foo[0]' will re (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." @@ -844,25 +902,48 @@ If ENSURE-VALID is T (default), then a memory reference such as 'foo[0]' will re :qubit qubit :address (parse-memory-or-formal-token address-tok)))))) -(defun parse-pragma (tok-lines) - "Parse a PRAGMA out of the lines of tokens TOK-LINES." - (match-line ((op :PRAGMA) (word-tok :NAME) &rest word-toks) tok-lines - (multiple-value-bind (words non-words) - (take-until (lambda (tok) (not (member (token-type tok) '(:NAME :INTEGER)))) (cons word-tok word-toks)) - (setf words (mapcar #'token-payload words)) - (cond - ((null non-words) - (make-pragma words)) +(defun process-pragma-extern-signature (pragma) + "If the PRAGMA is a signature of a function that does not mutate +arguments and that has a return type, then push its name into +*EXPRESSION-EXTERNS*. Otherwise remove its name from that list." + (with-slots (extern-name value-type param-types) pragma + (cond ((and value-type (loop :for param :in param-types :never (find :mut param))) + (pushnew extern-name *expression-externs* :test #'equal)) + (t + (setf *expression-externs* (delete extern-name *expression-externs* :test #'equal)))))) - ((endp (cdr non-words)) - (let ((last-tok (first non-words))) - (unless (eql ':STRING (token-type last-tok)) - (disappointing-token-error last-tok "a terminating string")) - (make-pragma words (token-payload last-tok)))) - (t - (quil-parse-error "Unexpected tokens near the end of a PRAGMA.")))))) +(defun parse-pragma (tok-lines) + "Parse a PRAGMA out of the lines of tokens TOK-LINES." + (match-line ((op :PRAGMA) word &rest word-toks) tok-lines + (let ((first-payload + (case (token-type word) + (:EXTERN "EXTERN") + (:NAME (token-payload word)) + (otherwise + (quil-parse-error "Expected PRAGMA expected :NAME or :EXTERN token."))))) + (let ((pragma + (multiple-value-bind (words non-words) + (take-until (lambda (tok) (not (member (token-type tok) '(:NAME :INTEGER)))) word-toks) + (setf words (cons first-payload (mapcar #'token-payload words))) + (cond + ((null non-words) + (make-pragma words)) + + ((endp (cdr non-words)) + (let ((last-tok (first non-words))) + (unless (eql ':STRING (token-type last-tok)) + (disappointing-token-error last-tok "a terminating string")) + (make-pragma words (token-payload last-tok)))) + + (t + (quil-parse-error "Unexpected tokens near the end of a PRAGMA.")))))) + + (when (typep pragma 'pragma-extern-signature) + (process-pragma-extern-signature pragma)) + + pragma)))) (defun parse-include (tok-lines) "Parse an INCLUDE out of the lines of tokens TOK-LINES." @@ -1569,10 +1650,28 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a ;; Parse out the parameters. (let ((entries - (split-sequence:split-sequence-if - (lambda (tok) - (eq ':COMMA (token-type tok))) - found-params)) + ;; splitting on unnested commas + (loop + :with paren-nesting := 0 + :with collecting := nil + :with entries := nil + :for tok :in found-params + :for type := (token-type tok) + :do (cond ((eq ':RIGHT-PAREN type) + (decf paren-nesting) + (push tok collecting)) + ((eq ':LEFT-PAREN type) + (incf paren-nesting) + (push tok collecting)) + ((and (eq ':COMMA type) (zerop paren-nesting)) + (push (nreverse collecting) entries) + (setf collecting nil)) + (t + (push tok collecting))) + :finally + (when collecting + (push (nreverse collecting) entries) + (return (nreverse entries))))) (parse-op (if allow-expressions #'parse-parameter-or-expression @@ -1613,18 +1712,50 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (token-payload tok)))))) (eval-when (:compile-toplevel :load-toplevel :execute) - (a:define-constant +quil<->lisp-functions+ - '(("SIN" . cl:sin) - ("COS" . cl:cos) - ("SQRT" . cl:sqrt) - ("EXP" . cl:exp) - ("CIS" . cl:cis)) + (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 *expression-externs*) + (setf (documentation '*expression-externs* 'variable) + "Names of externs that are permitted to appear in expressions.") + + (defvar *quil<->lisp-functions* nil) + (setf (documentation '*quil<->lisp-functions* 'variable) + "An association list forming a bijection between string names of +functions and the Lisp symbol whose function value implements the +named function. The string names may may appear in both CALL +instructions and in Quil's numerical expressions.") + + (a:define-constant +builtin-externs+ + '("SIN" "COS" "SQRT" "EXP" "CIS") :test #'equal :documentation - "Functions usable from within Quil, and their associated Lisp function symbols.") + "Functions that are declared extern by default.") + + (defun register-classical-function (name symbol) + "Register a string NAME for use in Quil CALL instructions and +numerical expressions to be associated with SYMBOL, which should +name a Lisp function. " + (declare (type string name) + (type symbol symbol)) + (let ((extant (assoc name *quil<->lisp-functions* :test #'string-equal))) + (cond (extant + (setf (cdr extant) symbol)) + (t + (setf *quil<->lisp-functions* + (acons name symbol *quil<->lisp-functions*)))))) - ;;; If you add a new arithmetic operator to +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+ or - ;;; +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+, you must also add it to *ARITHMETIC-GRAMMAR*, below. + (register-classical-function "SIN" 'cl:sin) + (register-classical-function "COS" 'cl:cos) + (register-classical-function "SQRT" 'cl:sqrt) + (register-classical-function "EXP" 'cl:exp) + (register-classical-function "CIS" 'cl:cis) + +;;; If you add a new arithmetic operator to +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+ or +;;; +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+, you must also add it to *ARITHMETIC-GRAMMAR*, below. (a:define-constant +quil<->lisp-prefix-arithmetic-operators+ '(("-" . cl:-)) :test #'equal @@ -1651,38 +1782,38 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (a:when-let ((found (assoc quil-string alist :test #'string-equal))) (cdr found))) - ;;; The following functions handle conversion between Quil's arithmetic operators/functions and - ;;; the corresponding lisp symbols (fbound to lisp functions) that are used in CL-QUIL for - ;;; evaluating Quil's arithmetic expressions. The mapping from lisp->Quil and Quil->lisp is - ;;; determined by the above tables, namely: +QUIL<->LISP-FUNCTIONS+, - ;;; +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+, and +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+. - ;;; - ;;; For example, the Quil infix operator "/" in an expression like "pi/8" maps to the Common Lisp - ;;; symbol CL:/ and vice versa. Likewise for the prefix operator "-" in "-%theta" which maps to - ;;; CL:-. - ;;; - ;;; The purpose of the following functions is to provide a layer of abstraction around the - ;;; conversion to/from Quil<->lisp and to act as a single source of truth for such conversions. - ;;; - ;;; Here is a glossary of the terms used in the following function names: - ;;; - ;;; lisp-symbol: - ;;; a SYMBOL which is fbound to a lisp function appropriate for evaluating the corresponding - ;;; Quil function or arithmetic operator. - ;;; - ;;; quil-function: - ;;; a STRING that denotes a Quil arithmetic function. For example "SIN", "COS", "EXP", etc. - ;;; See the table +QUIL<->LISP-FUNCTIONS+ for the list of valid functions. - ;;; - ;;; quil-prefix-operator: - ;;; a STRING that denotes a Quil prefix (unary) arithmetic operator. For example, the "-" in - ;;; the expression "-pi/2". See the table +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+ for the - ;;; list of valid prefix operators. - ;;; - ;;; quil-infix-operator: - ;;; a STRING that denotes a Quil infix (binary) arithmetic operator. For example, the "-" in - ;;; the expression "COS(%x) - i * SIN(%x)". See +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+ for - ;;; the list of valid infix operators. +;;; The following functions handle conversion between Quil's arithmetic operators/functions and +;;; the corresponding lisp symbols (fbound to lisp functions) that are used in CL-QUIL for +;;; evaluating Quil's arithmetic expressions. The mapping from lisp->Quil and Quil->lisp is +;;; determined by the above tables, namely: *QUIL<->LISP-FUNCTIONS*, +;;; +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+, and +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+. +;;; +;;; For example, the Quil infix operator "/" in an expression like "pi/8" maps to the Common Lisp +;;; symbol CL:/ and vice versa. Likewise for the prefix operator "-" in "-%theta" which maps to +;;; CL:-. +;;; +;;; The purpose of the following functions is to provide a layer of abstraction around the +;;; conversion to/from Quil<->lisp and to act as a single source of truth for such conversions. +;;; +;;; Here is a glossary of the terms used in the following function names: +;;; +;;; lisp-symbol: +;;; a SYMBOL which is fbound to a lisp function appropriate for evaluating the corresponding +;;; Quil function or arithmetic operator. +;;; +;;; quil-function: +;;; a STRING that denotes a Quil arithmetic function. For example "SIN", "COS", "EXP", etc. +;;; See the table *QUIL<->LISP-FUNCTIONS* for the list of valid functions. +;;; +;;; quil-prefix-operator: +;;; a STRING that denotes a Quil prefix (unary) arithmetic operator. For example, the "-" in +;;; the expression "-pi/2". See the table +QUIL<->LISP-PREFIX-ARITHMETIC-OPERATORS+ for the +;;; list of valid prefix operators. +;;; +;;; quil-infix-operator: +;;; a STRING that denotes a Quil infix (binary) arithmetic operator. For example, the "-" in +;;; the expression "COS(%x) - i * SIN(%x)". See +QUIL<->LISP-INFIX-ARITHMETIC-OPERATORS+ for +;;; the list of valid infix operators. (defun lisp-symbol->quil-prefix-operator (symbol) (%lisp->quil symbol +quil<->lisp-prefix-arithmetic-operators+)) @@ -1697,10 +1828,10 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (%quil->lisp quil-infix-operator +quil<->lisp-infix-arithmetic-operators+)) (defun lisp-symbol->quil-function (symbol) - (%lisp->quil symbol +quil<->lisp-functions+)) + (%lisp->quil symbol *quil<->lisp-functions*)) (defun quil-function->lisp-symbol (quil-function) - (%quil->lisp quil-function +quil<->lisp-functions+)) + (%quil->lisp quil-function *quil<->lisp-functions*)) (defun lisp-symbol->quil-function-or-prefix-operator (symbol) (or (lisp-symbol->quil-function symbol) @@ -1716,10 +1847,29 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (declare (ignore i0)) (list head a b))) - (defun validate-function (func-name) - "Return the lisp symbol that corresponds to the Quil function named FUNC-NAME, or signal a QUIL-PARSE-ERROR if FUNC-NAME is invalid." + (defun declared-extern-p (name) + "Checks that a function has been declared extern." + (find name *names-declared-extern* :test #'string-equal)) + + (defun allowed-in-expression-p (name) + "Checks that an function name is declared extern has a known type that +is permitted to appear in extern expressions." + (and (declared-extern-p name) + (find name *expression-externs* :test #'string-equal))) + + (defun validate-expression-function (func-name) + "Return the lisp symbol that corresponds to the Quil function named + FUNC-NAME, or signal a QUIL-PARSE-ERROR if FUNC-NAME is invalid." + (unless (declared-extern-p func-name) + (error "No function called ~a has been declared." func-name)) + + (unless (allowed-in-expression-p func-name) + (error "No type has been declared for ~a. Functions appearing in expressions +must be known to return a value and to not mutate their arguments." func-name)) + (or (quil-function->lisp-symbol func-name) - (quil-parse-error "Invalid function name: ~A." func-name))) + (error "The function ~a has not been registered with the compiler, we cannot +evaluate calls to it within expressions." func-name))) (defun find-or-make-parameter-symbol (param) (let ((found (assoc (param-name param) @@ -1743,7 +1893,7 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (yacc:define-parser *arithmetic-grammar* (:start-symbol expr) - (:terminals (:LEFT-PAREN :RIGHT-PAREN + (:terminals (:LEFT-PAREN :RIGHT-PAREN :COMMA :NAME :PARAMETER :INTEGER :COMPLEX :PLUS :MINUS :TIMES :DIVIDE :EXPT :AREF)) (:precedence ((:right :EXPT) (:left :TIMES :DIVIDE) (:left :PLUS :MINUS))) @@ -1758,16 +1908,23 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a (expr :EXPT expr (binary (quil-infix-operator->lisp-symbol "^"))) term) + (expr-list + (expr :COMMA expr-list + (lambda (e i1 es) + (declare (ignore i1)) + (cons e es))) + (expr #'list)) + (term (:MINUS expr (lambda (i0 x) (declare (ignore i0)) (list (quil-prefix-operator->lisp-symbol "-") x))) - (:NAME :LEFT-PAREN expr :RIGHT-PAREN - (lambda (f i0 x i1) + (:NAME :LEFT-PAREN expr-list :RIGHT-PAREN + (lambda (f i0 xs i1) (declare (ignore i0 i1)) - (let ((f (validate-function f))) - (list f x)))) + (let ((f (validate-expression-function f))) + (cons f xs)))) (:LEFT-PAREN expr :RIGHT-PAREN (lambda (i0 x i1) (declare (ignore i0 i1)) diff --git a/src/pragmas.lisp b/src/pragmas.lisp index 790bc0d31..e57088225 100644 --- a/src/pragmas.lisp +++ b/src/pragmas.lisp @@ -138,6 +138,104 @@ Expected syntax: PRAGMA REWIRING_SEARCH [\"A*\"|\"GREEDY-QUBIT\"|\"GREEDY-PATH\" (:display-string (prin1-to-string (symbol-name swap-search-type)))) + +(define-pragma "NON_VOLATILE" pragma-non-volatile + (:documentation "PRAGMA indicating that declared memory can be assumed to be non-volatile - it will not be modified outside of the Quil program in which it is declared. + +Expected syntax: PRAGMA NON_VOLATILE identifier") + (:global t) + (:slots (memory-name cl-quil::memory-name)) + (:words (name string)) + (:initialization + (setf memory-name (cl-quil::memory-name name))) + (:display-string + (princ-to-string (cl-quil::memory-name-region-name memory-name)))) + + +(defun tokenize-extern-signature (input) + (let ((pos 0)) + (labels ((peek () (if (< pos (length input)) (elt input pos) nil)) + (next () (prog1 (peek) (incf pos))) + (skip-whitespace () + (loop :for c := (peek) + :while (and c (eq #\Space c)) + :do (incf pos))) + (next-token () + (skip-whitespace) + (a:if-let (next-char (next)) + (case next-char + (#\( :LEFT-PAREN) + (#\) :RIGHT-PAREN) + (#\: :COLON) + (#\, :COMMA) + (#\[ :LEFT-BRACKET) + (#\] :RIGHT-BRACKET) + (otherwise + (let ((token + (with-output-to-string (token) + (princ next-char token) + (loop :for c := (next) + :while c + :until (find c "[]():, ") + :do (princ c token) + :finally (when c (decf pos)))))) + (cond ((equal "mut" token) + :MUT) + ((every (a:conjoin (complement #'alpha-char-p) #'alphanumericp) token) + (values :INT (parse-integer token))) + (t + (values :WORD token)))))) + nil))) + #'next-token))) + +(yacc:define-parser *extern-signature-grammar* + (:start-symbol signature) + (:terminals (:LEFT-PAREN :RIGHT-PAREN + :LEFT-BRACKET :RIGHT-BRACKET + :COMMA :COLON :MUT :INT :WORD)) + + (signature + (:WORD :LEFT-PAREN paramlist :RIGHT-PAREN + (lambda (&rest args) (list :value-type (first args) :param-types (third args)))) + (:LEFT-PAREN paramlist :RIGHT-PAREN + (lambda (&rest args) (list :param-types (second args))))) + + (paramlist + (param :COMMA paramlist + (lambda (p i0 ps) (declare (ignore i0)) + (cons p ps))) + (param (lambda (p) (list p)))) + + (param + (:WORD :COLON :MUT type + (lambda (var i0 mut type) (declare (ignore i0 mut)) (list* var :mut type))) + (:WORD :COLON type + (lambda (var i0 type) (declare (ignore i0)) (cons var type)))) + + (type + (:WORD) + (:WORD :LEFT-BRACKET :INT :RIGHT-BRACKET + (lambda (word rb size lb) + (declare (ignore rb lb)) + (format nil "~a[~a]" word size))))) + +(define-pragma "EXTERN" pragma-extern-signature + (:documentation "PRAGMA declaring the function signature of an extern. + +Expected syntax: PRAGMA EXTERN extern-name \"TYPE? \( (var : mut? TYPE)+ \)") + (:global t) + (:slots extern-name value-type param-types) + (:words name) + (:freeform-string function-signature-string) + (:initialization + (let ((parsed (yacc:parse-with-lexer + (tokenize-extern-signature function-signature-string) + *extern-signature-grammar*))) + (setf extern-name name) + (setf value-type (getf parsed :value-type)) + (setf param-types (getf parsed :param-types))))) + + (defun parsed-program-has-pragma-p (parsed-program &optional (pragma-type 'pragma)) "Return T if PARSED-PROGRAM's executable code contains any pragma. Optionally use PRAGMA-TYPE to restrict to a particular pragma type." (some (a:rcurry #'typep pragma-type) diff --git a/src/print-program.lisp b/src/print-program.lisp index 83d84b329..310fb28f4 100644 --- a/src/print-program.lisp +++ b/src/print-program.lisp @@ -27,6 +27,10 @@ (print-externs (externs) (loop :for name :being :the :hash-keys :of externs :do (print-instruction (make-instance 'extern :name name) stream) + (fresh-line stream))) + (print-stubs (stubs) + (loop :for name :being :the :hash-keys :of stubs + :do (print-instruction (make-instance 'stub :name name) stream) (fresh-line stream)))) ;; Ensure that any non-standard gates in the program are defined @@ -36,7 +40,8 @@ (loop :for k :being :the :hash-key :of **default-gate-definitions** :collect k))) (defgates (parsed-program-gate-definitions pp)) - (externs (parsed-program-extern-operations pp)) + (stubs (parsed-program-stub-operations pp)) + (externs (parsed-program-extern-declarations pp)) (simple-gates (map 'list #'gate-application-gate (remove-if-not (lambda (inst) @@ -50,6 +55,7 @@ (push (make-instance 'static-gate-definition :name (slot-value gate 'name) :entries (coerce (slot-value (simple-gate-matrix gate) 'magicl::storage) 'list)) defgates))) (print-externs externs) + (print-stubs stubs) (print-definitions (parsed-program-memory-definitions pp)) ;; instructions and single-line definitions (e.g. DECLARE) do diff --git a/src/quilt/analysis/fill-delays.lisp b/src/quilt/analysis/fill-delays.lisp index 9af0c1e2f..47e3b9cf9 100644 --- a/src/quilt/analysis/fill-delays.lisp +++ b/src/quilt/analysis/fill-delays.lisp @@ -32,14 +32,15 @@ (capture (capture-waveform instr))))) (waveform-ref-name-resolution wf-ref))) -(defun waveform-active-duration (wf-or-wf-defn) +(defun waveform-active-duration (wf-or-wf-defn frame) "Get the active duration of the waveform or waveform definition, in seconds. -If WF-OR-WF-DEFN is a waveform definition, SAMPLE-RATE (Hz) must be non-null. " +If WF-OR-WF-DEFN is a waveform definition, then FRAME's +SAMPLE-RATE (Hz) must be non-null. " (etypecase wf-or-wf-defn (standard-waveform (constant-value (waveform-duration wf-or-wf-defn))) (waveform-definition (/ (length (waveform-definition-entries wf-or-wf-defn)) - (constant-value (waveform-definition-sample-rate wf-or-wf-defn)))))) + (constant-value (frame-sample-rate frame)))))) (defparameter *quilt-seemingly-instantenous-duration* 0.0d0 "A numerical value representing the duration of seemingly instantenous operations, in seconds. This might be zero, and it might not be!") @@ -48,7 +49,7 @@ If WF-OR-WF-DEFN is a waveform definition, SAMPLE-RATE (Hz) must be non-null. " "Get the duration of the specified Quilt instruction INSTR if it is well defined, or NIL otherwise." (typecase instr ((or pulse capture) - (waveform-active-duration (resolved-waveform instr))) + (waveform-active-duration (resolved-waveform instr) (pulse-op-frame instr))) (delay (constant-value (delay-duration instr))) (raw-capture diff --git a/src/quilt/ast.lisp b/src/quilt/ast.lisp index 30b807eac..310d049cb 100644 --- a/src/quilt/ast.lisp +++ b/src/quilt/ast.lisp @@ -31,6 +31,9 @@ hash (qubit-index qubit)))))) +(defun frame-sample-rate (frame) + (frame-definition-sample-rate (frame-name-resolution frame))) + (defmethod print-instruction-generic ((thing frame) (stream stream)) (format stream "~{~/cl-quil:instruction-fmt/ ~}\"~A\"" (frame-qubits thing) @@ -214,6 +217,11 @@ (raw-capture-duration instr) (raw-capture-memory-ref instr))) +(defgeneric pulse-op-frame (op) + (:method ((op raw-capture)) (raw-capture-frame op)) + (:method ((op capture)) (capture-frame op)) + (:method ((op pulse)) (pulse-frame op))) + ;;; Timing Control and Synchronization (defclass delay (instruction) @@ -336,10 +344,6 @@ :reader waveform-definition-entries :type list :documentation "The raw IQ values of the waveform being defined.") - (sample-rate :initarg :sample-rate - :reader waveform-definition-sample-rate - :type constant - :documentation "The sample rate for which the waveform is applicable.") (context :initarg :context :type lexical-context :accessor lexical-context @@ -359,7 +363,7 @@ :documentation "A list of symbol parameter names.")) (:documentation "A waveform definition that has named parameters.")) -(defun make-waveform-definition (name parameters entries sample-rate &key context) +(defun make-waveform-definition (name parameters entries &key context) (check-type name string) (check-type parameters symbol-list) (if (not (endp parameters)) @@ -367,21 +371,18 @@ :name name :parameters parameters :entries entries - :sample-rate sample-rate :context context) (make-instance 'static-waveform-definition :name name :entries entries - :sample-rate sample-rate :context context))) (defmethod print-instruction-generic ((defn waveform-definition) (stream stream)) - (format stream "DEFWAVEFORM ~A~@[(~{%~A~^, ~})~] ~/cl-quil:instruction-fmt/:" + (format stream "DEFWAVEFORM ~A~@[(~{%~A~^, ~})~]:" (waveform-definition-name defn) (if (typep defn 'static-waveform-definition) '() - (waveform-definition-parameters defn)) - (waveform-definition-sample-rate defn)) + (waveform-definition-parameters defn))) (format stream "~% ~{~A~^, ~}" (mapcar (lambda (z) (with-output-to-string (s) diff --git a/src/quilt/package.lisp b/src/quilt/package.lisp index af04ec2f1..6389f87a9 100644 --- a/src/quilt/package.lisp +++ b/src/quilt/package.lisp @@ -140,7 +140,6 @@ #:waveform-definition-name ; READER #:waveform-definition-entries ; READER #:waveform-definition-parameters ; READER - #:waveform-definition-sample-rate ; READER #:calibration-definition ; ABSTRACT CLASS #:gate-calibration-definition ; CLASS diff --git a/src/quilt/parser.lisp b/src/quilt/parser.lisp index 8ee44a70f..feea13d06 100644 --- a/src/quilt/parser.lisp +++ b/src/quilt/parser.lisp @@ -394,8 +394,7 @@ (quil-parse-error "EOF reached when waveform definition expected.")) ;; Get the parameter and body lines - (let (name - sample-rate) + (let (name) (destructuring-bind (parameter-line &rest body-lines) tok-lines (destructuring-bind (op . params-args) parameter-line ;; Check that we are dealing with a DEFWAVEFORM. @@ -414,15 +413,17 @@ (setf name (quil:token-payload (pop params-args))) (multiple-value-bind (params rest-line) (parse-parameters params-args) - - (setf sample-rate (parse-sample-rate (butlast rest-line))) - + ;; Check for colon and incise it. (let ((maybe-colon (last rest-line))) (when (or (null maybe-colon) (not (eq ':COLON (quil:token-type (first maybe-colon))))) (quil-parse-error "Expected a colon terminating the first line of DEFWAVEFORM."))) + (when (butlast rest-line) + (quil-parse-error "Unexpected tokens ~s before colon on first line of DEFWAVEFORM." + (butlast rest-line))) + (let ((*arithmetic-parameters* nil) (*segment-encountered* nil)) (multiple-value-bind (parsed-entries rest-lines) @@ -447,7 +448,7 @@ :collect (gensym (concatenate 'string (param-name p) "-UNUSED")) :else :collect (second found-p)))) - (values (make-waveform-definition name param-symbols parsed-entries sample-rate :context op) + (values (make-waveform-definition name param-symbols parsed-entries :context op) rest-lines))))))))) ;;; Calibration Definitions diff --git a/tests/bad-test-files/bad-empty-extern.quil b/tests/bad-test-files/bad-empty-extern.quil index 7a447dfee..e810faf25 100644 --- a/tests/bad-test-files/bad-empty-extern.quil +++ b/tests/bad-test-files/bad-empty-extern.quil @@ -1,4 +1,4 @@ -# "Empty" extern declarations are bad +# "Empty" extern declarations ar bad EXTERN diff --git a/tests/bad-test-files/bad-empty-stub.quil b/tests/bad-test-files/bad-empty-stub.quil new file mode 100644 index 000000000..865db8ee9 --- /dev/null +++ b/tests/bad-test-files/bad-empty-stub.quil @@ -0,0 +1,5 @@ +# "Empty" stub declarations are bad + +STUB + +H 0 \ No newline at end of file diff --git a/tests/bad-test-files/bad-extern-declaration-arg.quil b/tests/bad-test-files/bad-extern-declaration-arg.quil deleted file mode 100644 index f34761c35..000000000 --- a/tests/bad-test-files/bad-extern-declaration-arg.quil +++ /dev/null @@ -1,5 +0,0 @@ -# Bad extern declaration argument - -EXTERN 0 - -H 0 \ No newline at end of file diff --git a/tests/bad-test-files/bad-extern-multi-args.quil b/tests/bad-test-files/bad-extern-multi-args.quil deleted file mode 100644 index 0d3efae30..000000000 --- a/tests/bad-test-files/bad-extern-multi-args.quil +++ /dev/null @@ -1,6 +0,0 @@ -# Bad extern with multiple args - -EXTERN CNOT FOO - -CNOT 1 0 -FOO 0 \ No newline at end of file diff --git a/tests/bad-test-files/bad-pragma-extern-type-string-syntax.quil b/tests/bad-test-files/bad-pragma-extern-type-string-syntax.quil new file mode 100644 index 000000000..ccae51d92 --- /dev/null +++ b/tests/bad-test-files/bad-pragma-extern-type-string-syntax.quil @@ -0,0 +1,5 @@ +# Pragma extern type strings have a grammar + +PRAGMA EXTERN foo "(x y z)" + +H 0 \ No newline at end of file diff --git a/tests/bad-test-files/bad-stub-declaration-arg.quil b/tests/bad-test-files/bad-stub-declaration-arg.quil new file mode 100644 index 000000000..cc6250bb3 --- /dev/null +++ b/tests/bad-test-files/bad-stub-declaration-arg.quil @@ -0,0 +1,5 @@ +# Bad stub declaration argument + +STUB 0 + +H 0 \ No newline at end of file diff --git a/tests/bad-test-files/bad-stub-multi-args.quil b/tests/bad-test-files/bad-stub-multi-args.quil new file mode 100644 index 000000000..0c491dc98 --- /dev/null +++ b/tests/bad-test-files/bad-stub-multi-args.quil @@ -0,0 +1,6 @@ +# Bad stub with multiple args + +STUB CNOT FOO + +CNOT 1 0 +FOO 0 \ No newline at end of file diff --git a/tests/extern-tests.lisp b/tests/extern-tests.lisp index 06aeac573..e0cbc6632 100644 --- a/tests/extern-tests.lisp +++ b/tests/extern-tests.lisp @@ -4,69 +4,85 @@ (in-package #:cl-quil-tests) -(deftest test-externs () - ;; We supply Quil with a mixture of "standard" and "totally phony" - ;; gates. Here we mark both MOO and CNOT as externed - (let ((quil - "EXTERN MOO; EXTERN CNOT; X 1; Y 2; MOO 1; X 0; CNOT 0 2; CZ 1 0; Y 0") - parsed) +(defun rando (realcell) (setf (aref realcell 0) (random 1.0))) + +;; you can give functions a name for use in Quil programs +(cl-quil::register-classical-function "randomize" 'rando) + +(deftest test-extern-and-call () + (let (parsed + compiled + (quil + " +EXTERN randomize +DECLARE x REAL +RX(x) 0 +CALL randomize x +CPHASE(pi*x/2) 0 1")) + + ;; we can parse programs like the above without error + (not-signals error + (setf parsed (parse-quil quil))) + + ;; an can compile such programs (not-signals error - (setf parsed (cl-quil:parse quil))) - ;; there should be two externs in the extern-operators - (let ((table - (cl-quil.frontend::parsed-program-extern-operations parsed))) - (is (gethash "CNOT" table)) - (is (gethash "MOO" table))) - ;; there should be two instances of extern-applications - (is (= 2 - (count-if (a:rcurry 'typep 'cl-quil.frontend:extern-application) - (cl-quil::parsed-program-executable-code parsed)))) - (let ((chip - (cl-quil::build-8q-chip)) - compiled) - ;; we should be able to compile programs with extern-applications in them - (not-signals error - (setf compiled - (cl-quil::compiler-hook - parsed - chip))) - ;; There should still be two instances of extern-application, - ;; which may have been rewired but not otherwise altered. - (is (= 2 - (count-if (a:rcurry 'typep 'cl-quil.frontend:extern-application) - (cl-quil::parsed-program-executable-code parsed)))) + (setf compiled (cl-quil::compiler-hook parsed (cl-quil:build-8q-chip)))) + + ;; we want to ensure that the call to randomize happens after the + ;; first instruction to reference x and before any other + ;; instruction that references x. + (flet ((is-dexpr (e) (cl-quil.frontend::delayed-expression-p e))) + (let* ((instrs + (parsed-program-executable-code compiled)) + (pos-rx + (position-if (lambda (instr) + (and (typep instr 'application) + (find-if #'is-dexpr (application-parameters instr)))) + instrs)) + (pos-call + (position-if (lambda (instr) (typep instr 'cl-quil.frontend::call)) + instrs)) + (pos-ref-after-rx + (and pos-rx + (position-if (lambda (instr) + (and (typep instr 'application) + (find-if #'is-dexpr (application-parameters instr)))) + instrs + :start (1+ pos-rx))))) + (is (and pos-rx pos-call pos-ref-after-rx + (< pos-rx pos-call pos-ref-after-rx))))))) + +(defun add2 (x y) (+ x y)) +(cl-quil::register-classical-function "add2" 'add2) + +(deftest test-extern-in-expressions () + (let (parsed rx) + ;; parsing works + (not-signals error + (setf parsed (parse-quil " +EXTERN add2; +PRAGMA EXTERN add2 \"REAL (x:REAL, y:REAL)\"; +RX(add2(3,pi)/4) 0"))) + + ;; because the expression involved no memory references, it is + ;; actually evaluated + (setf rx (elt (parsed-program-executable-code parsed) + (1- (length (parsed-program-executable-code parsed))))) + + (is (is-constant + (elt (application-parameters rx) 0))) - ;; One of the EXTERN-APPLICATION instances should be a MOO and - ;; the other should be a CNOT - (flet ((extern-named? (name) - (lambda (instr) - (and (typep instr 'cl-quil.frontend::extern-application) - (equal name (cl-quil.frontend:application-operator-name instr)))))) - (let ((instructions - (cl-quil:parsed-program-executable-code compiled))) - (is (= 1 (count-if (extern-named? "MOO") instructions))) - (is (= 1 (count-if (extern-named? "CNOT") instructions))) + ;; but this one will involve memory refs, and so will involve a delayed expression + (setf parsed (parse-quil " +EXTERN add2; +PRAGMA EXTERN add2 \"REAL (x:REAL, y:REAL)\"; +DECLARE x REAL; +RX(add2(x,pi)/4) 0")) + (setf rx (elt (parsed-program-executable-code parsed) + (1- (length (parsed-program-executable-code parsed))))) + (is (cl-quil.frontend::delayed-expression-p + (elt (application-parameters rx) 0))))) - ;; All of the Xs Ys should have been compiled to other gates and - ;; should no longer be present in the code - (is (zerop - (loop :for instr :across instructions - :for name = (and (typep instr 'quil::application) - (quil::application-operator-name instr)) - :when (member name '("X" "Y") :test #'equal) - :count 1))))) - ;; The extern table should have been duplicated on compiled program - (let ((pp-externs - (cl-quil.frontend:parsed-program-extern-operations parsed)) - (comp-externs - (cl-quil.frontend:parsed-program-extern-operations compiled))) - (is (= (hash-table-count pp-externs) - (hash-table-count comp-externs))) - ;; And they should contain the same members - (loop :for key :being :the :hash-keys :of pp-externs - :do (is (gethash key comp-externs))) - (loop :for key :being :the :hash-keys :of comp-externs - :do (is (gethash key pp-externs))))))) diff --git a/tests/good-test-files/good-basic-extern.quil b/tests/good-test-files/good-basic-extern.quil deleted file mode 100644 index 1997e1b72..000000000 --- a/tests/good-test-files/good-basic-extern.quil +++ /dev/null @@ -1,8 +0,0 @@ -# Basic Use of EXTERN - -EXTERN PHONY - -Y 0 -PHONY 1 0 -H 0 -X 0 \ No newline at end of file diff --git a/tests/good-test-files/good-basic-stub.quil b/tests/good-test-files/good-basic-stub.quil new file mode 100644 index 000000000..3eec8da5e --- /dev/null +++ b/tests/good-test-files/good-basic-stub.quil @@ -0,0 +1,8 @@ +# Basic Use of STUB + +STUB PHONY + +Y 0 +PHONY 1 0 +H 0 +X 0 \ No newline at end of file diff --git a/tests/good-test-files/good-extern-declare-and-call.quil b/tests/good-test-files/good-extern-declare-and-call.quil new file mode 100644 index 000000000..a47f9a8ea --- /dev/null +++ b/tests/good-test-files/good-extern-declare-and-call.quil @@ -0,0 +1,8 @@ +# Basic use of extern and call + +EXTERN foo +DECLARE x INTEGER +X 0 +CALL foo x 10 +CNOT 1 2 + diff --git a/tests/good-test-files/good-multiple-externs.quil b/tests/good-test-files/good-multiple-externs.quil deleted file mode 100644 index 24e306f29..000000000 --- a/tests/good-test-files/good-multiple-externs.quil +++ /dev/null @@ -1,13 +0,0 @@ -# Multiple externs some of which are "standard" gates - -EXTERN CNOT -EXTERN NOGATE -EXTERN NOTAGATE - -H 0 -CNOT 1 0 -NOTAGATE 0 1 -CZ 1 0 -NOGATE 0 -CNOT 0 1 -X 0 \ No newline at end of file diff --git a/tests/good-test-files/good-multiple-stubs.quil b/tests/good-test-files/good-multiple-stubs.quil new file mode 100644 index 000000000..d21fb7a1e --- /dev/null +++ b/tests/good-test-files/good-multiple-stubs.quil @@ -0,0 +1,13 @@ +# Multiple stubs some of which are "standard" gates + +STUB CNOT +STUB NOGATE +STUB NOTAGATE + +H 0 +CNOT 1 0 +NOTAGATE 0 1 +CZ 1 0 +NOGATE 0 +CNOT 0 1 +X 0 \ No newline at end of file diff --git a/tests/misc-tests.lisp b/tests/misc-tests.lisp index 10ff4b62f..b1959c1f3 100644 --- a/tests/misc-tests.lisp +++ b/tests/misc-tests.lisp @@ -193,7 +193,7 @@ (is (eq lisp-symbol (cl-quil.frontend::quil-infix-operator->lisp-symbol quil-string))) (is (string= quil-string (cl-quil.frontend::lisp-symbol->quil-infix-operator lisp-symbol))))) - (loop :for (quil-string . lisp-symbol) :in cl-quil.frontend::+quil<->lisp-functions+ :do + (loop :for (quil-string . lisp-symbol) :in cl-quil.frontend::*quil<->lisp-functions* :do (progn (is (cl-quil.frontend::valid-quil-function-or-operator-p lisp-symbol)) (is (eq lisp-symbol (cl-quil.frontend::quil-function->lisp-symbol quil-string))) diff --git a/tests/printer-test-files/gold-standard/externs.quil b/tests/printer-test-files/gold-standard/externs.quil index 34793979a..735c9cdb4 100644 --- a/tests/printer-test-files/gold-standard/externs.quil +++ b/tests/printer-test-files/gold-standard/externs.quil @@ -1,5 +1,5 @@ # Input -EXTERN NOTAGATE +STUB NOTAGATE X 0 CNOT 1 0 @@ -10,7 +10,7 @@ H 3 # Output -EXTERN NOTAGATE +STUB NOTAGATE X 0 CNOT 1 0 CZ 1 0 diff --git a/tests/quilt/analysis-tests.lisp b/tests/quilt/analysis-tests.lisp index 8a2b1d34d..12bc143cd 100644 --- a/tests/quilt/analysis-tests.lisp +++ b/tests/quilt/analysis-tests.lisp @@ -41,7 +41,7 @@ FOO(1.0) 0" (deftest test-quilt-name-resolution () (let ((pp (parse-quilt " DEFFRAME 0 \"xy\" -DEFWAVEFORM foo 1.0: +DEFWAVEFORM foo: 1.0, 1.0, 1.0 DEFCAL X q: @@ -64,9 +64,10 @@ PULSE 0 \"xy\" foo"))) (deftest test-quilt-duration () (let ((pp (parse-quilt " -DEFFRAME 0 \"xy\" +DEFFRAME 0 \"xy\": + SAMPLE-RATE: 2.0 -DEFWAVEFORM foo 2.0: +DEFWAVEFORM foo: 1.0, 1.0, 1.0, 1.0 PULSE 0 \"xy\" gaussian(duration: 1.0, fwhm: 0.5, t0: 0.5) diff --git a/tests/quilt/bad-test-files/bad-quilt-waveform-indentation.quil b/tests/quilt/bad-test-files/bad-quilt-waveform-indentation.quil index 4143ba2a9..3f4de9fe3 100644 --- a/tests/quilt/bad-test-files/bad-quilt-waveform-indentation.quil +++ b/tests/quilt/bad-test-files/bad-quilt-waveform-indentation.quil @@ -1,4 +1,4 @@ -DEFWAVEFORM foo 1.0: +DEFWAVEFORM foo: 1, 1, 1 HALT \ No newline at end of file diff --git a/tests/quilt/good-test-files/good-quilt-waveform-definition.quil b/tests/quilt/good-test-files/good-quilt-waveform-definition.quil index 121eb6cc5..88c1cc36c 100644 --- a/tests/quilt/good-test-files/good-quilt-waveform-definition.quil +++ b/tests/quilt/good-test-files/good-quilt-waveform-definition.quil @@ -1,9 +1,9 @@ DEFFRAME 0 "xy" -DEFWAVEFORM my_custom_waveform 1.0: +DEFWAVEFORM my_custom_waveform: 1+2*i, 3+4*i, 5+6*i -DEFWAVEFORM my_custom_parameterized_waveform(%a) 1.0: +DEFWAVEFORM my_custom_parameterized_waveform(%a): (1+2*i)*%a, (3+4*i)*%a, (5+6*i)*%a PULSE 0 "xy" my_custom_waveform diff --git a/tests/quilt/parser-tests.lisp b/tests/quilt/parser-tests.lisp index dc589bb0d..33fc12f42 100644 --- a/tests/quilt/parser-tests.lisp +++ b/tests/quilt/parser-tests.lisp @@ -42,23 +42,6 @@ (signals quil::quil-parse-error (parse-quil "DEFFRAME 0 \"foo\""))) -(deftest test-quilt-defwaveform-sample-rate () - (signals quil-parse-error - (parse-quilt " -DEFWAVEFORM foo: - 1.0, 1.0, 1.0, 1.0")) - (signals quil-parse-error - (parse-quilt " -DEFWAVEFORM foo 4+2*i: - 1.0, 1.0, 1.0, 1.0")) - (let ((pp (parse-quilt " -DEFWAVEFORM foo 4.0: - 1.0, 1.0, 1.0, 1.0"))) - (is (= 4.0 - (constant-value - (waveform-definition-sample-rate - (first (parsed-program-waveform-definitions pp)))))))) - (defun prints-as (expected obj &key (accessor #'quil:parsed-program-executable-code)) "Checks whether OBJ prints as the EXPECTED string. If OBJ is a string, parses OBJ and then checks that the first instruction prints as EXPECTED." (typecase obj @@ -86,7 +69,7 @@ DEFFRAME 0 \"rf\" DEFFRAME 0 \"zz\" DEFFRAME 0 1 \"foo\" DECLARE iq REAL[2] -DEFWAVEFORM wf 1.0: +DEFWAVEFORM wf: 1.0, 1.0, 1.0 ") (instrs (list @@ -123,6 +106,7 @@ DEFWAVEFORM wf 1.0: (deftest test-parse-and-print-quilt-definitions () (let ((boilerplate "~%DEFFRAME 0 \"rx\"") ; tacked on at end (frame-defns (list + "DEFFRAME \"xy\"" "DEFFRAME 0 1 \"xy\"" "DEFFRAME 0 1 \"xy\":~% SAMPLE-RATE: 1.0~%" "DEFFRAME 0 1 \"xy\":~% SAMPLE-RATE: 1.0~% INITIAL-FREQUENCY: 1.0~%" @@ -130,13 +114,13 @@ DEFWAVEFORM wf 1.0: "DEFFRAME 0 1 \"xy\":~% HARDWARE-OBJECT: \"q0_q1_xy\"~%" "DEFFRAME 0 1 \"xy\":~% SAMPLE-RATE: 1.0~% DIRECTION: \"tx\"~%")) (waveform-defns (list - "DEFWAVEFORM foo 1.0:~% 1.0~%" - "DEFWAVEFORM foo 1.0:~% 1.0+1.0i, 1.0+1.0i~%" + "DEFWAVEFORM foo:~% 1.0~%" + "DEFWAVEFORM foo:~% 1.0+1.0i, 1.0+1.0i~%" ;; case sensitivity - "DEFWAVEFORM FOO 1.0:~% 1.0~%" + "DEFWAVEFORM FOO:~% 1.0~%" ;; parametric waveform def ;; this is a bit too dependent on how arithmetic expressions are printed... - "DEFWAVEFORM foo(%theta) 1.0:~% (%theta*(1.0))~%" + "DEFWAVEFORM foo(%theta):~% (%theta*(1.0))~%" )) (calibration-defns (list ; just sticking delays in here to have something nontrivial to print "DEFCAL FOO 0:~% DELAY 0 1.0~% NOP~%" @@ -168,10 +152,10 @@ DEFWAVEFORM wf 1.0: (signature "DEFFRAME 0 \"foo\""))) (is (not (equalp (signature "DEFFRAME 0 \"foo\"") (signature "DEFFRAME 0 \"Foo\"")))) - (is (equalp (signature "DEFWAVEFORM foo 1.0:~% 1.0, 1.0") - (signature "DEFWAVEFORM foo 1.0:~% 1.0, 1.0"))) - (is (not (equalp (signature "DEFWAVEFORM foo 1.0:~% 1.0, 1.0") - (signature "DEFWAVEFORM Foo 1.0:~% 1.0, 1.0")))) + (is (equalp (signature "DEFWAVEFORM foo:~% 1.0, 1.0") + (signature "DEFWAVEFORM foo:~% 1.0, 1.0"))) + (is (not (equalp (signature "DEFWAVEFORM foo:~% 1.0, 1.0") + (signature "DEFWAVEFORM Foo:~% 1.0, 1.0")))) (is (equalp (signature "DEFCAL RX(%theta) q:~% NOP") (signature "DEFCAL RX(%theta) q:~% NOP"))) (is (equalp (signature "DEFCAL RX(0) 0:~% NOP") diff --git a/tests/stub-tests.lisp b/tests/stub-tests.lisp new file mode 100644 index 000000000..89c4b9765 --- /dev/null +++ b/tests/stub-tests.lisp @@ -0,0 +1,72 @@ +;;;; stub-tests.lisp +;;;; +;;;; Author: Colin O'Keefe + +(in-package #:cl-quil-tests) + +(deftest test-stubs () + ;; We supply Quil with a mixture of "standard" and "totally phony" + ;; gates. Here we mark both MOO and CNOT as stubed + (let ((quil + "STUB MOO; STUB CNOT; X 1; Y 2; MOO 1; X 0; CNOT 0 2; CZ 1 0; Y 0") + parsed) + (not-signals error + (setf parsed (cl-quil:parse quil))) + ;; there should be two stubs in the stub-operators + (let ((table + (cl-quil.frontend::parsed-program-stub-operations parsed))) + (is (gethash "CNOT" table)) + (is (gethash "MOO" table))) + ;; there should be two instances of stub-applications + (is (= 2 + (count-if (a:rcurry 'typep 'cl-quil.frontend:stub-application) + (cl-quil::parsed-program-executable-code parsed)))) + (let ((chip + (cl-quil::build-8q-chip)) + compiled) + ;; we should be able to compile programs with stub-applications in them + (not-signals error + (setf compiled + (cl-quil::compiler-hook + parsed + chip))) + ;; There should still be two instances of stub-application, + ;; which may have been rewired but not otherwise altered. + (is (= 2 + (count-if (a:rcurry 'typep 'cl-quil.frontend:stub-application) + (cl-quil::parsed-program-executable-code parsed)))) + + ;; One of the STUB-APPLICATION instances should be a MOO and + ;; the other should be a CNOT + (flet ((stub-named? (name) + (lambda (instr) + (and (typep instr 'cl-quil.frontend::stub-application) + (equal name (cl-quil.frontend:application-operator-name instr)))))) + (let ((instructions + (cl-quil:parsed-program-executable-code compiled))) + (is (= 1 (count-if (stub-named? "MOO") instructions))) + (is (= 1 (count-if (stub-named? "CNOT") instructions))) + + ;; All of the Xs Ys should have been compiled to other gates and + ;; should no longer be present in the code + (is (zerop + (loop :for instr :across instructions + :for name = (and (typep instr 'quil::application) + (quil::application-operator-name instr)) + :when (member name '("X" "Y") :test #'equal) + :count 1))))) + + ;; The stub table should have been duplicated on compiled program + (let ((pp-stubs + (cl-quil.frontend:parsed-program-stub-operations parsed)) + (comp-stubs + (cl-quil.frontend:parsed-program-stub-operations compiled))) + + (is (= (hash-table-count pp-stubs) + (hash-table-count comp-stubs))) + ;; And they should contain the same members + (loop :for key :being :the :hash-keys :of pp-stubs + :do (is (gethash key comp-stubs))) + (loop :for key :being :the :hash-keys :of comp-stubs + :do (is (gethash key pp-stubs))))))) +