Add some more tests for DEFEXPI functionality

src/parser.lisp

@@ -984,24 +984,28 @@ If ENSURE-VALID is T, then a memory reference such as 'foo[0]' will result in an
                        :arguments qubit-list))))
 
 (defun pauli-term->matrix (term arguments parameters parameter-names)
-  (let* ((prefactor-fn
+  (let* ((prefactor
            (typecase (pauli-term-prefactor term)
              (number
-              (lambda (&rest args) (declare (ignore args)) (pauli-term-prefactor term)))
+              (pauli-term-prefactor term))
              (delayed-expression
-              (compile nil `(lambda ,parameter-names
-                              (declare (ignorable ,@parameter-names))
-                              ,(delayed-expression-expression (pauli-term-prefactor term)))))
+              (apply
+               (compile nil `(lambda ,parameter-names
+                               (declare (ignorable ,@parameter-names))
+                               ,(delayed-expression-expression (pauli-term-prefactor term))))
+               parameters))
              ((or symbol cons)
-              (compile nil `(lambda ,parameter-names
-                              (declare (ignorable ,@parameter-names))
-                              ,(pauli-term-prefactor term))))))
+              (apply
+               (compile nil `(lambda ,parameter-names
+                               (declare (ignorable ,@parameter-names))
+                               ,(pauli-term-prefactor term)))
+               parameters))))
          (arg-count (length arguments))
          (size (expt 2 arg-count))
          (m (magicl:make-zero-matrix size size)))
     (dotimes (col size)
       (let ((row col)
-            (entry (apply prefactor-fn parameters)))
+            (entry prefactor))
         (loop :for letter :across (pauli-term-pauli-word term)
               :for arg :in (pauli-term-arguments term)
               :for arg-position := (- arg-count 1 (position arg arguments :test #'equalp))

tests/translator-tests.lisp

@@ -373,6 +373,54 @@ U(time)~{ ~a~}"
                                    (coerce (parsed-program-executable-code cpp) 'list)))))
     (is (quil::matrix-equals-dwim original-output compiled-output))))
 
+(deftest test-simple-defexpis ()
+  (let ((chip (quil::build-nq-fully-connected-chip 2)))
+    (dolist (prog-text (list "
+PRAGMA INITIAL_REWIRING \"NAIVE\"
+DEFGATE EXPI(%beta) p q AS PAULI-SUM:
+    ZZ(-%beta/4) p q
+    Z(%beta/4) p
+    Z(%beta/4) q
+
+EXPI(2.0) 0 1
+CPHASE(-2.0) 0 1"
+                             "
+PRAGMA INITIAL_REWIRING \"NAIVE\"
+DEFGATE EXPI(%beta) p AS PAULI-SUM:
+    Z(%beta/2) p
+
+EXPI(2.0) 0
+RZ(-2.0) 0"))
+      (let* ((cpp (compiler-hook (parse-quil prog-text) chip))
+             (m (parsed-program-to-logical-matrix cpp)))
+        (is (quil::double= 1d0 (abs (magicl:ref m 0 0))))
+        (loop :for j :below (magicl:matrix-rows m)
+              :do (is (quil::double= (magicl:ref m 0 0)
+                                     (magicl:ref m j j))))))))
+
+(deftest test-horizontal-composition-of-pauli-term->matrix ()
+  (flet ((word->matrix (word)
+           (quil::pauli-term->matrix
+            (quil::make-pauli-term :pauli-word word
+                                   :prefactor 1
+                                   :arguments (a:iota (length word)))
+            (a:iota (length word)) nil nil)))
+    (let* ((X (word->matrix "X"))
+           (Y (word->matrix "Y"))
+           (Z (word->matrix "Z"))
+           (I (word->matrix "I"))
+           (word-size 4)
+           (word (random-pauli-word word-size))
+           (m (magicl:make-identity-matrix 1)))
+      (loop :for char :across word
+            :for p := (ecase char
+                        (#\X X)
+                        (#\Y Y)
+                        (#\Z Z)
+                        (#\I I))
+            :do (setf m (magicl:kron m p)))
+      (is (quil::operator= m (word->matrix word))))))
+
 (defun random-permutation (list)
   (unless (null list)
     (let ((index (random (length list))))