Minor updates and code clean-up, now mostly functional under SBCL 1.1…

….14 Linux/x86_64

gate-compression.lisp

@@ -1,36 +1,38 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; gate-compression.lisp
-#|
+; #|
 
-c) 1999-2004, Lee Spector ([email protected])
+; c) 1999-2004, Lee Spector ([email protected])
 
-This code augments the Common Lisp version of the QGAME (Quantum Gate And
-Measurement Emulator) with the MATRIX-GATE gate form and functions for 
-compressing a sequence of gates into single MATRIX-GATE form that applies
-the unitary matrix built from the elements of the sequence. Also included
-is a function for checking the unitarity of a matrix -- this is used to
-ensure that round-off errors during compression do not produce physicially
-impossible results.
+; This code augments the Common Lisp version of the QGAME (Quantum Gate And
+; Measurement Emulator) with the MATRIX-GATE gate form and functions for 
+; compressing a sequence of gates into single MATRIX-GATE form that applies
+; the unitary matrix built from the elements of the sequence. Also included
+; is a function for checking the unitarity of a matrix -- this is used to
+; ensure that round-off errors during compression do not produce physicially
+; impossible results.
 
-Example calls are provided at the end of this file.
+; Example calls are provided at the end of this file.
 
-QGAME and related documentation is distributed from:
+; QGAME and related documentation is distributed from:
 
-  http://hampshire.edu/lspector/qgame.html
+;   http://hampshire.edu/lspector/qgame.html
 
-See also:
+; See also:
 
-  Spector, Lee. 2004. Automatic Quantum Computer Programming: A Genetic 
-  Programming Approach. Boston/Dordrecht/New York/London: Kluwer Academic 
-  Publishers.
+;   Spector, Lee. 2004. Automatic Quantum Computer Programming: A Genetic 
+;   Programming Approach. Boston/Dordrecht/New York/London: Kluwer Academic 
+;   Publishers.
 
-Version history:
-Original sources from qc-matrices/matrices.lisp 
-Oct 5 1999, made compatible with limited-oracle
-Nov 12 2003, many updates, disentangled from LGP
-May 26 2004, cosmetic changes for distribution
+; Version history:
+; Original sources from qc-matrices/matrices.lisp 
+; Oct 5 1999, made compatible with limited-oracle
+; Nov 12 2003, many updates, disentangled from LGP
+; May 26 2004, cosmetic changes for distribution
 
-|#
+; |#
+
+(in-package :qgame)
 
 ;; compiler optimization settings
 
@@ -103,7 +105,7 @@ Written by Lee Spector, 1999."
           when (logbitp index int)
           sum (expt 2 exponent))))
 
-(defun long (n)
+(defun coerce-to-long-float (n)
   "Returns the number n coerced to a long float."
   (coerce n 'long-float))
 
@@ -135,24 +137,24 @@ gate-form, which should conform to the QGAME interface syntax."
                                (list (/ 1 (sqrt 2.0L0))  (/ 1 (sqrt 2.0L0)))
                                ))
                         (cdr gate-form)))
