920 quil spec 2024 1 conformance

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")))

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)))

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)))

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/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

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))

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 procedure that operates on classical memory and values, declared to
+be available in the underlying system."))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;; Gate Definitions
@@ -1115,6 +1122,26 @@ 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
+    :type extern
+    :documentation "The extern to be called.")
+   (arguments
+    :initarg :arguments
+    :reader call-arguments
+    :documentation "A list of memory refs and constant values"))
+  (:documentation "A call to an EXTERN function."))
+
+(defmethod mnemonic ((call call))
+  (declare (ignore call))
+  (values "CALL" 'call))
+
+(defmethod arguments ((call call))
+  (coerce (cons (call-extern call) (call-arguments call)) 'vector))
+
 (defclass jump (instruction)
   ((label :initarg :label
           :accessor jump-label))
@@ -1316,17 +1343,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 +1595,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 +1686,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 +1803,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 +1858,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

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)))
 

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,15 +113,18 @@ 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)
       (make-instance 'parsed-program
                      :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

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))))))
+
+