Hotfix: Euler infinite loop (#356)

* admit that 'perfect' operations like RZ are not actually perfect
* never permit unguarded compilers into rewriting rule sets
* bump version to 1.10.1

VERSION.txt

@@ -1 +1 @@
-"1.10.0"
+"1.10.1"

src/chip-specification.lisp

@@ -8,6 +8,9 @@
 ;;;
 ;;; Use MAKE-ADJUSTABLE-VECTOR and VNTH for these objects.
 
+(defconstant +near-perfect-fidelity+ 0.99999d0
+  "Even perfect operations are typically limited in their physical realization by, say, the granularity of control electronics. (For instance, waveform IQ values might be stored as complex fixnums of some specified depth.) This constant is a mnemonic for \"supposedly perfect\" and captures some of the loss incurred by these imperfections.")
+
 (defstruct chip-specification
   "Houses information about hardware components on a QPU.
 
@@ -50,7 +53,7 @@ DURATION is the time duration in nanoseconds of this gate application."
 FIDELITY stores the measured gate fidelity.
 
 DURATION stores the measured gate duration (in nanoseconds)."
-  (fidelity 1d0 :type real)
+  (fidelity +near-perfect-fidelity+ :type real)
   (duration 1/100 :type real))
 
 (defun copy-gate-record (record &key fidelity duration)
@@ -334,13 +337,13 @@ used to specify CHIP-SPEC."
                        (hardware-object-gate-information obj))
               (make-gate-record :duration 2000)))
       (when (member ':RZ type)
-        (stash-gate-record "RZ" '(_) (list q) 1/100 1d0))
+        (stash-gate-record "RZ" '(_) (list q) 1/100 +near-perfect-fidelity+))
       (when (member ':X/2 type)
         (stash-gate-record "RX" '(#.(/ pi 2))  `(,q) 9 0.98d0)
         (stash-gate-record "RX" '(#.(/ pi -2)) `(,q) 9 0.98d0)
         (stash-gate-record "RX" '(#.pi)        `(,q) 9 0.98d0)
         (stash-gate-record "RX" '(#.(- pi))    `(,q) 9 0.98d0)
-        (stash-gate-record "RX" '(0d0)         `(,q) 9 1d0)))
+        (stash-gate-record "RX" '(0d0)         `(,q) 9 +near-perfect-fidelity+)))
     ;; return the qubit
     obj))
 

src/define-compiler.lisp

@@ -258,7 +258,7 @@ OPTIONS: plist of options governing applicability of the compiler binding."
          (equalp (gate-binding-operator binding) (application-operator gate)))
      ;; binding parameter is not a wildcard => each (binding parameter is not a wildcard => binding param = gate param)
      (or (symbolp (gate-binding-parameters binding))
-         (every (lambda (b g) (or (symbolp b) (equalp b (constant-value g))))
+         (every (lambda (b g) (or (symbolp b) (double= b (constant-value g))))
                 (gate-binding-parameters binding)
                 (application-parameters gate)))
      ;; each (binding argument is not a wildcard => binding arg = gate arg)
@@ -285,6 +285,14 @@ OPTIONS: plist of options governing applicability of the compiler binding."
   (:method ((binding wildcard-binding) gate)
     (typep gate 'gate-application)))
 
+(defun unguarded-binding-p (b)
+  "Will the binding B match on any ol' gate?"
+  (or (and (wildcard-binding-p b)
+           (endp (wildcard-binding-options b)))
+      (and (gate-binding-p b)
+           (symbolp (gate-binding-operator b))
+           (endp (gate-binding-options b)))))
+
 (define-condition cannot-concretize-binding (serious-condition) ())
 (define-condition no-binding-match (serious-condition) ())
 
@@ -695,33 +703,40 @@ N.B.: The word \"shortest\" here is a bit fuzzy.  In practice it typically means
            (compiler-does-not-apply () nil)
            (cannot-concretize-binding () nil)))
        (consider-compiler (compiler)
-         ;; we support two kinds of matches:
-         ;; (1) a "blind" match, where we can tell just by considering bindings
-         ;;     that the compiler will always have reasonable input and output
-         ;; (2) an "exhaustive" match, where we instantiate different test cases
-         ;;     to pump through the compiler, convincing ourselves that in all
-         ;;     applicable situations the compiler gives good output.
-         (or
-          ;; first try the blind match
-          (let* ((gateset (blank-out-qubits gateset))
-                 (in-fidelity 1d0)
-                 (out-fidelity (occurrence-table-cost (compiler-output-gates compiler) gateset)))
-            (and (occurrence-table-in-gateset-p (compiler-output-gates compiler) gateset)
-                 (loop :for b :in (compiler-bindings compiler)
-                       :always (loop :for g :being :the :hash-keys :of gateset
-                                     :for gate-fidelity := (gate-record-fidelity (gethash g gateset))
-                                     ;; TODO: revisit this predicate.
-                                       :thereis (and (or (binding-subsumes-p g b)
-                                                         (when (typep b 'gate-binding)
-                                                           (binding-subsumes-p (copy-binding b :options nil) g)))
-                                                     (setf in-fidelity (* in-fidelity gate-fidelity)))))
-                 (>= out-fidelity in-fidelity)))
-          ;; if that falls through, try the exhaustive match
-          (let ((matches (loop :for binding :in (compiler-bindings compiler)
-                               :collect (gates-that-match-binding binding))))
-            (unless (every #'identity matches)
-              (return-from consider-compiler nil))
-            (every #'identity (apply #'a:map-product (a:curry #'consider-input-test-case compiler) matches))))))
+         ;; certain things we will never tolerate:
+         ;; (1) unguarded matches will always result in infinite loops.
+         (and
+          (notany #'unguarded-binding-p (compiler-bindings compiler))
+          ;; have cleared these checks, we support two kinds of matches:
+          ;; (1) a "blind" match, where we can tell just by considering bindings
+          ;;     that the compiler will always have reasonable input and output
+          ;; (2) an "exhaustive" match, where we instantiate different test cases
+          ;;     to pump through the compiler, convincing ourselves that in all
+          ;;     applicable situations the compiler gives good output.
+          (or
+           ;; first try the blind match
+           (let* ((gateset (blank-out-qubits gateset))
+                  (in-fidelity 1d0)
+                  (out-fidelity (occurrence-table-cost (compiler-output-gates compiler) gateset)))
+             (and (occurrence-table-in-gateset-p (compiler-output-gates compiler) gateset)
+                  (loop :for b :in (compiler-bindings compiler)
+                        :always (loop :for g :being :the :hash-keys :of gateset
+                                      :for gate-fidelity := (gate-record-fidelity (gethash g gateset))
+                                      ;; TODO: revisit this predicate.
+                                        :thereis (and (or (binding-subsumes-p g b)
+                                                          (when (typep b 'gate-binding)
+                                                            (binding-subsumes-p (copy-binding b :options nil) g)))
+                                                      (setf in-fidelity (* in-fidelity gate-fidelity)))))
+                  (>= out-fidelity in-fidelity)))
+           ;; if that falls through, try the exhaustive match
+           (let ((matches (loop :for binding :in (compiler-bindings compiler)
+                                :for match := (gates-that-match-binding binding)
+                                :when (null match)
+                                  :do (return-from consider-compiler nil)
+                                :collect match)))
+             ;; TODO: this MAP-PRODUCT could be better: unknown argument list size,
+             ;;       generates a whole big list and then does EVERY afterward, ...
+             (every #'identity (apply #'a:map-product (a:curry #'consider-input-test-case compiler) matches)))))))
 
     (let (applicable-compilers)
       (dolist (compiler **compilers-available** applicable-compilers)