From f378fbbc12cd5d06b99580635e4a3be4beca8a64 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Thu, 23 May 2019 20:00:10 -0500 Subject: [PATCH 01/18] Fix printing of EXPT in delayed expressions Ensure that the lisp function EXPT maps to the Quil infix operator "^" when printing a DELAYED-EXPRESSION in PRINT-INSTRUCTION-GENERIC. Fixes #249 --- src/ast.lisp | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/ast.lisp b/src/ast.lisp index e9ac2162b..cfd2dcd5b 100644 --- a/src/ast.lisp +++ b/src/ast.lisp @@ -109,7 +109,7 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." "Evaluate the delayed expression DE to a numerical value (represented in a CONSTANT data structure). MEMORY-MODEL is an association list with keys MEMORY-REF structures and values the value stored at that location." (labels ((lookup-function (expr) (case expr - ((+ - * / cos sin tan) expr) + ((+ - * / expt cos sin sqrt exp cis) expr) (otherwise (error "Illegal function in arithmetic expression: ~a." expr)))) (evaluate-parameter (param) (etypecase param @@ -1142,7 +1142,11 @@ For example, (format stream "~A" (formal-name thing))) (:method ((thing delayed-expression) (stream stream)) - (labels ((print-delayed-expression (expr stream) + (labels ((lisp-symbol-to-infix-operator (symbol) + (case symbol + (cl:expt "^") + (otherwise (symbol-name symbol)))) + (print-delayed-expression (expr stream) (typecase expr (cons (cond @@ -1151,7 +1155,7 @@ For example, ((= (length expr) 3) (format stream "(~a~a~a)" (print-delayed-expression (second expr) nil) - (first expr) + (lisp-symbol-to-infix-operator (first expr)) (print-delayed-expression (third expr) nil))) ((= (length expr) 2) (format stream "~a(~a)" From 197db5db3cd9d12a8e5cdd9f68c3785edb8799ed Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Thu, 23 May 2019 20:00:30 -0500 Subject: [PATCH 02/18] Add more PRINT-INSTRUCTION tests + support for testing golden files - Move existing PRINT-INSTRUCTION tests into a new file tests/printer-tests.lisp - Add support for testing "golden files", which are tests files that contain a sequence of input/expected-output pairs. See the comment in tests/utilities.lisp for more info. - Add a bunch of new PRINT-INSTRUCTION tests using the new golden file format. --- cl-quil-tests.asd | 1 + tests/misc-tests.lisp | 36 --- tests/parser-tests.lisp | 34 --- tests/printer-test-files/basics.quil | 143 +++++++++ tests/printer-test-files/classical.quil | 65 ++++ .../printer-test-files/decomposed-ccnot.quil | 55 ++++ .../delayed-expressions.quil | 89 ++++++ tests/printer-test-files/gh-issue-249.quil | 14 + .../printer-test-files/permutation-gates.quil | 18 ++ tests/printer-tests.lisp | 123 ++++++++ tests/utilities.lisp | 278 ++++++++++++++++++ 11 files changed, 786 insertions(+), 70 deletions(-) create mode 100644 tests/printer-test-files/basics.quil create mode 100644 tests/printer-test-files/classical.quil create mode 100644 tests/printer-test-files/decomposed-ccnot.quil create mode 100644 tests/printer-test-files/delayed-expressions.quil create mode 100644 tests/printer-test-files/gh-issue-249.quil create mode 100644 tests/printer-test-files/permutation-gates.quil create mode 100644 tests/printer-tests.lisp diff --git a/cl-quil-tests.asd b/cl-quil-tests.asd index 4e6d5250b..2a2fb1f33 100644 --- a/cl-quil-tests.asd +++ b/cl-quil-tests.asd @@ -25,6 +25,7 @@ (:file "initial-rewiring-tests") (:file "lexer-tests") (:file "parser-tests") + (:file "printer-tests") (:file "classical-memory-tests") (:file "resource-tests") (:file "misc-tests") diff --git a/tests/misc-tests.lisp b/tests/misc-tests.lisp index 67b623cca..1fe41f972 100644 --- a/tests/misc-tests.lisp +++ b/tests/misc-tests.lisp @@ -42,42 +42,6 @@ (is (equal '(a b c d) (quil::reduce-append '((a) (b c) nil (d))))) (is (equal '(a b c d e f) (quil::reduce-append '((a) (b c) nil (d) (e f)))))) -(deftest test-print-instruction () - (is (string= "PRAGMA gate_time CNOT \"50 ns\"" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::pragma - :words '("gate_time" "CNOT") - :freeform-string "50 ns") - s)))) - ;; try a operand-free instruction - (is (string= "HALT" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'halt) - s)))) - ;; try a unary instruction - (is (string= "NEG ro[3]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::classical-negate - :target (mref "ro" 3)) - s)))) - ;; try a binary instruction - (is (string= "MEASURE 1 ro[3]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::measure - :address (mref "ro" 3) - :qubit (qubit 1)) - s)))) - ;; try something fancy - (is (string= "CPHASE-AND-MEASURE(%alpha) 1 3 ro[5]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'cl-quil::circuit-application - :operator #.(named-operator "CPHASE-AND-MEASURE") - :parameters `(,(param "alpha")) - :arguments `(,(qubit 1) - ,(qubit 3) - ,(mref "ro" 5))) - s))))) - (deftest test-big-defgate () (let* ((qubit-count 8) (program-string diff --git a/tests/parser-tests.lisp b/tests/parser-tests.lisp index f1279c1ea..73f1f551f 100644 --- a/tests/parser-tests.lisp +++ b/tests/parser-tests.lisp @@ -155,40 +155,6 @@ (is (string= "H" instr-dagger^2)) (is (string= "DAGGER H" instr-dagger^3))))) -(deftest test-defgate-printing () - (let ((befores (list "DEFGATE R(%theta, %beta): - exp(%beta/3*i), 0 - 0, exp(%theta/2*i) - -R(pi/2, pi/8) 0" - "DEFGATE R: - exp(2*i), 0 - 0, exp(4*i) - -R 0"))) - (dolist (before befores) - (let ((after (with-output-to-string (s) - (quil::print-parsed-program - (quil::parse-quil before) - s)))) - (quil::parse-quil after))))) - -(deftest test-circuit-and-declare-printing () - (let* ((before "DECLARE theta REAL[16] -DECLARE theta-bits BIT[100] SHARING theta OFFSET 1 REAL - -DEFCIRCUIT TEST(%a) b c: - RZ(%a) b - RZ(%a) c - - -TEST(0.5) 0 1 -") - (after (with-output-to-string (s) - (cl-quil::print-parsed-program - (cl-quil::parse-quil-into-raw-program before) s)))) - (is (string= before after)))) - (deftest test-defgate-as-matrix () (let* ((quil " DEFGATE TEST AS MATRIX: diff --git a/tests/printer-test-files/basics.quil b/tests/printer-test-files/basics.quil new file mode 100644 index 000000000..42828ea5a --- /dev/null +++ b/tests/printer-test-files/basics.quil @@ -0,0 +1,143 @@ +# Input + +# Output + +# Input +# Comment only +# Output + +# Input +DECLARE ro BIT +MEASURE 0 ro[0] + +# Output +DECLARE ro BIT + +MEASURE 0 ro[0] + +# Input +DECLARE mem OCTET[128] +DECLARE x INTEGER SHARING mem OFFSET 8 BIT 1 OCTET + +# Output +DECLARE mem OCTET[128] +DECLARE x INTEGER SHARING mem OFFSET 8 BIT 1 OCTET + + +# Input +DECLARE mem OCTET[128] +DECLARE x BIT[8] SHARING mem OFFSET 1 BIT + +# Output +DECLARE mem OCTET[128] +DECLARE x BIT[8] SHARING mem OFFSET 1 BIT + + +# Input +RESET +RESET 0 +NOP +WAIT +HALT + +# Output +RESET +RESET 0 +NOP +WAIT +HALT + +# Input +LABEL @F +LABEL @x +LABEL @F2 +LABEL @LOOKY-HERE + +# Output +LABEL @F +LABEL @x +LABEL @F2 +LABEL @LOOKY-HERE + +# Input +DECLARE b BIT +DECLARE ro BIT[2] +LABEL @TOP +JUMP @TOP +JUMP-WHEN @TOP b +JUMP-WHEN @TOP ro[1] +JUMP-UNLESS @TOP b +JUMP-UNLESS @TOP ro[1] + +# Output +DECLARE b BIT +DECLARE ro BIT[2] + +LABEL @TOP +JUMP @TOP +JUMP-WHEN @TOP b[0] +JUMP-WHEN @TOP ro[1] +JUMP-UNLESS @TOP b[0] +JUMP-UNLESS @TOP ro[1] + +# Input +DECLARE ro BIT[2] +MEASURE 0 +MEASURE 0 ro[0] + +# Output +DECLARE ro BIT[2] + +MEASURE 0 +MEASURE 0 ro[0] + +# Input +I 0 +X 1 +Y 2 +Z 0 +H 1 +RX(pi) 0 +RY(COS(pi)) 1 +RZ(pi/2) 2 +CNOT 0 1 +CCNOT 0 1 2 +S 0 +T 1 +PHASE(i) 2 +CPHASE00(1) 1 2 +CPHASE01(1.0) 0 1 +CPHASE10(1*1) 1 0 +CPHASE10(2/2) 1 0 +CZ 0 1 +SWAP 1 0 +CSWAP 0 2 1 +ISWAP 0 2 +PSWAP(pi/8) 1 0 +PISWAP(pi/2^3) 0 1 + +# Output +I 0 +X 1 +Y 2 +Z 0 +H 1 +RX(pi) 0 +RY(-1.0) 1 +RZ(pi/2) 2 +CNOT 0 1 +CCNOT 0 1 2 +S 0 +T 1 +PHASE(1.0i) 2 +CPHASE00(1.0) 1 2 +CPHASE01(1.0) 0 1 +CPHASE10(1.0) 1 0 +CPHASE10(1.0) 1 0 +CZ 0 1 +SWAP 1 0 +CSWAP 0 2 1 +ISWAP 0 2 +PSWAP(pi/8) 1 0 +PISWAP(pi/8) 0 1 + diff --git a/tests/printer-test-files/classical.quil b/tests/printer-test-files/classical.quil new file mode 100644 index 000000000..4e1ea85fc --- /dev/null +++ b/tests/printer-test-files/classical.quil @@ -0,0 +1,65 @@ +# Input +DECLARE int INTEGER[4] +DECLARE ro BIT[4] +DECLARE b BIT + +NEG int[0] +NOT ro[1] +MOVE int[2] 1 +EXCHANGE int[0] int[1] +CONVERT ro[0] int[0] +LOAD b b int[0] +STORE b int[0] b + +# Output +DECLARE int INTEGER[4] +DECLARE ro BIT[4] +DECLARE b BIT + +NEG int[0] +NOT ro[1] +MOVE int[2] 1 +EXCHANGE int[0] int[1] +CONVERT ro[0] int[0] +LOAD b[0] b int[0] +STORE b int[0] b[0] + +# Input +# Stolen from tests/good-test-files/good-classical-binaries.quil +DECLARE ro BIT[4] +DECLARE oct OCTET +DECLARE x REAL[2] + +AND ro[0] ro[1] +XOR ro[1] ro[2] +IOR ro[2] ro[3] + +EQ ro[0] ro[1] ro[2] +LE ro[0] ro[1] ro[2] +LT ro[0] ro[1] ro[2] +GE ro[0] ro[1] ro[2] +GT ro[0] ro[1] ro[2] + +ADD x[0] x[1] +SUB x[0] x[1] +MUL x[0] x[1] +DIV x[0] x[1] + +# Output +DECLARE ro BIT[4] +DECLARE oct OCTET +DECLARE x REAL[2] + +AND ro[0] ro[1] +XOR ro[1] ro[2] +IOR ro[2] ro[3] +EQ ro[0] ro[1] ro[2] +LE ro[0] ro[1] ro[2] +LT ro[0] ro[1] ro[2] +GE ro[0] ro[1] ro[2] +GT ro[0] ro[1] ro[2] +ADD x[0] x[1] +SUB x[0] x[1] +MUL x[0] x[1] +DIV x[0] x[1] + diff --git a/tests/printer-test-files/decomposed-ccnot.quil b/tests/printer-test-files/decomposed-ccnot.quil new file mode 100644 index 000000000..e13084ba4 --- /dev/null +++ b/tests/printer-test-files/decomposed-ccnot.quil @@ -0,0 +1,55 @@ +# Input +DEFCIRCUIT CNOT-DT-T-CNOT-T p1 p2 p3: + CNOT p2 p3 + DAGGER T p3 + CNOT p1 p3 + T p3 + +DEFCIRCUIT DECOMPOSED-CCNOT q1 q2 q3: + H q3 + CNOT-DT-T-CNOT-T q1 q2 q3 + CNOT-DT-T-CNOT-T q1 q2 q3 + T q2 + H q3 + CNOT q1 q2 + T q1 + DAGGER T q2 + CNOT q1 q2 + +DECOMPOSED-CCNOT 0 1 2 + +# Output +DEFCIRCUIT CNOT-DT-T-CNOT-T p1 p2 p3: + CNOT p2 p3 + DAGGER T p3 + CNOT p1 p3 + T p3 + +DEFCIRCUIT DECOMPOSED-CCNOT q1 q2 q3: + H q3 + CNOT-DT-T-CNOT-T q1 q2 q3 + CNOT-DT-T-CNOT-T q1 q2 q3 + T q2 + H q3 + CNOT q1 q2 + T q1 + DAGGER T q2 + CNOT q1 q2 + + +H 2 +CNOT 1 2 +DAGGER T 2 +CNOT 0 2 +T 2 +CNOT 1 2 +DAGGER T 2 +CNOT 0 2 +T 2 +T 1 +H 2 +CNOT 0 1 +T 0 +DAGGER T 1 +CNOT 0 1 + diff --git a/tests/printer-test-files/delayed-expressions.quil b/tests/printer-test-files/delayed-expressions.quil new file mode 100644 index 000000000..992f2d4db --- /dev/null +++ b/tests/printer-test-files/delayed-expressions.quil @@ -0,0 +1,89 @@ +# Input +DEFGATE TEST(%arg): + %arg+%arg, %arg-%arg + %arg/%arg, %arg^%arg + +# Output +DEFGATE TEST(%arg): + (%arg+%arg), (%arg-%arg) + (%arg/%arg), (%arg^%arg) + + + +# Input +DEFGATE TEST(%arg): + 2*%arg+%arg/pi, %arg^2-%arg+2*%arg + %arg*2/2*%arg, %arg^%arg^%arg + +# Output +DEFGATE TEST(%arg): + (((2.0)*%arg)+(%arg/(pi))), (((%arg^(2.0))-%arg)+((2.0)*%arg)) + (((%arg*(2.0))/(2.0))*%arg), (%arg^(%arg^%arg)) + + + +# Input +DEFGATE TEST(%arg): + COS(%arg), SIN(%arg), CIS(%arg), SQRT(%arg) + EXP(%arg), SIN(pi/%arg), COS(pi/2*%arg), CIS(%arg*i), + SIN(2*%arg), EXP(1+%arg), SQRT(%arg^2), SQRT(%arg)^2 + COS(SIN(%arg)), SIN(%arg)^2+COS(%arg)^2, SIN(%arg)/SIN(%arg), SIN(%arg)/COS(%arg) + +# Output +DEFGATE TEST(%arg): + COS(%arg), SIN(%arg), CIS(%arg), SQRT(%arg) + EXP(%arg), SIN(((pi)/%arg)), COS((((pi)/(2.0))*%arg)), CIS((%arg*(1.0i))) + SIN(((2.0)*%arg)), EXP(((1.0)+%arg)), SQRT((%arg^(2.0))), (SQRT(%arg)^(2.0)) + COS(SIN(%arg)), ((SIN(%arg)^(2.0))+(COS(%arg)^(2.0))), (SIN(%arg)/SIN(%arg)), (SIN(%arg)/COS(%arg)) + + + +# Input +DEFGATE TEST(%arg): + %arg*COS(%arg/2+2^2)^2^4, 0 + 0, 0 + +# Output +DEFGATE TEST(%arg): + (%arg*(COS(((%arg/(2.0))+((2.0)^(2.0))))^((2.0)^(4.0)))), 0.0 + 0.0, 0.0 + + + +# Input +DEFGATE TEST(%arg1, %arg2, %arg3): + (%arg1*%arg2+(%arg3/pi)^2)/pi, 0 + 0, 0 + +# Output +DEFGATE TEST(%arg1, %arg2, %arg3): + (((%arg1*%arg2)+((%arg3/(pi))^(2.0)))/(pi)), 0.0 + 0.0, 0.0 + + + +# Input +DEFGATE TEST(%arg1, %arg2): + 0, 0 + 0, %arg1^%arg2 + +# Output +DEFGATE TEST(%arg1, %arg2): + 0.0, 0.0 + 0.0, (%arg1^%arg2) + + + +# Input +DEFCIRCUIT TEST(%arg1, %arg2) p: + RX(%arg1-%arg2) p + +TEST(pi, pi*SIN(pi/2)) 0 + +# Output +DEFCIRCUIT TEST(%arg1, %arg2) p: + RX((%arg1-%arg2)) p + + +RX(0.0) 0 + diff --git a/tests/printer-test-files/gh-issue-249.quil b/tests/printer-test-files/gh-issue-249.quil new file mode 100644 index 000000000..b3a244c3c --- /dev/null +++ b/tests/printer-test-files/gh-issue-249.quil @@ -0,0 +1,14 @@ +# Input +DEFGATE TEST(%arg): + COS(%arg)^2, 0 + 0, SIN(%arg)^2 + +TEST(0.5) 0 +# Output +DEFGATE TEST(%arg): + (COS(%arg)^(2.0)), 0.0 + 0.0, (SIN(%arg)^(2.0)) + + +TEST(0.5) 0 + diff --git a/tests/printer-test-files/permutation-gates.quil b/tests/printer-test-files/permutation-gates.quil new file mode 100644 index 000000000..b031da424 --- /dev/null +++ b/tests/printer-test-files/permutation-gates.quil @@ -0,0 +1,18 @@ +# Input +DEFGATE TEST: + pi/pi, 0 + 0, 2^4/16 +# Output +DEFGATE TEST AS PERMUTATION: + 0, 1 + + +# Input +DEFGATE TEST: + 0, 1 + 1, 0 +# Output +DEFGATE TEST AS PERMUTATION: + 1, 0 + + diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp new file mode 100644 index 000000000..aa06fb307 --- /dev/null +++ b/tests/printer-tests.lisp @@ -0,0 +1,123 @@ +;;;; tests/printer-tests.lisp +;;;; +;;;; Author: appleby + +(in-package #:cl-quil-tests) + +(defparameter *printer-test-files-directory* + (asdf:system-relative-pathname + ':cl-quil-tests + "tests/printer-test-files/")) + +(defun parse-and-print-quil-to-string (input) + (with-output-to-string (s) + (quil::print-parsed-program (quil:parse-quil input) s))) + +(defun update-print-parsed-program-golden-files (&key skip-prompt) + "Call UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES on all the files in *PRINTER-TEST-FILES-DIRECTORY*. + +See the documentation string for UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES for more info and an +admonition against carelessness." + (update-golden-file-output-sections + (uiop:directory-files *printer-test-files-directory* #P"*.quil") + #'parse-and-print-quil-to-string + :skip-prompt skip-prompt)) + +(deftest test-print-parsed-program-golden-files () + "Ensure that PRINT-PARSED-PROGRAM produces the expected output and that it is parseable by PARSE-QUIL." + + ;; Why hello. Has this test failed due to innocuous changes to the printed representation of the + ;; parsed program? Then you should consider running UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES, + ;; above, to update the output sections of the golden files. If you do so, however, be sure to + ;; examine the diffs of the old vs new output *carefully* to ensure all the changes are intended + ;; or expected. Golden files are precious, and their sanctity must be preserved. Thank you. + + (let* ((golden-files (uiop:directory-files *printer-test-files-directory* #P"*.quil"))) + (is (not (null golden-files))) + (dolist (file golden-files) + (format t "~& Testing file ~a" (pathname-name file)) + (multiple-value-bind (golden-inputs golden-outputs) (parse-golden-file file) + (loop :for input :in golden-inputs + :for expected-output :in golden-outputs :do + (let* ((input-pp (quil:parse-quil input)) + (actual-output (with-output-to-string (s) + (quil::print-parsed-program input-pp s)))) + (is (string= expected-output actual-output)) + + ;; Ensure the output of PRINT-PARSED-PROGRAM can be parsed. + (not-signals error (quil:parse-quil actual-output)) + + ;; Ensure expected-output is a fixed point of parse -> print. + (is (string= expected-output + (parse-and-print-quil-to-string expected-output))))))))) + +(deftest test-print-instruction () + (is (string= "PRAGMA gate_time CNOT \"50 ns\"" + (with-output-to-string (s) + (cl-quil::print-instruction (make-instance 'quil::pragma + :words '("gate_time" "CNOT") + :freeform-string "50 ns") + s)))) + ;; try a operand-free instruction + (is (string= "HALT" + (with-output-to-string (s) + (cl-quil::print-instruction (make-instance 'halt) + s)))) + ;; try a unary instruction + (is (string= "NEG ro[3]" + (with-output-to-string (s) + (cl-quil::print-instruction (make-instance 'quil::classical-negate + :target (mref "ro" 3)) + s)))) + ;; try a binary instruction + (is (string= "MEASURE 1 ro[3]" + (with-output-to-string (s) + (cl-quil::print-instruction (make-instance 'quil::measure + :address (mref "ro" 3) + :qubit (qubit 1)) + s)))) + ;; try something fancy + (is (string= "CPHASE-AND-MEASURE(%alpha) 1 3 ro[5]" + (with-output-to-string (s) + (cl-quil::print-instruction (make-instance 'cl-quil::circuit-application + :operator #.(named-operator "CPHASE-AND-MEASURE") + :parameters `(,(param "alpha")) + :arguments `(,(qubit 1) + ,(qubit 3) + ,(mref "ro" 5))) + s))))) + +(deftest test-defgate-printing () + (let ((befores (list "DEFGATE R(%theta, %beta): + exp(%beta/3*i), 0 + 0, exp(%theta/2*i) + +R(pi/2, pi/8) 0" + "DEFGATE R: + exp(2*i), 0 + 0, exp(4*i) + +R 0"))) + (dolist (before befores) + (let ((after (with-output-to-string (s) + (quil::print-parsed-program + (quil::parse-quil before) + s)))) + (quil::parse-quil after))))) + +(deftest test-circuit-and-declare-printing () + (let* ((before "DECLARE theta REAL[16] +DECLARE theta-bits BIT[100] SHARING theta OFFSET 1 REAL + +DEFCIRCUIT TEST(%a) b c: + RZ(%a) b + RZ(%a) c + + +TEST(0.5) 0 1 +") + (after (with-output-to-string (s) + (cl-quil::print-parsed-program + (cl-quil::parse-quil-into-raw-program before) s)))) + (is (string= before after)))) + diff --git a/tests/utilities.lisp b/tests/utilities.lisp index 088aa8079..019df8b45 100644 --- a/tests/utilities.lisp +++ b/tests/utilities.lisp @@ -33,3 +33,281 @@ :operator (cl-quil::named-operator "TEST") :arguments (mapcar #'cl-quil::qubit qubit-indices) :gate matrix)) + +(macrolet + ((def (predicate-name container-type element-test) + (check-type predicate-name symbol) + (check-type container-type symbol) + (check-type element-test symbol) + (let ((docstring + (format nil "Return true if OBJECT is a ~A and every element satisfies ~A." + container-type element-test))) + `(defun ,predicate-name (object) + ,docstring + (and (typep object ',container-type) + (every #',element-test object)))))) + (def string-list-p list stringp) + (def string-sequence-p sequence stringp)) + +(defun join-strings (strings &key (delimiter #\Newline) prefix-p suffix-p) + "Join a sequence of STRINGS on the character or string DELIMITER. + +If PREFIX-P is non-nil, prefix the returned string with DELIMITER. + +If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." + (check-type strings (satisfies string-sequence-p)) + (check-type delimiter (or string character)) + (with-output-to-string (stream) + (loop :with last := (length strings) + :with delimiter-string := (string delimiter) + :initially (and prefix-p (write-string delimiter-string stream)) + :for str :in (coerce strings 'list) + :for i :upfrom 1 + :do (write-string str stream) + :when (or (< i last) suffix-p) + :do (write-string delimiter-string stream)))) + +;;; +;;; PARSING "GOLDEN" TEST FILES +;;; +;;; A golden file is a file that contains one or more alternating input and output sections, where +;;; each input section contains text meant to be passed to some function under test, and each output +;;; section corresponds to the expected output for the preceding input. Input sections start with a +;;; line containing the string "# Input" and likewise output sections begin with "# Output". For +;;; example: +;;; +;;; ----------- begin golden.txt ------------ +;;; # Input +;;; DEFGATE TEST(%arg): +;;; COS(%arg)^2, 0 +;;; 0, SIN(%arg)^2 +;;; +;;; TEST(0.5) 0 +;;; # Output +;;; DEFGATE TEST(%arg): +;;; (COS(%arg)^(2.0)), 0.0 +;;; 0.0, (SIN(%arg)^(2.0)) +;;; +;;; +;;; TEST(0.5) 0 +;;; +;;; ----------- end golden.txt ------------ +;;; +;;; In this example, both the input and output sections contain Quil code, but the golden file +;;; parser does not attribute any meaning to the contents of the sections. Any text between the +;;; section headers, including blank lines, is collected and returned. +;;; +;;; Golden files are useful for testing any function or system that can take text as input and +;;; produces text as output. See TEST-PRINT-PARSED-PROGRAM-GOLDEN-FILES in printer-tests.lisp for +;;; example usage. +;;; +;;; +;;; A NOTE ON TRAILING NEWLINES +;;; +;;; The final newline in an input or output section is considered part of the golden file syntax, +;;; not therefore not included in the input/output text returned for that section. Thus, if you want +;;; your input/output to include a trailing newline, then you need to add a trailing blank line to +;;; the section text. For example, given the following file: +;;; +;;; ----------- begin no-trailing-newline.txt ------------ +;;; # Input +;;; Input 1 +;;; # Output +;;; Output 1 +;;; # Input +;;; Input 2 +;;; # Output +;;; Output 2 +;;; ----------- end no-trailing-newline.txt ------------ +;;; +;;; calling (parse-golden-file "no-trailing-newline.txt") will return +;;; +;;; (values ("Input 1" "Input 2") ("Output 1" "Output 2")) +;;; +;;; whereas parsing the file +;;; +;;; ----------- begin with-trailing-newlines.txt ------------ +;;; # Input +;;; Input 1 +;;; +;;; # Output +;;; Output 1 +;;; +;;; # Input +;;; Input 2 +;;; # Output +;;; Output 2 +;;; +;;; ----------- end with-trailing-newlines.txt ------------ +;;; +;;; will return (printf-style newline escapes for brevity, you get the idea) +;;; +;;; (values ("Input 1\n" "Input 2") ("Output 1\n" "Output 2\n")) +;;; +;;; +;;; UPDATING GOLDEN FILES +;;; +;;; If you change the system under test such that it produces new or different output, you'll need +;;; to update the output sections of the associated golden files. The function +;;; UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS does just that. See it's docstring for more info, or have a +;;; look at UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES in printer-tests.lisp for example usage. +;;; +;;; Of course, you are also free to update a golden file with your favorite text editor or by any +;;; other means. Just keep in mind the above comments about trailing newlines. +;;; +;;; +;;; ADDING NEW INPUT/OUTPUT pairs +;;; +;;; You can also use UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS to add new outputs to a golden file without +;;; the need to copy/paste or fiddle with trailing-newline matching. For example, if you add the +;;; following to any golden file, either at the end or just after any existing output section: +;;; +;;; # Input +;;; My fresh new input test case +;;; # Output +;;; +;;; then run +;;; +;;; (update-golden-file-output-sections +;;; "path/to/modified/golden/file" +;;; #'some-function-that-generates-desired-output) +;;; +;;; then the previously-empty output section will be populated with the desired output. Note, +;;; however, that this will update ALL output sections in the file. In general, this is not a +;;; problem since the only sane way to use golden files is to assume that every input/output pair in +;;; the file is to be processed by the same output-generating function. Also note that the trailing +;;; "# Output" is required; otherwise, UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS will complain that the +;;; number of input and output sections are not the same. + +(define-condition golden-file-parse-error (alexandria:simple-parse-error) + ((line-number + :initarg :line-number + :initform 0 + :type integer + :reader golden-file-parse-error-line-number) + (bad-text + :initarg :bad-text + :initform nil + :type (or null string) + :reader golden-file-parse-error-bad-text)) + (:report (lambda (condition stream) + (format stream + "Error while parsing golden file at line ~D." + (golden-file-parse-error-line-number condition)) + (alexandria:when-let ((bad-text (golden-file-parse-error-bad-text condition))) + (format stream "~&Invalid text: ~S" bad-text)) + (alexandria:when-let ((format-control (simple-condition-format-control condition))) + (apply #'format stream + (concatenate 'string "~&" format-control) + (simple-condition-format-arguments condition))))) + (:documentation "An error that occurred while parsing a golden file.")) + +(defun parse-golden-file-stream (stream) + "Parse a \"golden\" file from STREAM and return (VALUES INPUTS OUTPUTS). + +STREAM is an input stream and both INPUTS and OUTPUTS are lists of strings. + +A \"golden\" file is a file that contains one or more alternating input and output sections, where +each input section contains text meant to be passed to some function under test, and each output +section corresponds to the expected output for the preceding input. Input sections start with a line +containing the string \"# Input\" (which is discarded) and likewise the output sections begin with +\"# Output\". Any text in between, including blank lines, is collected in the return values INPUTS +and OUTPUTS, respectively." + (flet ((parse-error (line-number line format-control &rest format-arguments) + (error 'golden-file-parse-error + :line-number line-number + :bad-text line + :format-control format-control + :format-arguments format-arguments))) + (loop :with state := ':START + :with input-header := "# Input" + :with output-header := "# Output" + :with pending-lines := '() + :with inputs := '() + :with outputs := '() + :for line-number :upfrom 1 + :for line := (read-line stream nil) + :while line + :do (ecase state + (:START + (unless (string= line "# Input") + (parse-error line-number line "Expected ~S" input-header)) + (setf state ':READING-INPUT)) + ((:READING-INPUT :READING-OUTPUT) + (multiple-value-bind (bad-section next-section next-state) + (if (eq state ':READING-INPUT) + (values input-header output-header ':READING-OUTPUT) + (values output-header input-header ':READING-INPUT)) + (cond + ((string= line bad-section) + (parse-error line-number line "Expected anything other than ~S" bad-section)) + ((string= line next-section) + (let ((new-section (join-strings (nreverse pending-lines)))) + (if (eq state ':READING-INPUT) + (push new-section inputs) + (push new-section outputs))) + (setf pending-lines '()) + (setf state next-state)) + (t + (push line pending-lines)))))) + :finally (progn + (unless (eq state ':READING-OUTPUT) + (parse-error line-number + nil + "Golden file must end with an ~S section" + output-header)) + (push (join-strings (nreverse pending-lines)) outputs) + (unless (= (length inputs) (length outputs)) + (parse-error + line-number + nil + "Number of ~S sections (~D) does not match number of ~S sections (~D)." + input-header (length inputs) + output-header (length outputs))) + (return (values (nreverse inputs) (nreverse outputs))))))) + +(defun parse-golden-file (file-name) + "Convenience wrapper around PARSE-GOLDEN-STREAM." + (check-type file-name (or string pathname)) + (with-open-file (f file-name) + (parse-golden-file-stream f))) + +(defun update-golden-file-output-sections (file-paths output-callback + &key (if-exists ':supersede) skip-prompt) + "Update all output sections of the golden files at FILE-PATHS. + +If you call this function, examine the diffs of the old vs new output sections *carefully* before +committing the updated files, in order to ensure that all the changes are intended or expected. +Golden files are precious, and their sanctity must be preserved! + +FILE-PATHS is either a single PATHNAME or NAMESTRING, or a list of them. All of the files should be +valid golden files that can be parsed by PARSE-GOLDEN-FILE. + +OUTPUT-CALLBACK is function from STRING -> STRING. It will be called successively for each +golden-file input section, and should return the corresponding output string for the given input. + +IF-EXISTS has the standard Common Lisp meaning. See http://l1sp.org/cl/open." + (let ((file-paths-list (alexandria:ensure-list file-paths))) + (when (or skip-prompt + (y-or-n-p + "Are you sure you want to clobber all the output sections of the following files?~%~@ + ~{~A~%~}~%" + file-paths-list)) + (dolist (file file-paths-list) + (format t "~&Updating ~A" file) + (alexandria:write-string-into-file + (join-strings (loop :for input :in (parse-golden-file file) + :for output := (funcall output-callback input) + :collect "# Input" + :collect input + :collect "# Output" + :collect output) + ;; Any trailing newline in the final output section is considered syntax and + ;; consumed by the parser, thus suffix the string with an additional newline + ;; here. This has the side benefit of mimicking Emacs' `require-final-newline' + ;; when the final output section does not end in a newline, thus preventing + ;; spurious diffs if someone visits the golden file in Emacs. + :suffix-p t) + file + :if-exists if-exists + :if-does-not-exist ':error))))) From 01dd974ed3825c5ae9d1a40352f11bdd59926674 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Tue, 28 May 2019 14:33:30 -0500 Subject: [PATCH 03/18] Rename test-print-instruction to test-instruction-fmt Rename the test and replace all (with-output-to-string (s) (cl-quil::print-instruction ... s)) with (format nil "~/cl-quil:instruction-fmt/" ...). Updates #116 --- tests/printer-tests.lisp | 51 +++++++++++++++++----------------------- 1 file changed, 21 insertions(+), 30 deletions(-) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index aa06fb307..4287d0b6b 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -51,41 +51,32 @@ admonition against carelessness." (is (string= expected-output (parse-and-print-quil-to-string expected-output))))))))) -(deftest test-print-instruction () - (is (string= "PRAGMA gate_time CNOT \"50 ns\"" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::pragma - :words '("gate_time" "CNOT") - :freeform-string "50 ns") - s)))) +(deftest test-instruction-fmt () + (is (string= "PRAGMA gate_time CNOT \"50 ns\"" (format nil "~/cl-quil:instruction-fmt/" + (make-instance 'quil::pragma + :words '("gate_time" "CNOT") + :freeform-string "50 ns")))) ;; try a operand-free instruction - (is (string= "HALT" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'halt) - s)))) + (is (string= "HALT" (format nil "~/cl-quil:instruction-fmt/" (make-instance 'halt)))) + ;; try a unary instruction - (is (string= "NEG ro[3]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::classical-negate - :target (mref "ro" 3)) - s)))) + (is (string= "NEG ro[3]" (format nil "~/cl-quil:instruction-fmt/" + (make-instance 'quil::classical-negate + :target (mref "ro" 3))))) ;; try a binary instruction - (is (string= "MEASURE 1 ro[3]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'quil::measure - :address (mref "ro" 3) - :qubit (qubit 1)) - s)))) + (is (string= "MEASURE 1 ro[3]" (format nil "~/cl-quil:instruction-fmt/" + (make-instance 'quil::measure + :address (mref "ro" 3) + :qubit (qubit 1))))) ;; try something fancy (is (string= "CPHASE-AND-MEASURE(%alpha) 1 3 ro[5]" - (with-output-to-string (s) - (cl-quil::print-instruction (make-instance 'cl-quil::circuit-application - :operator #.(named-operator "CPHASE-AND-MEASURE") - :parameters `(,(param "alpha")) - :arguments `(,(qubit 1) - ,(qubit 3) - ,(mref "ro" 5))) - s))))) + (format nil "~/cl-quil:instruction-fmt/" + (make-instance 'cl-quil::circuit-application + :operator #.(named-operator "CPHASE-AND-MEASURE") + :parameters `(,(param "alpha")) + :arguments `(,(qubit 1) + ,(qubit 3) + ,(mref "ro" 5))))))) (deftest test-defgate-printing () (let ((befores (list "DEFGATE R(%theta, %beta): From 69613185614f95224699832d4c78cffd7d55e06d Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Tue, 28 May 2019 20:51:40 -0500 Subject: [PATCH 04/18] Add hack to reset CL-QUIL::**COMMENTS** for testing purposes Resetting the **COMMENTS** table might be required for any test that wants to validate the output of PRINT-PARSED-PROGRAM for programs that contain HALT, NOP, RESET, or other instructions that are represented by singleton classes. This is because the **COMMENTS** hash table is keyed on object identity, so if any prior tests have attached rewiring comments to any singleton instructions, they will persist and be printed by PRINT-PARSED-PROGRAM. See also "Curio No. 2: Comment sharing" from https://github.com/rigetti/quilc/issues/245 --- src/ast.lisp | 6 +++++- tests/printer-tests.lisp | 15 ++++++++++++++- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/src/ast.lisp b/src/ast.lisp index cfd2dcd5b..62696c778 100644 --- a/src/ast.lisp +++ b/src/ast.lisp @@ -152,8 +152,12 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." ;;;;;;;;;;;;;;;;;;;;; Comment protocol for syntax tree objects ;;;;;;;;;;;;;;;;;;;; +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun make-comment-table () + (tg:make-weak-hash-table :test 'eq :weakness ':key))) + (global-vars:define-global-var **comments** - (tg:make-weak-hash-table :test 'eq :weakness ':key) + (make-comment-table) "Weak hash table populated with comments associated to different parts of an AST.") (defun comment (x) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index 4287d0b6b..1baeaf092 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -13,11 +13,22 @@ (with-output-to-string (s) (quil::print-parsed-program (quil:parse-quil input) s))) +(defun reset-comment-table-hack () + "Reset the CL-QUIL::**COMMENTS** hash table. + + Resetting the **COMMENTS** table might be required for any test that wants to validate the output + of PRINT-PARSED-PROGRAM for programs that contain HALT, NOP, RESET, or other instructions that are + represented by singleton classes. This is because the **COMMENTS** hash table is keyed on object + identity, so if any prior tests have attached rewiring comments to any singleton instructions, + they will persist and be printed by PRINT-PARSED-PROGRAM." + (setf quil::**comments** (quil::make-comment-table))) + (defun update-print-parsed-program-golden-files (&key skip-prompt) "Call UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES on all the files in *PRINTER-TEST-FILES-DIRECTORY*. See the documentation string for UPDATE-PRINT-PARSED-PROGRAM-GOLDEN-FILES for more info and an admonition against carelessness." + (reset-comment-table-hack) (update-golden-file-output-sections (uiop:directory-files *printer-test-files-directory* #P"*.quil") #'parse-and-print-quil-to-string @@ -32,7 +43,9 @@ admonition against carelessness." ;; examine the diffs of the old vs new output *carefully* to ensure all the changes are intended ;; or expected. Golden files are precious, and their sanctity must be preserved. Thank you. - (let* ((golden-files (uiop:directory-files *printer-test-files-directory* #P"*.quil"))) + (reset-comment-table-hack) + + (let ((golden-files (uiop:directory-files *printer-test-files-directory* #P"*.quil"))) (is (not (null golden-files))) (dolist (file golden-files) (format t "~& Testing file ~a" (pathname-name file)) From 49140afcebbbb36e354f55b7f3e2ec0cd90e5475 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Wed, 29 May 2019 20:02:26 -0500 Subject: [PATCH 05/18] Add abstraction around quil<-->lisp function/operator conversion The purpose of this commit is to add single source of truth + some abstraction for how Quil functions and operators map to a lisp symbols and vice versa. The motivation for this change is that previously there were a handful of places were the logic for validating and/or translating between Quil and lisp was duplicated, which led to bugs when the list of valid functions, say, was updated in one place but not the other. --- src/ast.lisp | 16 ++-- src/parser.lisp | 94 +++++++++++++++---- tests/misc-tests.lisp | 22 +++++ .../delayed-expressions.quil | 12 +++ 4 files changed, 115 insertions(+), 29 deletions(-) diff --git a/src/ast.lisp b/src/ast.lisp index 62696c778..b48c1c078 100644 --- a/src/ast.lisp +++ b/src/ast.lisp @@ -108,9 +108,9 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." (defun evaluate-delayed-expression (de &optional (memory-model-evaluator #'identity)) "Evaluate the delayed expression DE to a numerical value (represented in a CONSTANT data structure). MEMORY-MODEL is an association list with keys MEMORY-REF structures and values the value stored at that location." (labels ((lookup-function (expr) - (case expr - ((+ - * / expt cos sin sqrt exp cis) expr) - (otherwise (error "Illegal function in arithmetic expression: ~a." expr)))) + (if (valid-quil-function-or-operator-p expr) + expr + (error "Illegal function in arithmetic expression: ~a." expr))) (evaluate-parameter (param) (etypecase param (constant (constant-value param)) @@ -1146,11 +1146,7 @@ For example, (format stream "~A" (formal-name thing))) (:method ((thing delayed-expression) (stream stream)) - (labels ((lisp-symbol-to-infix-operator (symbol) - (case symbol - (cl:expt "^") - (otherwise (symbol-name symbol)))) - (print-delayed-expression (expr stream) + (labels ((print-delayed-expression (expr stream) (typecase expr (cons (cond @@ -1159,11 +1155,11 @@ For example, ((= (length expr) 3) (format stream "(~a~a~a)" (print-delayed-expression (second expr) nil) - (lisp-symbol-to-infix-operator (first expr)) + (lisp-symbol->quil-infix-operator (first expr)) (print-delayed-expression (third expr) nil))) ((= (length expr) 2) (format stream "~a(~a)" - (first expr) + (lisp-symbol->quil-function-or-prefix-operator (first expr)) (print-delayed-expression (second expr) nil))))) (number (format stream "(~/cl-quil:complex-fmt/)" expr)) diff --git a/src/parser.lisp b/src/parser.lisp index 11e71faee..dc44ac1e3 100644 --- a/src/parser.lisp +++ b/src/parser.lisp @@ -1515,25 +1515,79 @@ INPUT-STRING that triggered the condition." (token-payload tok)))))) (eval-when (:compile-toplevel :load-toplevel :execute) + (alexandria:define-constant +quil<->lisp-functions+ + '(("SIN" . cl:sin) + ("COS" . cl:cos) + ("SQRT" . cl:sqrt) + ("EXP" . cl:exp) + ("CIS" . cl:cis)) + :test #'equal + :documentation + "Functions usable from within Quil, and their associated Lisp function symbols.") + + (alexandria:define-constant +quil<->lisp-prefix-arithmetic-operators+ + '(("-" . cl:-)) + :test #'equal + :documentation + "Prefix arithmetic operators usable from within Quil, and their associated Lisp function symbols.") + + ;; If you add a new arithmetic operator here, you must also add it to *ARITHMETIC-GRAMMAR*, below. + (alexandria:define-constant +quil<->lisp-infix-arithmetic-operators+ + '(("+" . cl:+) + ("-" . cl:-) + ("/" . cl:/) + ("*" . cl:*) + ("^" . cl:expt)) + :test #'equal + :documentation + "Infix arithmetic operators usable from within Quil, and their associated Lisp function symbols.") + + (flet ((lisp->quil (lisp-symbol alist) + (check-type lisp-symbol symbol) + (alexandria:when-let ((found (rassoc lisp-symbol alist :test #'eq))) + (car found))) + (quil->lisp (quil-string alist) + (check-type quil-string string) + (alexandria:when-let ((found (assoc quil-string alist :test #'string-equal))) + (cdr found)))) + + (defun lisp-symbol->quil-prefix-operator (symbol) + (lisp->quil symbol +quil<->lisp-prefix-arithmetic-operators+)) + + (defun quil-prefix-operator->lisp-symbol (quil-prefix-operator) + (quil->lisp quil-prefix-operator +quil<->lisp-prefix-arithmetic-operators+)) + + (defun lisp-symbol->quil-infix-operator (symbol) + (lisp->quil symbol +quil<->lisp-infix-arithmetic-operators+)) + + (defun quil-infix-operator->lisp-symbol (quil-infix-operator) + (quil->lisp quil-infix-operator +quil<->lisp-infix-arithmetic-operators+)) + + (defun lisp-symbol->quil-function (symbol) + (lisp->quil symbol +quil<->lisp-functions+)) + + (defun quil-function->lisp-symbol (quil-function) + (quil->lisp quil-function +quil<->lisp-functions+)) + + (defun lisp-symbol->quil-function-or-prefix-operator (symbol) + (or (lisp-symbol->quil-function symbol) + (lisp-symbol->quil-prefix-operator symbol))) + + (defun valid-quil-function-or-operator-p (symbol) + (not (null (or (lisp-symbol->quil-function symbol) + (lisp-symbol->quil-prefix-operator symbol) + (lisp-symbol->quil-infix-operator symbol)))))) + (defun binary (head) (lambda (a i0 b) (declare (ignore i0)) (list head a b))) - (defparameter *valid-functions* - '(("SIN" cl:sin) - ("COS" cl:cos) - ("SQRT" cl:sqrt) - ("EXP" cl:exp) - ("CIS" cl:cis)) - "Functions usable from within Quil, and their associated Lisp function symbols.") - (defun validate-function (func-name) - "Validate the function named FUNC-NAME against *VALID-FUNCTIONS*. Signal a QUIL-PARSE-ERROR if it's invalid." - (let ((found (assoc func-name *valid-functions* :test #'string-equal))) - (if found - (second found) - (quil-parse-error "Invalid function name: ~A" 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." + (alexandria:if-let ((lisp-symbol (quil-function->lisp-symbol func-name))) + lisp-symbol + (quil-parse-error "Invalid function name: ~A" func-name))) (defun find-or-make-parameter-symbol (param) (let ((found (assoc (param-name param) @@ -1563,18 +1617,20 @@ INPUT-STRING that triggered the condition." (:precedence ((:right :EXPT) (:left :TIMES :DIVIDE) (:left :PLUS :MINUS))) (expr - (expr :PLUS expr (binary 'cl:+)) - (expr :MINUS expr (binary 'cl:-)) - (expr :TIMES expr (binary 'cl:*)) - (expr :DIVIDE expr (binary 'cl:/)) - (expr :EXPT expr (binary 'cl:expt)) + ;; If you add a new arithmetic operator here, you must also add it to + ;; +quil<->lisp-infix-arithmetic-operators+, above. + (expr :PLUS expr (binary (quil-infix-operator->lisp-symbol "+"))) + (expr :MINUS expr (binary (quil-infix-operator->lisp-symbol "-"))) + (expr :TIMES expr (binary (quil-infix-operator->lisp-symbol "*"))) + (expr :DIVIDE expr (binary (quil-infix-operator->lisp-symbol "/"))) + (expr :EXPT expr (binary (quil-infix-operator->lisp-symbol "^"))) term) (term (:MINUS expr (lambda (i0 x) (declare (ignore i0)) - (list 'cl:- x))) + (list (quil-prefix-operator->lisp-symbol "-") x))) (:NAME :LEFT-PAREN expr :RIGHT-PAREN (lambda (f i0 x i1) (declare (ignore i0 i1)) diff --git a/tests/misc-tests.lisp b/tests/misc-tests.lisp index 1fe41f972..abf82fa2b 100644 --- a/tests/misc-tests.lisp +++ b/tests/misc-tests.lisp @@ -240,3 +240,25 @@ (lambda (permutation) (not-signals simple-error (quil::check-permutation permutation))) (a:iota n)))) + +(deftest test-quil<->lisp-bridge () + "Test that the functions for mapping between quil<->lisp work." + (loop :for (quil-string . lisp-symbol) :in quil::+quil<->lisp-prefix-arithmetic-operators+ :do + (progn + (is (quil::valid-quil-function-or-operator-p lisp-symbol)) + (is (eq lisp-symbol (quil::quil-prefix-operator->lisp-symbol quil-string))) + (is (string= quil-string (quil::lisp-symbol->quil-prefix-operator lisp-symbol))) + (is (string= quil-string (quil::lisp-symbol->quil-function-or-prefix-operator lisp-symbol))))) + + (loop :for (quil-string . lisp-symbol) :in quil::+quil<->lisp-infix-arithmetic-operators+ :do + (progn + (is (quil::valid-quil-function-or-operator-p lisp-symbol)) + (is (eq lisp-symbol (quil::quil-infix-operator->lisp-symbol quil-string))) + (is (string= quil-string (quil::lisp-symbol->quil-infix-operator lisp-symbol))))) + + (loop :for (quil-string . lisp-symbol) :in quil::+quil<->lisp-functions+ :do + (progn + (is (quil::valid-quil-function-or-operator-p lisp-symbol)) + (is (eq lisp-symbol (quil::quil-function->lisp-symbol quil-string))) + (is (string= quil-string (quil::lisp-symbol->quil-function lisp-symbol))) + (is (string= quil-string (quil::lisp-symbol->quil-function-or-prefix-operator lisp-symbol)))))) diff --git a/tests/printer-test-files/delayed-expressions.quil b/tests/printer-test-files/delayed-expressions.quil index 992f2d4db..a270e8e6e 100644 --- a/tests/printer-test-files/delayed-expressions.quil +++ b/tests/printer-test-files/delayed-expressions.quil @@ -74,6 +74,18 @@ DEFGATE TEST(%arg1, %arg2): +# Input +DEFGATE UNARY-MINUS(%arg1): + 0, -1 + 0, -%arg1 + +# Output +DEFGATE UNARY-MINUS(%arg1): + 0.0, -1.0 + 0.0, -(%arg1) + + + # Input DEFCIRCUIT TEST(%arg1, %arg2) p: RX(%arg1-%arg2) p From bb9999c7ab51f63189a826bff5de8fc143f02abd Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Fri, 31 May 2019 11:07:15 -0500 Subject: [PATCH 06/18] Move generic deftypes and type predicates into a new types.lisp file --- cl-quil.asd | 1 + src/addresser/rewiring.lisp | 7 +-- src/ast.lisp | 15 ++++-- src/chip-reader.lisp | 5 +- src/clifford/clifford.lisp | 4 +- src/clifford/pauli.lisp | 4 +- src/clifford/qubit-algebra.lisp | 3 -- src/compilers/approx.lisp | 2 +- src/define-pragma.lisp | 10 ---- src/gates.lisp | 2 +- src/parser.lisp | 96 ++++++++++++++++++++++----------- src/types.lisp | 45 ++++++++++++++++ tests/utilities.lisp | 17 +----- 13 files changed, 132 insertions(+), 79 deletions(-) create mode 100644 src/types.lisp diff --git a/cl-quil.asd b/cl-quil.asd index e8690f808..9bcd2c880 100644 --- a/cl-quil.asd +++ b/cl-quil.asd @@ -41,6 +41,7 @@ :components ((:static-file "stdgates.quil"))) (:file "package") (:file "options") + (:file "types") (:file "utilities") (:file "relabeling") (:file "matrix-operations") diff --git a/src/addresser/rewiring.lisp b/src/addresser/rewiring.lisp index 858570c36..352b64b66 100644 --- a/src/addresser/rewiring.lisp +++ b/src/addresser/rewiring.lisp @@ -8,14 +8,11 @@ (in-package #:cl-quil) -(defun integeropt-vector-p (v) - (and (vectorp v) (every (lambda (x) (or (not x) (integerp x))) v))) - (defstruct (rewiring (:constructor init-rewiring) (:copier nil)) - (l2p #() :type (satisfies integeropt-vector-p)) - (p2l #() :type (satisfies integeropt-vector-p))) + (l2p #() :type integeropt-vector) + (p2l #() :type integeropt-vector)) (defun inverse-matches-forward-p (forward inverse) "Checks that each non-NIL mapping in FORWARD has a corresponding inverse mapping in diff --git a/src/ast.lisp b/src/ast.lisp index b48c1c078..760c68a36 100644 --- a/src/ast.lisp +++ b/src/ast.lisp @@ -100,7 +100,7 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." (defun make-delayed-expression (params lambda-params expression) "Make a DELAYED-EXPRESSION object initially with parameters PARAMS (probably a list of PARAM objects), lambda parameters LAMBDA-PARAMS, and the form EXPRESSION." - (assert (every #'symbolp lambda-params)) + (check-type lambda-params symbol-list) (%delayed-expression :params params :lambda-params lambda-params :expression expression)) @@ -122,7 +122,7 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." (cons (let ((args (mapcar (lambda (e) (evaluate-expr params lambda-params e)) (cdr expression)))) - (if (every (lambda (thing) (typep thing 'number)) args) + (if (number-list-p args) (apply (lookup-function (first expression)) args) (cdr expression)))) (symbol @@ -154,11 +154,18 @@ EXPRESSION should be an arithetic (Lisp) form which refers to LAMBDA-PARAMS." (eval-when (:compile-toplevel :load-toplevel :execute) (defun make-comment-table () + "Return an empty weak hash table suitable for use as the CL-QUIL::**COMMENTS** table. + +This function can be used to re-initialize the **COMMENTS** table. + +Keys are tested with EQ." (tg:make-weak-hash-table :test 'eq :weakness ':key))) (global-vars:define-global-var **comments** (make-comment-table) - "Weak hash table populated with comments associated to different parts of an AST.") + "Weak hash table populated with comments associated to different parts of an AST. + +The keys are typically INSTRUCTION instances and associated values are STRINGs.") (defun comment (x) (values (gethash x **comments**))) @@ -254,7 +261,7 @@ as a permutation." (defun make-gate-definition (name parameters entries) "Make a static or parameterized gate definition instance, depending on the existence of PARAMETERS." (check-type name string) - (assert (every #'symbolp parameters)) + (check-type parameters symbol-list) (if parameters (make-instance 'parameterized-gate-definition :name name diff --git a/src/chip-reader.lisp b/src/chip-reader.lisp index 971cea97c..6c9295a01 100644 --- a/src/chip-reader.lisp +++ b/src/chip-reader.lisp @@ -54,15 +54,12 @@ (:documentation "This condition can be signaled when the chip reader fails to find an ISA layer.") (:report "Invalid QPU description file: missing required ISA layer or sub-layer.")) -(defun integer-list-p (list) - (every #'integerp list)) - (defun expand-key-to-integer-list (key) "Expands a string of the form \"n1-...-nm\" to the list of integers (list n1 ... nm)." (etypecase key (string (mapcar #'parse-integer (split-sequence:split-sequence #\- key))) - ((and list (satisfies integer-list-p)) + (integer-list key))) (defun dead-qubit-hash-table () diff --git a/src/clifford/clifford.lisp b/src/clifford/clifford.lisp index 0c5d84a1f..a872b470b 100644 --- a/src/clifford/clifford.lisp +++ b/src/clifford/clifford.lisp @@ -80,7 +80,7 @@ qubits." (declaim (ftype (function (t) simple-vector) basis-map)) (defstruct (clifford (:include qubit-algebra)) "An element of the Clifford group on NUM-QUBITS qubits." - (num-qubits 0 :type unsigned-fixnum) + (num-qubits 0 :type quil::unsigned-fixnum) (basis-map nil :type simple-vector)) (defmethod num-qubits ((c clifford)) @@ -236,7 +236,7 @@ NOTE: THERE IS NO CHECKING OF THE VALIDITY OF THE MAP. ANTICOMMUTATIVITY IS NOT (declare (type clifford c)) (declare (inline pauli-hash)) (sxhash - (loop :with h :of-type unsigned-fixnum := 0 + (loop :with h :of-type quil::unsigned-fixnum := 0 :for p :of-type pauli :across (basis-map c) :do (setf h (hash-mix h (pauli-hash p))) :finally (return h)))) diff --git a/src/clifford/pauli.lisp b/src/clifford/pauli.lisp index 471296ed1..aa7377014 100644 --- a/src/clifford/pauli.lisp +++ b/src/clifford/pauli.lisp @@ -27,7 +27,7 @@ (1- (length (pauli-components p)))) (defun make-components (num-qubits) - (declare (type unsigned-fixnum num-qubits)) + (declare (type quil::unsigned-fixnum num-qubits)) (make-array (1+ num-qubits) :element-type 'base4 :initial-element 0)) @@ -265,7 +265,7 @@ hash-function." (declare (optimize speed (safety 0) (debug 0) (space 0)) (type pauli p)) (sxhash - (loop :with h :of-type unsigned-fixnum := 0 + (loop :with h :of-type quil::unsigned-fixnum := 0 :for x :across (pauli-components p) :do (setf h (hash-mix h x)) :finally (return h)))) diff --git a/src/clifford/qubit-algebra.lisp b/src/clifford/qubit-algebra.lisp index 6a7f06057..c7d879007 100644 --- a/src/clifford/qubit-algebra.lisp +++ b/src/clifford/qubit-algebra.lisp @@ -8,9 +8,6 @@ ;;; algebras", corresponding to algebras that have some correspondence ;;; with collections of qubits. -(deftype unsigned-fixnum () - `(and fixnum unsigned-byte)) - (defstruct (qubit-algebra (:conc-name nil)) "A generic algebra involving objects specialized to NUM-QUBITS qubits.") diff --git a/src/compilers/approx.lisp b/src/compilers/approx.lisp index 721a37bee..d632acab2 100644 --- a/src/compilers/approx.lisp +++ b/src/compilers/approx.lisp @@ -162,7 +162,7 @@ ;; special-orthogonal, we have to correct this behavior manually. (defun find-real-spanning-set (vectors) "VECTORS is a list of complex vectors in C^n (which, here, are of type LIST). When possible, computes a set of vectors with real coefficients that span the same complex subspace of C^n as VECTORS." - (assert (a:proper-list-p vectors)) + (check-type vectors a:proper-list) (let* ((coeff-matrix (magicl:make-complex-matrix (length (first vectors)) (* 2 (length vectors)) diff --git a/src/define-pragma.lisp b/src/define-pragma.lisp index de61e1143..e84a1b7fb 100644 --- a/src/define-pragma.lisp +++ b/src/define-pragma.lisp @@ -79,16 +79,6 @@ elements to ELT-TYPE. (alexa:lexer-match-error (c) (quil-parse-error "Lexer failure: ~A" c)))) -(defun integer-sequence-p (object) - (and (typep object 'sequence) - (every #'integerp object))) - -(deftype integer-vector () - `(and vector (satisfies integer-sequence-p))) - -(deftype integer-list () - `(and list (satisfies integer-sequence-p))) - ;;;;;;;;;;;;;;;;;;;; Macroexpansion-time checking ;;;;;;;;;;;;;;;;;;;; diff --git a/src/gates.lisp b/src/gates.lisp index acb5382e6..bc080e28b 100644 --- a/src/gates.lisp +++ b/src/gates.lisp @@ -322,7 +322,7 @@ (entries (gate-definition-entries gate-def)) (params (gate-definition-parameters gate-def)) (dim (isqrt (length entries)))) - (assert (every #'symbolp params)) + (check-type params symbol-list) (make-instance 'parameterized-gate :name name :dimension dim diff --git a/src/parser.lisp b/src/parser.lisp index dc44ac1e3..708222b98 100644 --- a/src/parser.lisp +++ b/src/parser.lisp @@ -1525,13 +1525,14 @@ INPUT-STRING that triggered the condition." :documentation "Functions usable from within Quil, and their associated Lisp function symbols.") + ;; 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. (alexandria:define-constant +quil<->lisp-prefix-arithmetic-operators+ '(("-" . cl:-)) :test #'equal :documentation "Prefix arithmetic operators usable from within Quil, and their associated Lisp function symbols.") - ;; If you add a new arithmetic operator here, you must also add it to *ARITHMETIC-GRAMMAR*, below. (alexandria:define-constant +quil<->lisp-infix-arithmetic-operators+ '(("+" . cl:+) ("-" . cl:-) @@ -1542,41 +1543,75 @@ INPUT-STRING that triggered the condition." :documentation "Infix arithmetic operators usable from within Quil, and their associated Lisp function symbols.") - (flet ((lisp->quil (lisp-symbol alist) - (check-type lisp-symbol symbol) - (alexandria:when-let ((found (rassoc lisp-symbol alist :test #'eq))) - (car found))) - (quil->lisp (quil-string alist) - (check-type quil-string string) - (alexandria:when-let ((found (assoc quil-string alist :test #'string-equal))) - (cdr found)))) + (defun %lisp->quil (lisp-symbol alist) + (check-type lisp-symbol symbol) + (alexandria:when-let ((found (rassoc lisp-symbol alist :test #'eq))) + (car found))) + + (defun %quil->lisp (quil-string alist) + (check-type quil-string string) + (alexandria: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. - (defun lisp-symbol->quil-prefix-operator (symbol) - (lisp->quil symbol +quil<->lisp-prefix-arithmetic-operators+)) + (defun lisp-symbol->quil-prefix-operator (symbol) + (%lisp->quil symbol +quil<->lisp-prefix-arithmetic-operators+)) - (defun quil-prefix-operator->lisp-symbol (quil-prefix-operator) - (quil->lisp quil-prefix-operator +quil<->lisp-prefix-arithmetic-operators+)) + (defun quil-prefix-operator->lisp-symbol (quil-prefix-operator) + (%quil->lisp quil-prefix-operator +quil<->lisp-prefix-arithmetic-operators+)) - (defun lisp-symbol->quil-infix-operator (symbol) - (lisp->quil symbol +quil<->lisp-infix-arithmetic-operators+)) + (defun lisp-symbol->quil-infix-operator (symbol) + (%lisp->quil symbol +quil<->lisp-infix-arithmetic-operators+)) - (defun quil-infix-operator->lisp-symbol (quil-infix-operator) - (quil->lisp quil-infix-operator +quil<->lisp-infix-arithmetic-operators+)) + (defun quil-infix-operator->lisp-symbol (quil-infix-operator) + (%quil->lisp quil-infix-operator +quil<->lisp-infix-arithmetic-operators+)) - (defun lisp-symbol->quil-function (symbol) - (lisp->quil symbol +quil<->lisp-functions+)) + (defun lisp-symbol->quil-function (symbol) + (%lisp->quil symbol +quil<->lisp-functions+)) - (defun quil-function->lisp-symbol (quil-function) - (quil->lisp quil-function +quil<->lisp-functions+)) + (defun quil-function->lisp-symbol (quil-function) + (%quil->lisp quil-function +quil<->lisp-functions+)) - (defun lisp-symbol->quil-function-or-prefix-operator (symbol) - (or (lisp-symbol->quil-function symbol) - (lisp-symbol->quil-prefix-operator symbol))) + (defun lisp-symbol->quil-function-or-prefix-operator (symbol) + (or (lisp-symbol->quil-function symbol) + (lisp-symbol->quil-prefix-operator symbol))) - (defun valid-quil-function-or-operator-p (symbol) - (not (null (or (lisp-symbol->quil-function symbol) - (lisp-symbol->quil-prefix-operator symbol) - (lisp-symbol->quil-infix-operator symbol)))))) + (defun valid-quil-function-or-operator-p (symbol) + (not (null (or (lisp-symbol->quil-function symbol) + (lisp-symbol->quil-prefix-operator symbol) + (lisp-symbol->quil-infix-operator symbol))))) (defun binary (head) (lambda (a i0 b) @@ -1585,9 +1620,8 @@ INPUT-STRING that triggered the condition." (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." - (alexandria:if-let ((lisp-symbol (quil-function->lisp-symbol func-name))) - lisp-symbol - (quil-parse-error "Invalid function name: ~A" func-name))) + (or (quil-function->lisp-symbol func-name) + (quil-parse-error "Invalid function name: ~A" func-name))) (defun find-or-make-parameter-symbol (param) (let ((found (assoc (param-name param) diff --git a/src/types.lisp b/src/types.lisp new file mode 100644 index 000000000..b6d7b839a --- /dev/null +++ b/src/types.lisp @@ -0,0 +1,45 @@ +;;;; src/types.lisp +;;;; +;;;; Author: Appleby +;;;; +;;;; This file contains general-purpose types and type-predicates. Types that are more specialized +;;;; do not belong here and should live in the file or package where they are most used, +;;;; e.g. OPTIMAL-2Q-TARGET-ATOM in compilers/approx.lisp. + +(in-package #:cl-quil) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (macrolet + ((def (type-name predicate-name container-type element-type) + (check-type type-name symbol) + (check-type predicate-name symbol) + (check-type container-type symbol) + (let* ((name (symbol-name predicate-name)) + (article (if (position (schar name 0) "AEIOU") "an" "a")) + (predicate-docstring + (format nil "Is OBJECT ~A ~A where every element satisfies (TYPEP element '~A)." + article container-type element-type)) + (deftype-docstring + (format nil "Type of an object that (SATISFIES ~A)." predicate-name))) + `(progn + (defun ,predicate-name (object) + ,predicate-docstring + (and (typep object ',container-type) + (every (lambda (element) + (typep element ',element-type)) + object))) + (deftype ,type-name () + ,deftype-docstring + '(satisfies ,predicate-name)))))) + + ;; Normally, we'd want ALEXANDRIA:PROPER-LIST in place of LIST in the definitions + ;; below. However, because the predicate we define calls EVERY on the OBJECT (which will error + ;; if given an improper list), we're OK to use LISTs here. + (def integer-list integer-list-p list integer) + (def number-list number-list-p list number) + (def symbol-list symbol-list-p list symbol) + (def string-sequence string-sequence-p sequence string) + (def integeropt-vector integeropt-vector-p vector (or null integer)))) + +(deftype unsigned-fixnum () + `(and fixnum unsigned-byte)) diff --git a/tests/utilities.lisp b/tests/utilities.lisp index 019df8b45..155fa3997 100644 --- a/tests/utilities.lisp +++ b/tests/utilities.lisp @@ -34,28 +34,13 @@ :arguments (mapcar #'cl-quil::qubit qubit-indices) :gate matrix)) -(macrolet - ((def (predicate-name container-type element-test) - (check-type predicate-name symbol) - (check-type container-type symbol) - (check-type element-test symbol) - (let ((docstring - (format nil "Return true if OBJECT is a ~A and every element satisfies ~A." - container-type element-test))) - `(defun ,predicate-name (object) - ,docstring - (and (typep object ',container-type) - (every #',element-test object)))))) - (def string-list-p list stringp) - (def string-sequence-p sequence stringp)) - (defun join-strings (strings &key (delimiter #\Newline) prefix-p suffix-p) "Join a sequence of STRINGS on the character or string DELIMITER. If PREFIX-P is non-nil, prefix the returned string with DELIMITER. If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." - (check-type strings (satisfies string-sequence-p)) + (check-type strings quil::string-sequence) (check-type delimiter (or string character)) (with-output-to-string (stream) (loop :with last := (length strings) From 1dbf7c3712c97ddad329cb0b4a0ea92f703c276b Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 18:30:43 -0500 Subject: [PATCH 07/18] Give credit where credit is due Mention that printer-test-files/decomposed-ccnot.quil was stolen from Nielsen & Chuang. --- tests/printer-test-files/decomposed-ccnot.quil | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/printer-test-files/decomposed-ccnot.quil b/tests/printer-test-files/decomposed-ccnot.quil index e13084ba4..87f5e7166 100644 --- a/tests/printer-test-files/decomposed-ccnot.quil +++ b/tests/printer-test-files/decomposed-ccnot.quil @@ -1,4 +1,5 @@ # Input +# This is a slightly modified form of Figure 4.9 on p. 182 of Nielsen & Chuang (2010 ed.) DEFCIRCUIT CNOT-DT-T-CNOT-T p1 p2 p3: CNOT p2 p3 DAGGER T p3 From 3d5c9072b1fc569382d03f1d79ef1c7d7bb96d7a Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 18:44:09 -0500 Subject: [PATCH 08/18] Add mref test to printer-test-files/delayed-expressions.quil --- .../printer-test-files/delayed-expressions.quil | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/printer-test-files/delayed-expressions.quil b/tests/printer-test-files/delayed-expressions.quil index a270e8e6e..43baf5e3b 100644 --- a/tests/printer-test-files/delayed-expressions.quil +++ b/tests/printer-test-files/delayed-expressions.quil @@ -99,3 +99,19 @@ DEFCIRCUIT TEST(%arg1, %arg2) p: RX(0.0) 0 +# Input +DECLARE int INTEGER[2] + +DEFGATE MREF(%arg): + %arg*int, int[1]/%arg + int[0]^%arg, COS(int+%arg) + +# Output +DECLARE int INTEGER[2] + +DEFGATE MREF(%arg): + (%arg*int[0]), (int[1]/%arg) + (int[0]^%arg), COS((int[0]+%arg)) + + + From 1d4f707116fc371ee593f8dde93771c10b8ed2e7 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 18:53:03 -0500 Subject: [PATCH 09/18] Add tests/printer-test-files/pragmas.quil --- tests/printer-test-files/pragmas.quil | 45 +++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/printer-test-files/pragmas.quil diff --git a/tests/printer-test-files/pragmas.quil b/tests/printer-test-files/pragmas.quil new file mode 100644 index 000000000..caeac3a2f --- /dev/null +++ b/tests/printer-test-files/pragmas.quil @@ -0,0 +1,45 @@ +# Input +# Stolen from tests/good-test-files/good-pragmas.quil +PRAGMA x +PRAGMA x y +PRAGMA x y z + +PRAGMA x "something" +PRAGMA x y "something" +PRAGMA x y z "something" + +PRAGMA ___X_y_Z "s" + +# Output +PRAGMA x +PRAGMA x y +PRAGMA x y z +PRAGMA x "something" +PRAGMA x y "something" +PRAGMA x y z "something" +PRAGMA ___X_y_Z "s" + +# Input +PRAGMA INITIAL_REWIRING "PARTIAL" +PRAGMA INITIAL_REWIRING "NAIVE" +PRAGMA EXPECTED_REWIRING "#(3 4 0 1 2)" +PRAGMA CURRENT_REWIRING "#(0 1 2 3)" +PRAGMA COMMUTING_BLOCKS +PRAGMA END_COMMUTING_BLOCKS +PRAGMA BLOCK +PRAGMA END_BLOCK +PRAGMA ADD-KRAUS X 0 "(0 0 0 0)" +PRAGMA READOUT-POVM 0 "(0 0 0 0)" + +# Output +PRAGMA INITIAL_REWIRING "PARTIAL" +PRAGMA INITIAL_REWIRING "NAIVE" +PRAGMA EXPECTED_REWIRING "#(3 4 0 1 2)" +PRAGMA CURRENT_REWIRING "#(0 1 2 3)" +PRAGMA COMMUTING_BLOCKS +PRAGMA END_COMMUTING_BLOCKS +PRAGMA BLOCK +PRAGMA END_BLOCK +PRAGMA ADD-KRAUS X 0 "(0.0 0.0 0.0 0.0)" +PRAGMA READOUT-POVM 0 "(0.0 0.0 0.0 0.0)" + From 318461a52e84b1d0e9804284e2efe06331c715b6 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 19:05:19 -0500 Subject: [PATCH 10/18] Improvements to PARSE-AND-PRINT-QUIL-TO-STRING Allow the caller of PARSE-AND-PRINT-QUIL-TO-STRING to specify the :PARSER and :PRINTER they want, and make sure to use this function everywhere applicable in printer-tests.lisp. --- tests/printer-tests.lisp | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index 1baeaf092..a4d1e6a45 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -9,9 +9,11 @@ ':cl-quil-tests "tests/printer-test-files/")) -(defun parse-and-print-quil-to-string (input) +(defun parse-and-print-quil-to-string (input + &key (parser #'quil:parse-quil) + (printer #'quil::print-parsed-program)) (with-output-to-string (s) - (quil::print-parsed-program (quil:parse-quil input) s))) + (funcall printer (funcall parser input) s))) (defun reset-comment-table-hack () "Reset the CL-QUIL::**COMMENTS** hash table. @@ -52,9 +54,7 @@ admonition against carelessness." (multiple-value-bind (golden-inputs golden-outputs) (parse-golden-file file) (loop :for input :in golden-inputs :for expected-output :in golden-outputs :do - (let* ((input-pp (quil:parse-quil input)) - (actual-output (with-output-to-string (s) - (quil::print-parsed-program input-pp s)))) + (let ((actual-output (parse-and-print-quil-to-string input))) (is (string= expected-output actual-output)) ;; Ensure the output of PRINT-PARSED-PROGRAM can be parsed. @@ -103,10 +103,7 @@ R(pi/2, pi/8) 0" R 0"))) (dolist (before befores) - (let ((after (with-output-to-string (s) - (quil::print-parsed-program - (quil::parse-quil before) - s)))) + (let ((after (parse-and-print-quil-to-string before))) (quil::parse-quil after))))) (deftest test-circuit-and-declare-printing () @@ -120,8 +117,6 @@ DEFCIRCUIT TEST(%a) b c: TEST(0.5) 0 1 ") - (after (with-output-to-string (s) - (cl-quil::print-parsed-program - (cl-quil::parse-quil-into-raw-program before) s)))) + (after (parse-and-print-quil-to-string before :parser #'quil::parse-quil-into-raw-program))) (is (string= before after)))) From d8fbad4e1babd04fc71a6e4cad69c25f6f22d7fd Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 20:26:49 -0500 Subject: [PATCH 11/18] More printer-tests tweaks - Allow a golden test case to disable the fixed-point check for a particular output by leaving a comment in the corresponding Input section. - Add a golden test file defgates.quil that contains an example of an input/output pair for which the fixed-point check needs to be disabled. - Move one of the test cases that previously appeared in TEST-DEFGATE-PRINTING into delayed-expressions.quil. - Add comments explaining why the remaining test cases in TEST-DEFGATE-PRINTING and TEST-CIRCUIT-AND-DECLARE-PRINTING are not simply included in the golden parse/print tests. - Update TEST-DEFGATE-PRINTING with a NOT-SIGNALS fiasco assertion. --- tests/printer-test-files/defgates.quil | 41 +++++++++++++++++++ .../delayed-expressions.quil | 15 +++++++ tests/printer-tests.lisp | 30 ++++++++------ 3 files changed, 73 insertions(+), 13 deletions(-) create mode 100644 tests/printer-test-files/defgates.quil diff --git a/tests/printer-test-files/defgates.quil b/tests/printer-test-files/defgates.quil new file mode 100644 index 000000000..2b2e36bfa --- /dev/null +++ b/tests/printer-test-files/defgates.quil @@ -0,0 +1,41 @@ +# Input +# Disable fixed-point check + +# The expected output for this input is as given in the Output section, below. However, if *that* +# output is parsed, it will be correctly recognized as a permutation matrix, and then the printed +# representation will be a "DEFGATE R as PERMUTATION" not a "DEFGATE R", hence we disable the +# fixed-point check for this input. + +DEFGATE R: + exp(i*0), 0 + 0, exp(0/i) + +R 0 + +# Output +DEFGATE R: + 1.0, 0.0 + 0.0, 1.0 + + +R 0 + +# Input + +# If we modify the DEFGATE from the previous Input section slightly so that it's no longer a +# permutation matrix, then the output passes the fixed-point check. + +DEFGATE R: + exp(i*0), 0 + 1, exp(0/i) + +R 0 + +# Output +DEFGATE R: + 1.0, 0.0 + 1.0, 1.0 + + +R 0 + diff --git a/tests/printer-test-files/delayed-expressions.quil b/tests/printer-test-files/delayed-expressions.quil index 43baf5e3b..d8829c2bc 100644 --- a/tests/printer-test-files/delayed-expressions.quil +++ b/tests/printer-test-files/delayed-expressions.quil @@ -86,6 +86,21 @@ DEFGATE UNARY-MINUS(%arg1): +# Input +DEFGATE R(%theta, %beta): + exp(%beta/3*i), 0 + 0, exp(%theta/2*i) + +R(pi/2, pi/8) 0 + +# Output +DEFGATE R(%theta, %beta): + EXP(((%beta/(3.0))*(1.0i))), 0.0 + 0.0, EXP(((%theta/(2.0))*(1.0i))) + + +R(pi/2, pi/8) 0 + # Input DEFCIRCUIT TEST(%arg1, %arg2) p: RX(%arg1-%arg2) p diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index a4d1e6a45..8f4190217 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -60,9 +60,12 @@ admonition against carelessness." ;; Ensure the output of PRINT-PARSED-PROGRAM can be parsed. (not-signals error (quil:parse-quil actual-output)) - ;; Ensure expected-output is a fixed point of parse -> print. - (is (string= expected-output - (parse-and-print-quil-to-string expected-output))))))))) + ;; Ensure expected-output is a fixed point of parse -> print. In rare cases, this + ;; check might fail, so skip it if we find a magic cookie at the start of the + ;; input section indicating that we should do so. + (unless (alexandria:starts-with-subseq "# Disable fixed-point check" input) + (is (string= expected-output + (parse-and-print-quil-to-string expected-output)))))))))) (deftest test-instruction-fmt () (is (string= "PRAGMA gate_time CNOT \"50 ns\"" (format nil "~/cl-quil:instruction-fmt/" @@ -92,21 +95,22 @@ admonition against carelessness." ,(mref "ro" 5))))))) (deftest test-defgate-printing () - (let ((befores (list "DEFGATE R(%theta, %beta): - exp(%beta/3*i), 0 - 0, exp(%theta/2*i) - -R(pi/2, pi/8) 0" - "DEFGATE R: + ;; The EXP terms in the below DEFGATE evaluate to floating point values with with lots of digits + ;; in the printed representation. It seems like a bad idea to have a test depend on the precise + ;; default printed representation of such a float, so this test is not included in + ;; TEST-PRINT-PARSED-PROGRAM-GOLDEN-FILES, above. However, a similar test case inspired by this + ;; one is included in printer-test-files/defgates.quil. + (let ((before "DEFGATE R: exp(2*i), 0 0, exp(4*i) -R 0"))) - (dolist (before befores) - (let ((after (parse-and-print-quil-to-string before))) - (quil::parse-quil after))))) +R 0")) + (let ((after (parse-and-print-quil-to-string before))) + (not-signals error (quil::parse-quil after))))) (deftest test-circuit-and-declare-printing () + ;; This test relies on the fact that PARSE-QUIL-INTO-RAW-PROGRAM doesn't EXPAND-CIRCUITS, + ;; otherwise it could be included in TEST-PRINT-PARSED-PROGRAM-GOLDEN-FILES, above. (let* ((before "DECLARE theta REAL[16] DECLARE theta-bits BIT[100] SHARING theta OFFSET 1 REAL From 56fe7f986fe7ce7a4b21293a7a38663ac2df6cb9 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 20:36:53 -0500 Subject: [PATCH 12/18] Add a DEFGATE ... AS PERMUTATION test to the golden printer tests --- tests/printer-test-files/permutation-gates.quil | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/printer-test-files/permutation-gates.quil b/tests/printer-test-files/permutation-gates.quil index b031da424..64f2adc9d 100644 --- a/tests/printer-test-files/permutation-gates.quil +++ b/tests/printer-test-files/permutation-gates.quil @@ -16,3 +16,12 @@ DEFGATE TEST AS PERMUTATION: 1, 0 +# Input +DEFGATE PERM AS PERMUTATION: + 1, 0, 3, 2 + +# Output +DEFGATE PERM AS PERMUTATION: + 1, 0, 3, 2 + + From df5bc5e32d3b51ddbe63ea2002c9c4c39b35598b Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sat, 1 Jun 2019 20:57:35 -0500 Subject: [PATCH 13/18] Add TEST-JUMP-TO-INTEGER-LABEL-PRINTING --- tests/printer-tests.lisp | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index 8f4190217..b0840bb67 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -124,3 +124,14 @@ TEST(0.5) 0 1 (after (parse-and-print-quil-to-string before :parser #'quil::parse-quil-into-raw-program))) (is (string= before after)))) +(deftest test-jump-to-integer-label-printing () + "Ensure that JUMP instructions with integer LABELs are printed correctly." + (is (string= (quil::print-instruction-to-string + (quil::make-instance 'quil::unconditional-jump :label 42)) + "JUMP {absolute address 42}")) + (is (string= (quil::print-instruction-to-string + (quil::make-instance 'quil::jump-when :label 0 :address (quil::mref "ro" 0))) + "JUMP-WHEN {absolute address 0} ro[0]")) + (is (string= (quil::print-instruction-to-string + (quil::make-instance 'quil::jump-unless :label 1 :address (quil::mref "ro" 2))) + "JUMP-UNLESS {absolute address 1} ro[2]"))) From 7e370d4ddaa4a16ed84a79b53a697e4479b6c732 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sun, 2 Jun 2019 19:12:35 -0500 Subject: [PATCH 14/18] Track originating file and line number when parsing golden files - Add GOLDEN-TEST-CASE structure to represent individual input/output pairs parsed from a golden test file. This structure also tracks the originating file name and line number for each test, as well as the input and output sections. - PARSE-GOLDEN-FILE{,-STREAM} now returns a list of GOLDEN-TEST-CASE structures. - TEST-PRINT-PARSED-PROGRAM-GOLDEN-FILES now includes the file name and line number of the input/output pair that caused a failure for any failing assertions. --- tests/printer-tests.lisp | 28 ++++++--- tests/utilities.lisp | 131 ++++++++++++++++++++++++++------------- 2 files changed, 105 insertions(+), 54 deletions(-) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index b0840bb67..d785b355c 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -50,22 +50,30 @@ admonition against carelessness." (let ((golden-files (uiop:directory-files *printer-test-files-directory* #P"*.quil"))) (is (not (null golden-files))) (dolist (file golden-files) - (format t "~& Testing file ~a" (pathname-name file)) - (multiple-value-bind (golden-inputs golden-outputs) (parse-golden-file file) - (loop :for input :in golden-inputs - :for expected-output :in golden-outputs :do - (let ((actual-output (parse-and-print-quil-to-string input))) - (is (string= expected-output actual-output)) - - ;; Ensure the output of PRINT-PARSED-PROGRAM can be parsed. - (not-signals error (quil:parse-quil actual-output)) + (format t "~& Testing file ~A" (pathname-name file)) + (loop :for test-case :in (parse-golden-file file) + :for input := (golden-test-case-input test-case) + :for expected-output := (golden-test-case-output test-case) + :for failure-message := (format nil "~&Golden test case at~%~A:~D" + (golden-test-case-file test-case) + (golden-test-case-line test-case)) + :do (let ((*always-show-failed-sexp* t)) + (format t "~& test case at line ~D" (golden-test-case-line test-case)) + + (let (actual-output) + ;; This SETF is ugly, but guarding this in a NOT-SIGNALS aids debugging in case + ;; PARSE-AND-PRINT-QUIL-TO-STRING chokes on INPUT. + (not-signals error (setf actual-output (parse-and-print-quil-to-string input))) + (not-signals error (quil:parse-quil actual-output)) + (is (string= expected-output actual-output) failure-message)) ;; Ensure expected-output is a fixed point of parse -> print. In rare cases, this ;; check might fail, so skip it if we find a magic cookie at the start of the ;; input section indicating that we should do so. (unless (alexandria:starts-with-subseq "# Disable fixed-point check" input) (is (string= expected-output - (parse-and-print-quil-to-string expected-output)))))))))) + (parse-and-print-quil-to-string expected-output)) + failure-message))))))) (deftest test-instruction-fmt () (is (string= "PRAGMA gate_time CNOT \"50 ns\"" (format nil "~/cl-quil:instruction-fmt/" diff --git a/tests/utilities.lisp b/tests/utilities.lisp index 155fa3997..2b69900fe 100644 --- a/tests/utilities.lisp +++ b/tests/utilities.lisp @@ -90,7 +90,7 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." ;;; A NOTE ON TRAILING NEWLINES ;;; ;;; The final newline in an input or output section is considered part of the golden file syntax, -;;; not therefore not included in the input/output text returned for that section. Thus, if you want +;;; and therefore not included in the input/output text returned for that section. Thus, if you want ;;; your input/output to include a trailing newline, then you need to add a trailing blank line to ;;; the section text. For example, given the following file: ;;; @@ -107,7 +107,16 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." ;;; ;;; calling (parse-golden-file "no-trailing-newline.txt") will return ;;; -;;; (values ("Input 1" "Input 2") ("Output 1" "Output 2")) +;;; (#S(CL-QUIL-TESTS::GOLDEN-TEST-CASE +;;; :FILE #1="no-trailing-newline.txt" +;;; :LINE 1 +;;; :INPUT "input 1" +;;; :OUTPUT "output 1") +;;; #S(CL-QUIL-TESTS::GOLDEN-TEST-CASE +;;; :FILE #1# +;;; :LINE 5 +;;; :INPUT "input 2" +;;; :OUTPUT "output 2")) ;;; ;;; whereas parsing the file ;;; @@ -127,7 +136,16 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." ;;; ;;; will return (printf-style newline escapes for brevity, you get the idea) ;;; -;;; (values ("Input 1\n" "Input 2") ("Output 1\n" "Output 2\n")) +;;; (#S(CL-QUIL-TESTS::GOLDEN-TEST-CASE +;;; :FILE #1="with-trailing-newlines.txt" +;;; :LINE 1 +;;; :INPUT "input 1\n" +;;; :OUTPUT "output 1\n") +;;; #S(CL-QUIL-TESTS::GOLDEN-TEST-CASE +;;; :FILE #1# +;;; :LINE 7 +;;; :INPUT "input 2" +;;; :OUTPUT "output 2\n")) ;;; ;;; ;;; UPDATING GOLDEN FILES @@ -161,14 +179,14 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." ;;; however, that this will update ALL output sections in the file. In general, this is not a ;;; problem since the only sane way to use golden files is to assume that every input/output pair in ;;; the file is to be processed by the same output-generating function. Also note that the trailing -;;; "# Output" is required; otherwise, UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS will complain that the -;;; number of input and output sections are not the same. +;;; "# Output" is required; otherwise, UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS will fail when attempting +;;; to parse the file. (define-condition golden-file-parse-error (alexandria:simple-parse-error) ((line-number :initarg :line-number :initform 0 - :type integer + :type unsigned-byte :reader golden-file-parse-error-line-number) (bad-text :initarg :bad-text @@ -187,8 +205,23 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." (simple-condition-format-arguments condition))))) (:documentation "An error that occurred while parsing a golden file.")) +(defstruct golden-test-case + "GOLDEN-TEST-CASE represents a single input/output pair read from a golden file by PARSE-GOLDEN-FILE. + +FILE is a STRING representation of the file this test case was parsed from. + +LINE is the line number in FILE where the given INPUT section begins. + +INPUT is the text from this test case's Input section. + +OUTPUT is the text from this test case's Output section." + (file "" :type string) + (line 0 :type unsigned-byte) + (input "" :type string) + (output "" :type string)) + (defun parse-golden-file-stream (stream) - "Parse a \"golden\" file from STREAM and return (VALUES INPUTS OUTPUTS). + "Parse a \"golden\" file from STREAM and return a list of GOLDEN-TEST-CASEs. STREAM is an input stream and both INPUTS and OUTPUTS are lists of strings. @@ -196,60 +229,69 @@ A \"golden\" file is a file that contains one or more alternating input and outp each input section contains text meant to be passed to some function under test, and each output section corresponds to the expected output for the preceding input. Input sections start with a line containing the string \"# Input\" (which is discarded) and likewise the output sections begin with -\"# Output\". Any text in between, including blank lines, is collected in the return values INPUTS -and OUTPUTS, respectively." +\"# Output\". Any text in between, including blank lines, is collected in a GOLDEN-TEST-CASE's INPUT +and OUTPUT slots, respectively." + (assert (input-stream-p stream)) (flet ((parse-error (line-number line format-control &rest format-arguments) (error 'golden-file-parse-error :line-number line-number :bad-text line :format-control format-control - :format-arguments format-arguments))) + :format-arguments format-arguments)) + (stream-file-name (stream) + (alexandria:if-let ((path (uiop:truename* stream))) + (enough-namestring path) + ;; If STREAM is not a FILE-STREAM, it won't have an a TRUENAME. Just format the STREAM. + (format nil "~A" stream)))) (loop :with state := ':START :with input-header := "# Input" :with output-header := "# Output" + :with file-name := (stream-file-name stream) :with pending-lines := '() - :with inputs := '() - :with outputs := '() + :with pending-test-case := nil + :with test-cases := '() :for line-number :upfrom 1 :for line := (read-line stream nil) :while line - :do (ecase state - (:START - (unless (string= line "# Input") - (parse-error line-number line "Expected ~S" input-header)) - (setf state ':READING-INPUT)) - ((:READING-INPUT :READING-OUTPUT) - (multiple-value-bind (bad-section next-section next-state) - (if (eq state ':READING-INPUT) - (values input-header output-header ':READING-OUTPUT) - (values output-header input-header ':READING-INPUT)) - (cond - ((string= line bad-section) - (parse-error line-number line "Expected anything other than ~S" bad-section)) - ((string= line next-section) - (let ((new-section (join-strings (nreverse pending-lines)))) - (if (eq state ':READING-INPUT) - (push new-section inputs) - (push new-section outputs))) - (setf pending-lines '()) - (setf state next-state)) - (t - (push line pending-lines)))))) + :do (labels ((new-test-case () + (make-golden-test-case :file file-name :line line-number))) + (ecase state + (:START + (unless (string= line "# Input") + (parse-error line-number line "Expected ~S" input-header)) + (setf pending-test-case (new-test-case)) + (setf state ':READING-INPUT)) + ((:READING-INPUT :READING-OUTPUT) + (multiple-value-bind (bad-section next-section next-state) + (if (eq state ':READING-INPUT) + (values input-header output-header ':READING-OUTPUT) + (values output-header input-header ':READING-INPUT)) + (cond + ((string= line bad-section) + (parse-error line-number line "Expected anything other than ~S" bad-section)) + ((string= line next-section) + (let ((new-section (join-strings (nreverse pending-lines)))) + (ecase state + (:READING-INPUT + (setf (golden-test-case-input pending-test-case) new-section)) + (:READING-OUTPUT + (setf (golden-test-case-output pending-test-case) new-section) + (push pending-test-case test-cases) + (setf pending-test-case (new-test-case))))) + (setf pending-lines '()) + (setf state next-state)) + (t + (push line pending-lines))))))) :finally (progn (unless (eq state ':READING-OUTPUT) (parse-error line-number nil "Golden file must end with an ~S section" output-header)) - (push (join-strings (nreverse pending-lines)) outputs) - (unless (= (length inputs) (length outputs)) - (parse-error - line-number - nil - "Number of ~S sections (~D) does not match number of ~S sections (~D)." - input-header (length inputs) - output-header (length outputs))) - (return (values (nreverse inputs) (nreverse outputs))))))) + (setf (golden-test-case-output pending-test-case) + (join-strings (nreverse pending-lines))) + (push pending-test-case test-cases) + (return (nreverse test-cases)))))) (defun parse-golden-file (file-name) "Convenience wrapper around PARSE-GOLDEN-STREAM." @@ -281,7 +323,8 @@ IF-EXISTS has the standard Common Lisp meaning. See http://l1sp.org/cl/open." (dolist (file file-paths-list) (format t "~&Updating ~A" file) (alexandria:write-string-into-file - (join-strings (loop :for input :in (parse-golden-file file) + (join-strings (loop :for test-case :in (parse-golden-file file) + :for input := (golden-test-case-input test-case) :for output := (funcall output-callback input) :collect "# Input" :collect input From c3f6424821789d19c504cf90c4e6f971a5fbccd5 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Sun, 2 Jun 2019 21:11:59 -0500 Subject: [PATCH 15/18] Add MAP-GOLDEN-FILES-AND-TEST-CASES This is a convenience wrapper for writing golden file tests that handles iterating over golden files and any GOLDEN-TEST-CASEs they include, as well as reporting status about the current file and test case being processed. --- tests/printer-tests.lisp | 48 +++++++++++++++++++--------------------- tests/utilities.lisp | 26 ++++++++++++++++++++++ 2 files changed, 49 insertions(+), 25 deletions(-) diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index d785b355c..901ee5adc 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -49,31 +49,29 @@ admonition against carelessness." (let ((golden-files (uiop:directory-files *printer-test-files-directory* #P"*.quil"))) (is (not (null golden-files))) - (dolist (file golden-files) - (format t "~& Testing file ~A" (pathname-name file)) - (loop :for test-case :in (parse-golden-file file) - :for input := (golden-test-case-input test-case) - :for expected-output := (golden-test-case-output test-case) - :for failure-message := (format nil "~&Golden test case at~%~A:~D" - (golden-test-case-file test-case) - (golden-test-case-line test-case)) - :do (let ((*always-show-failed-sexp* t)) - (format t "~& test case at line ~D" (golden-test-case-line test-case)) - - (let (actual-output) - ;; This SETF is ugly, but guarding this in a NOT-SIGNALS aids debugging in case - ;; PARSE-AND-PRINT-QUIL-TO-STRING chokes on INPUT. - (not-signals error (setf actual-output (parse-and-print-quil-to-string input))) - (not-signals error (quil:parse-quil actual-output)) - (is (string= expected-output actual-output) failure-message)) - - ;; Ensure expected-output is a fixed point of parse -> print. In rare cases, this - ;; check might fail, so skip it if we find a magic cookie at the start of the - ;; input section indicating that we should do so. - (unless (alexandria:starts-with-subseq "# Disable fixed-point check" input) - (is (string= expected-output - (parse-and-print-quil-to-string expected-output)) - failure-message))))))) + (map-golden-files-and-test-cases + (lambda (test-case) + (let ((*always-show-failed-sexp* t) + (input (golden-test-case-input test-case)) + (expected-output (golden-test-case-output test-case)) + (actual-output nil) + (message (format nil "~&Golden test case at (file:line): ~A:~D" + (golden-test-case-file test-case) + (golden-test-case-line test-case)))) + ;; This SETF is ugly, but guarding this in a NOT-SIGNALS aids debugging in case + ;; PARSE-AND-PRINT-QUIL-TO-STRING chokes on INPUT. + (not-signals error (setf actual-output (parse-and-print-quil-to-string input))) + (not-signals error (quil:parse-quil actual-output)) + (is (string= expected-output actual-output) message) + + ;; Ensure expected-output is a fixed point of parse -> print. In rare cases, this check + ;; might fail, so skip it if we find a magic cookie at the start of the input section + ;; indicating that we should do so. + (unless (alexandria:starts-with-subseq "# Disable fixed-point check" input) + (is (string= expected-output + (parse-and-print-quil-to-string expected-output)) + message)))) + golden-files))) (deftest test-instruction-fmt () (is (string= "PRAGMA gate_time CNOT \"50 ns\"" (format nil "~/cl-quil:instruction-fmt/" diff --git a/tests/utilities.lisp b/tests/utilities.lisp index 2b69900fe..7e514c699 100644 --- a/tests/utilities.lisp +++ b/tests/utilities.lisp @@ -299,6 +299,32 @@ and OUTPUT slots, respectively." (with-open-file (f file-name) (parse-golden-file-stream f))) +(defun map-golden-files-and-test-cases (test-case-function golden-files &optional (stream t)) + "Call TEST-CASE-FUNCTION on every GOLDEN-TEST-CASE found in the specified GOLDEN-FILES. + +This is a convenience wrapper for writing golden file tests that handles iterating over the +GOLDEN-FILES and their GOLDEN-TEST-CASEs as well as reporting status about the current file and test +case on the optional STREAM argument. + +Note that unlike standard MAP* functions, this function performs a nested, double iteration. +Roughly: + + (dolist (f golden-files) + (dolist (t (parse-golden-file f)) + (funcall test-case-function t))) + +TEST-CASE-FUNCTION is function that takes a single GOLDEN-TEST-CASE argument. + +GOLDEN-FILES is a LIST of PATHNAMEs indicating golden files to test. + +STREAM is an optional OUTPUT-STREAM for writing debug messages indicating the current file and test +case being processed. STREAM defaults to T." + (dolist (file golden-files) + (format stream "~& Testing golden file ~A at line:" (pathname-name file)) + (dolist (test-case (parse-golden-file file)) + (format stream " ~D" (golden-test-case-line test-case)) + (funcall test-case-function test-case)))) + (defun update-golden-file-output-sections (file-paths output-callback &key (if-exists ':supersede) skip-prompt) "Update all output sections of the golden files at FILE-PATHS. From b168c4c33cd142247cc4e5eb65951b904f0690fb Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Mon, 3 Jun 2019 11:38:39 -0500 Subject: [PATCH 16/18] Add descriptive names for DEFGATE/DEFCIRCUIT golden tests This aids debuggability in case of failing tests. --- tests/printer-test-files/defgates.quil | 16 +++---- .../delayed-expressions.quil | 46 +++++++++---------- tests/printer-test-files/gh-issue-249.quil | 8 ++-- .../printer-test-files/permutation-gates.quil | 12 ++--- 4 files changed, 41 insertions(+), 41 deletions(-) diff --git a/tests/printer-test-files/defgates.quil b/tests/printer-test-files/defgates.quil index 2b2e36bfa..0105f6ad4 100644 --- a/tests/printer-test-files/defgates.quil +++ b/tests/printer-test-files/defgates.quil @@ -6,36 +6,36 @@ # representation will be a "DEFGATE R as PERMUTATION" not a "DEFGATE R", hence we disable the # fixed-point check for this input. -DEFGATE R: +DEFGATE TEST-NOT-FIXED-POINT: exp(i*0), 0 0, exp(0/i) -R 0 +TEST-NOT-FIXED-POINT 0 # Output -DEFGATE R: +DEFGATE TEST-NOT-FIXED-POINT: 1.0, 0.0 0.0, 1.0 -R 0 +TEST-NOT-FIXED-POINT 0 # Input # If we modify the DEFGATE from the previous Input section slightly so that it's no longer a # permutation matrix, then the output passes the fixed-point check. -DEFGATE R: +DEFGATE TEST-FIXED-POINT: exp(i*0), 0 1, exp(0/i) -R 0 +TEST-FIXED-POINT 0 # Output -DEFGATE R: +DEFGATE TEST-FIXED-POINT: 1.0, 0.0 1.0, 1.0 -R 0 +TEST-FIXED-POINT 0 diff --git a/tests/printer-test-files/delayed-expressions.quil b/tests/printer-test-files/delayed-expressions.quil index d8829c2bc..02ad85702 100644 --- a/tests/printer-test-files/delayed-expressions.quil +++ b/tests/printer-test-files/delayed-expressions.quil @@ -1,36 +1,36 @@ # Input -DEFGATE TEST(%arg): +DEFGATE TEST-BINARY-ARITH(%arg): %arg+%arg, %arg-%arg %arg/%arg, %arg^%arg # Output -DEFGATE TEST(%arg): +DEFGATE TEST-BINARY-ARITH(%arg): (%arg+%arg), (%arg-%arg) (%arg/%arg), (%arg^%arg) # Input -DEFGATE TEST(%arg): +DEFGATE TEST-ARITH-ASSOC(%arg): 2*%arg+%arg/pi, %arg^2-%arg+2*%arg %arg*2/2*%arg, %arg^%arg^%arg # Output -DEFGATE TEST(%arg): +DEFGATE TEST-ARITH-ASSOC(%arg): (((2.0)*%arg)+(%arg/(pi))), (((%arg^(2.0))-%arg)+((2.0)*%arg)) (((%arg*(2.0))/(2.0))*%arg), (%arg^(%arg^%arg)) # Input -DEFGATE TEST(%arg): +DEFGATE TEST-FUNCTIONS(%arg): COS(%arg), SIN(%arg), CIS(%arg), SQRT(%arg) EXP(%arg), SIN(pi/%arg), COS(pi/2*%arg), CIS(%arg*i), SIN(2*%arg), EXP(1+%arg), SQRT(%arg^2), SQRT(%arg)^2 COS(SIN(%arg)), SIN(%arg)^2+COS(%arg)^2, SIN(%arg)/SIN(%arg), SIN(%arg)/COS(%arg) # Output -DEFGATE TEST(%arg): +DEFGATE TEST-FUNCTIONS(%arg): COS(%arg), SIN(%arg), CIS(%arg), SQRT(%arg) EXP(%arg), SIN(((pi)/%arg)), COS((((pi)/(2.0))*%arg)), CIS((%arg*(1.0i))) SIN(((2.0)*%arg)), EXP(((1.0)+%arg)), SQRT((%arg^(2.0))), (SQRT(%arg)^(2.0)) @@ -39,76 +39,76 @@ DEFGATE TEST(%arg): # Input -DEFGATE TEST(%arg): +DEFGATE TEST-EXPT-ASSOC(%arg): %arg*COS(%arg/2+2^2)^2^4, 0 0, 0 # Output -DEFGATE TEST(%arg): +DEFGATE TEST-EXPT-ASSOC(%arg): (%arg*(COS(((%arg/(2.0))+((2.0)^(2.0))))^((2.0)^(4.0)))), 0.0 0.0, 0.0 # Input -DEFGATE TEST(%arg1, %arg2, %arg3): +DEFGATE TEST-INFIX-ASSOC(%arg1, %arg2, %arg3): (%arg1*%arg2+(%arg3/pi)^2)/pi, 0 0, 0 # Output -DEFGATE TEST(%arg1, %arg2, %arg3): +DEFGATE TEST-INFIX-ASSOC(%arg1, %arg2, %arg3): (((%arg1*%arg2)+((%arg3/(pi))^(2.0)))/(pi)), 0.0 0.0, 0.0 # Input -DEFGATE TEST(%arg1, %arg2): +DEFGATE TEST-EXPT(%arg1, %arg2): 0, 0 0, %arg1^%arg2 # Output -DEFGATE TEST(%arg1, %arg2): +DEFGATE TEST-EXPT(%arg1, %arg2): 0.0, 0.0 0.0, (%arg1^%arg2) # Input -DEFGATE UNARY-MINUS(%arg1): +DEFGATE TEST-UNARY-MINUS(%arg1): 0, -1 0, -%arg1 # Output -DEFGATE UNARY-MINUS(%arg1): +DEFGATE TEST-UNARY-MINUS(%arg1): 0.0, -1.0 0.0, -(%arg1) # Input -DEFGATE R(%theta, %beta): +DEFGATE TEST-R(%theta, %beta): exp(%beta/3*i), 0 0, exp(%theta/2*i) -R(pi/2, pi/8) 0 +TEST-R(pi/2, pi/8) 0 # Output -DEFGATE R(%theta, %beta): +DEFGATE TEST-R(%theta, %beta): EXP(((%beta/(3.0))*(1.0i))), 0.0 0.0, EXP(((%theta/(2.0))*(1.0i))) -R(pi/2, pi/8) 0 +TEST-R(pi/2, pi/8) 0 # Input -DEFCIRCUIT TEST(%arg1, %arg2) p: +DEFCIRCUIT TEST-CIRCUIT-EXPANSION(%arg1, %arg2) p: RX(%arg1-%arg2) p -TEST(pi, pi*SIN(pi/2)) 0 +TEST-CIRCUIT-EXPANSION(pi, pi*SIN(pi/2)) 0 # Output -DEFCIRCUIT TEST(%arg1, %arg2) p: +DEFCIRCUIT TEST-CIRCUIT-EXPANSION(%arg1, %arg2) p: RX((%arg1-%arg2)) p @@ -117,14 +117,14 @@ RX(0.0) 0 # Input DECLARE int INTEGER[2] -DEFGATE MREF(%arg): +DEFGATE TEST-MREF(%arg): %arg*int, int[1]/%arg int[0]^%arg, COS(int+%arg) # Output DECLARE int INTEGER[2] -DEFGATE MREF(%arg): +DEFGATE TEST-MREF(%arg): (%arg*int[0]), (int[1]/%arg) (int[0]^%arg), COS((int[0]+%arg)) diff --git a/tests/printer-test-files/gh-issue-249.quil b/tests/printer-test-files/gh-issue-249.quil index b3a244c3c..c19ca16ff 100644 --- a/tests/printer-test-files/gh-issue-249.quil +++ b/tests/printer-test-files/gh-issue-249.quil @@ -1,14 +1,14 @@ # Input -DEFGATE TEST(%arg): +DEFGATE TEST-GH-ISSUE-249(%arg): COS(%arg)^2, 0 0, SIN(%arg)^2 -TEST(0.5) 0 +TEST-GH-ISSUE-249(0.5) 0 # Output -DEFGATE TEST(%arg): +DEFGATE TEST-GH-ISSUE-249(%arg): (COS(%arg)^(2.0)), 0.0 0.0, (SIN(%arg)^(2.0)) -TEST(0.5) 0 +TEST-GH-ISSUE-249(0.5) 0 diff --git a/tests/printer-test-files/permutation-gates.quil b/tests/printer-test-files/permutation-gates.quil index 64f2adc9d..fb19ba992 100644 --- a/tests/printer-test-files/permutation-gates.quil +++ b/tests/printer-test-files/permutation-gates.quil @@ -1,27 +1,27 @@ # Input -DEFGATE TEST: +DEFGATE TEST-PERM-01: pi/pi, 0 0, 2^4/16 # Output -DEFGATE TEST AS PERMUTATION: +DEFGATE TEST-PERM-01 AS PERMUTATION: 0, 1 # Input -DEFGATE TEST: +DEFGATE TEST-PERM-10: 0, 1 1, 0 # Output -DEFGATE TEST AS PERMUTATION: +DEFGATE TEST-PERM-10 AS PERMUTATION: 1, 0 # Input -DEFGATE PERM AS PERMUTATION: +DEFGATE PERM-AS-PERM AS PERMUTATION: 1, 0, 3, 2 # Output -DEFGATE PERM AS PERMUTATION: +DEFGATE PERM-AS-PERM AS PERMUTATION: 1, 0, 3, 2 From de79d1522c98263684d8db6ddd146103ee7c48a5 Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Tue, 4 Jun 2019 15:02:06 -0500 Subject: [PATCH 17/18] Prefix comments with ;;; not ;; inside eval-when --- src/parser.lisp | 68 ++++++++++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/src/parser.lisp b/src/parser.lisp index 708222b98..24fc9cf48 100644 --- a/src/parser.lisp +++ b/src/parser.lisp @@ -1525,8 +1525,8 @@ INPUT-STRING that triggered the condition." :documentation "Functions usable from within Quil, and their associated Lisp function symbols.") - ;; 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. + ;;; 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. (alexandria:define-constant +quil<->lisp-prefix-arithmetic-operators+ '(("-" . cl:-)) :test #'equal @@ -1553,38 +1553,38 @@ INPUT-STRING that triggered the condition." (alexandria: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+)) From 2fcde9c6c22368b206bd6b9eea25865a109234fe Mon Sep 17 00:00:00 2001 From: Mike Appleby <86076+appleby@users.noreply.github.com> Date: Tue, 4 Jun 2019 15:21:10 -0500 Subject: [PATCH 18/18] Convert remaining alexandria: references to spiffy new nickname a: --- src/parser.lisp | 10 +++++----- tests/printer-tests.lisp | 2 +- tests/utilities.lisp | 12 ++++++------ 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/parser.lisp b/src/parser.lisp index 24fc9cf48..82fe5f03c 100644 --- a/src/parser.lisp +++ b/src/parser.lisp @@ -1515,7 +1515,7 @@ INPUT-STRING that triggered the condition." (token-payload tok)))))) (eval-when (:compile-toplevel :load-toplevel :execute) - (alexandria:define-constant +quil<->lisp-functions+ + (a:define-constant +quil<->lisp-functions+ '(("SIN" . cl:sin) ("COS" . cl:cos) ("SQRT" . cl:sqrt) @@ -1527,13 +1527,13 @@ INPUT-STRING that triggered the condition." ;;; 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. - (alexandria:define-constant +quil<->lisp-prefix-arithmetic-operators+ + (a:define-constant +quil<->lisp-prefix-arithmetic-operators+ '(("-" . cl:-)) :test #'equal :documentation "Prefix arithmetic operators usable from within Quil, and their associated Lisp function symbols.") - (alexandria:define-constant +quil<->lisp-infix-arithmetic-operators+ + (a:define-constant +quil<->lisp-infix-arithmetic-operators+ '(("+" . cl:+) ("-" . cl:-) ("/" . cl:/) @@ -1545,12 +1545,12 @@ INPUT-STRING that triggered the condition." (defun %lisp->quil (lisp-symbol alist) (check-type lisp-symbol symbol) - (alexandria:when-let ((found (rassoc lisp-symbol alist :test #'eq))) + (a:when-let ((found (rassoc lisp-symbol alist :test #'eq))) (car found))) (defun %quil->lisp (quil-string alist) (check-type quil-string string) - (alexandria:when-let ((found (assoc quil-string alist :test #'string-equal))) + (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 diff --git a/tests/printer-tests.lisp b/tests/printer-tests.lisp index 901ee5adc..90b3dfbf0 100644 --- a/tests/printer-tests.lisp +++ b/tests/printer-tests.lisp @@ -67,7 +67,7 @@ admonition against carelessness." ;; Ensure expected-output is a fixed point of parse -> print. In rare cases, this check ;; might fail, so skip it if we find a magic cookie at the start of the input section ;; indicating that we should do so. - (unless (alexandria:starts-with-subseq "# Disable fixed-point check" input) + (unless (a:starts-with-subseq "# Disable fixed-point check" input) (is (string= expected-output (parse-and-print-quil-to-string expected-output)) message)))) diff --git a/tests/utilities.lisp b/tests/utilities.lisp index 7e514c699..9f6d1f5f3 100644 --- a/tests/utilities.lisp +++ b/tests/utilities.lisp @@ -182,7 +182,7 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." ;;; "# Output" is required; otherwise, UPDATE-GOLDEN-FILE-OUTPUT-SECTIONS will fail when attempting ;;; to parse the file. -(define-condition golden-file-parse-error (alexandria:simple-parse-error) +(define-condition golden-file-parse-error (a:simple-parse-error) ((line-number :initarg :line-number :initform 0 @@ -197,9 +197,9 @@ If SUFFIX-P is non-nil, suffix the returned string with DELIMITER." (format stream "Error while parsing golden file at line ~D." (golden-file-parse-error-line-number condition)) - (alexandria:when-let ((bad-text (golden-file-parse-error-bad-text condition))) + (a:when-let ((bad-text (golden-file-parse-error-bad-text condition))) (format stream "~&Invalid text: ~S" bad-text)) - (alexandria:when-let ((format-control (simple-condition-format-control condition))) + (a:when-let ((format-control (simple-condition-format-control condition))) (apply #'format stream (concatenate 'string "~&" format-control) (simple-condition-format-arguments condition))))) @@ -239,7 +239,7 @@ and OUTPUT slots, respectively." :format-control format-control :format-arguments format-arguments)) (stream-file-name (stream) - (alexandria:if-let ((path (uiop:truename* stream))) + (a:if-let ((path (uiop:truename* stream))) (enough-namestring path) ;; If STREAM is not a FILE-STREAM, it won't have an a TRUENAME. Just format the STREAM. (format nil "~A" stream)))) @@ -340,7 +340,7 @@ OUTPUT-CALLBACK is function from STRING -> STRING. It will be called successivel golden-file input section, and should return the corresponding output string for the given input. IF-EXISTS has the standard Common Lisp meaning. See http://l1sp.org/cl/open." - (let ((file-paths-list (alexandria:ensure-list file-paths))) + (let ((file-paths-list (a:ensure-list file-paths))) (when (or skip-prompt (y-or-n-p "Are you sure you want to clobber all the output sections of the following files?~%~@ @@ -348,7 +348,7 @@ IF-EXISTS has the standard Common Lisp meaning. See http://l1sp.org/cl/open." file-paths-list)) (dolist (file file-paths-list) (format t "~&Updating ~A" file) - (alexandria:write-string-into-file + (a:write-string-into-file (join-strings (loop :for test-case :in (parse-golden-file file) :for input := (golden-test-case-input test-case) :for output := (funcall output-callback input)