-    (u-theta (expand-matrix (let ((theta (long (third gate-form))))
+    (u-theta (expand-matrix (let ((theta (coerce-to-long-float (third gate-form))))
                               (make-array '(2 2)
                                           :initial-contents 
                                           (list (list (cos theta)  (sin theta))
                                                 (list (- (sin theta))  (cos theta)))))
                             (list (second gate-form))))
-    (cphase (expand-matrix (let ((alpha (long (fourth gate-form))))
+    (cphase (expand-matrix (let ((alpha (coerce-to-long-float (fourth gate-form))))
                              (make-array '(4 4)
                                          :initial-contents 
                                          (list (list 1 0 0 0)
                                                (list 0 1 0 0)
                                                (list 0 0 1 0)
                                                (list 0 0 0 (exp (* (sqrt -1) alpha))))))
                            (list (second gate-form) (third gate-form))))
-    (u2 (expand-matrix (let ((phi (long (third gate-form)))
-                             (theta (long (fourth gate-form)))
-                             (psi (long (fifth gate-form)))
-                             (alpha (long (sixth gate-form)))
+    (u2 (expand-matrix (let ((phi (coerce-to-long-float (third gate-form)))
+                             (theta (coerce-to-long-float (fourth gate-form)))
+                             (psi (coerce-to-long-float (fifth gate-form)))
+                             (alpha (coerce-to-long-float (sixth gate-form)))
                              (i (sqrt -1)))
                          (make-array
                           '(2 2)

qgame.asd

@@ -28,4 +28,4 @@
                  (:file "qgame")
                  (:file "gate-compression")))
 
-;; EOF
+;; EOF

qgame.lisp

@@ -5,6 +5,8 @@
 ;; version 1.20031226 (major version number.yyyymmdd)
 ;; version history below
 
+(in-package :qgame)
+
 ; for maximum reasonably safe speed
 (eval-when (compile)
   (declaim (optimize (speed 3) (safety 1) (space 0) (debug 0))))
@@ -445,37 +447,37 @@ branch."
                                    distance-from-first-to-second-unmatched-end
                                    )))))))
 
-#|
-Test code for without-if-branch and without-else-branch:
-
-(setq p1 '((foo) (bar) (end) (baz) (bingo) (end) (biff) (boff)))
-(setq p2 '(  (foo) (bar) 
-             (measure 0) (blink) (end) (blank) (end) 
-           (end) 
-             (baz) (bingo) 
-             (measure 1) (plonk) (end) (plank) (end)
-           (end) 
-           (biff) (boff)))
-(setq p3 '(  (foo) (bar) 
-             (measure 0) (blink) (measure 0)(end)(end)(end) (blank) (end) 
-           (end) 
-             (baz) (bingo) 
-             (measure 1) (plonk) (end) (plank) (measure 0)(end)(end)(end)
-           (end) 
-           (biff) (boff)))
-
-(without-if-branch p1)
-(without-if-branch p2)
-(without-if-branch p3)
-(without-else-branch p1)
-(without-else-branch p2)
-(without-else-branch p3)
-
-
-(setq p4 '((end) (measure 1) (end) (end) (measure 1) (end)))
-(without-if-branch p4)
-(without-else-branch p4)
-|#
+; #|
+; Test code for without-if-branch and without-else-branch:
+
+; (setq p1 '((foo) (bar) (end) (baz) (bingo) (end) (biff) (boff)))
+; (setq p2 '(  (foo) (bar) 
+;              (measure 0) (blink) (end) (blank) (end) 
+;            (end) 
+;              (baz) (bingo) 
+;              (measure 1) (plonk) (end) (plank) (end)
+;            (end) 
+;            (biff) (boff)))
+; (setq p3 '(  (foo) (bar) 
+;              (measure 0) (blink) (measure 0)(end)(end)(end) (blank) (end) 
+;            (end) 
+;              (baz) (bingo) 
+;              (measure 1) (plonk) (end) (plank) (measure 0)(end)(end)(end)
+;            (end) 
+;            (biff) (boff)))
+
+; (without-if-branch p1)
+; (without-if-branch p2)
+; (without-if-branch p3)
+; (without-else-branch p1)
+; (without-else-branch p2)
+; (without-else-branch p3)
+
+
+; (setq p4 '((end) (measure 1) (end) (end) (measure 1) (end)))
+; (without-if-branch p4)
+; (without-else-branch p4)
+; |#
 
 (defun force-to (measured-value qubit qsys)
   "Collapses a quantum system to the provided measured-value for the provided
@@ -598,19 +600,19 @@ return values."
 
 
 
-#|
+; #|
 
-EXAMPLES
+; EXAMPLES
 
-To run each example evaluate the relevant definition and then call the function
-with or without a debugging argument (which should be 0 for no debugging info,
-1 for a little debugging info, and 1 for a lot of debugging info). For example,
-after evaluating the test-herbs-grover function definition you could try the
-following calls:
+; To run each example evaluate the relevant definition and then call the function
+; with or without a debugging argument (which should be 0 for no debugging info,
+; 1 for a little debugging info, and 1 for a lot of debugging info). For example,
+; after evaluating the test-herbs-grover function definition you could try the
+; following calls:
 
-(test-herbs-grover) ;; for no debugging info
-(test-herbs-grover 1) ;; for some debugging info (just results)
-(test-herbs-grover 2) ;; for more debugging info
+; (test-herbs-grover) ;; for no debugging info
+; (test-herbs-grover 1) ;; for some debugging info (just results)
+; (test-herbs-grover 2) ;; for more debugging info
 
 
 ;;
@@ -639,7 +641,7 @@ following calls:
    :debug debug
    :inspect t))
 
-(test-branching)
+; (test-branching)
 
 
 (defun test-herbs-grover (&optional (debug 0))
@@ -667,8 +669,8 @@ cases."
    :debug debug
    :inspect nil))
 
-(test-herbs-grover 1)
-(test-herbs-grover 2)
+; (test-herbs-grover 1)
+; (test-herbs-grover 2)
 
 
 (defun test-evolved-grover (&optional (debug 0))
@@ -696,8 +698,8 @@ algorithm (evolved with lgp2) for a 4 item database on all four
    :debug debug
    :inspect nil))
 
-(test-evolved-grover 1)
-(test-evolved-grover 2)
+; (test-evolved-grover 1)
+; (test-evolved-grover 2)
 
 
 (defun test-evolved-and-or (&optional (debug 0))
@@ -734,10 +736,10 @@ algorithm (evolved with lgp2) for a 4 item database on all four
    :debug debug
    :inspect nil))
 
-(test-evolved-and-or 1)
-(test-evolved-and-or 2)
+; (test-evolved-and-or 1)
+; (test-evolved-and-or 2)
 
 
-|#
+; |#
 
 ;; EOF