Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add process-protoquil transform and use it in app and lib #897

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Add process-protoquil transform and use it in app and lib #897

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
fb54ac7
Add process-protoquil transform and use it in app and lib
notmgsk Aug 9, 2023
ffab65c
fix
notmgsk Aug 14, 2023
bffea7f
export process-protoquil
notmgsk Sep 29, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
76 changes: 1 addition & 75 deletions app/src/entry-point.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -497,15 +497,7 @@ Returns a values tuple (PROCESSED-PROGRAM, STATISTICS), where PROCESSED-PROGRAM
(compiler-hook program chip-specification :protoquil protoquil :destructive t)

(when protoquil
;; if we're supposed to output protoQuil, we strip circuit and
;; gate definitions
(setf (parsed-program-circuit-definitions processed-program) nil
(parsed-program-gate-definitions processed-program) nil)

;; if we're supposed to output protoQuil, we also need to
;; strip the final HALT instructions from the output
(setf (parsed-program-executable-code processed-program)
(strip-final-halt-respecting-rewirings processed-program))
(cl-quil.frontend::transform 'cl-quil::process-protoquil processed-program)

;; Compute statistics for protoquil program
(compute-statistics processed-program chip-specification statistics :gate-whitelist gate-whitelist :gate-blacklist gate-blacklist)
Expand Down Expand Up @@ -587,69 +579,3 @@ This function will have undefined behavior when PROCESSED-PROGRAM is not protoqu

statistics)

(defun strip-final-halt-respecting-rewirings (processed-program)
"Remove the final HALT instruction, if any, from PROCESSED-PROGRAM, retaining any attached rewiring comments."
(let* ((instructions (parsed-program-executable-code processed-program))
(last-instruction (and (plusp (length instructions))
(cl-quil::nth-instr 0 processed-program :from-end t)))
(penultimate-instruction (and (< 1 (length instructions))
(cl-quil::nth-instr 1 processed-program :from-end t)))
(must-transfer-comment-p (and (not (null penultimate-instruction))
(comment last-instruction))))

(unless (cl-quil::haltp last-instruction)
(return-from strip-final-halt-respecting-rewirings instructions))

(when must-transfer-comment-p
;; Transfer the rewiring comment from LAST-INSTRUCTION to
;; PENULTIMATE-INSTRUCTION.
(multiple-value-bind (last-entering last-exiting)
(cl-quil::instruction-rewirings last-instruction)
(multiple-value-bind (penultimate-entering penultimate-exiting)
(cl-quil::instruction-rewirings penultimate-instruction)
(flet ((assert-rewirings-compatible (rewiring-type last-rewiring penultimate-rewiring)
;; This bit of hoop-jumping guards against the
;; unlikely event that both PENULTIMATE-INSTRUCTION
;; and LAST-INSTRUCTION have rewiring comments
;; attached which might be incompatible. We check
;; to ensure that either one of the rewirings is
;; NULL, or else they are EQUALP and can safely be
;; merged.
(assert (or (or (null last-rewiring)
(null penultimate-rewiring))
(equalp last-rewiring penultimate-rewiring))
()
"Failed to strip final HALT. Instructions have incompatible ~A rewirings:~@
LAST: ~A ~A~@
PREV: ~A ~A"
rewiring-type last-instruction last-rewiring
penultimate-instruction penultimate-rewiring)))
(assert-rewirings-compatible ':ENTERING last-entering penultimate-entering)
(assert-rewirings-compatible ':EXITING last-exiting penultimate-exiting))
;; Consider the following cases for the :ENTERING rewirings
;; (the same case analysis applies to the :EXITING rewiring
;; pair as well).
;;
;; 1) If both the rewirings are non-NIL, then the
;; ASSERT-REWIRINGS-COMPATIBLE check above guarantees
;; that they are EQUALP, and it doesn't matter which one
;; we select.
;;
;; 2) If only one is non-NIL, the OR selects it.
;;
;; 3) If both are NIL, then MAKE-REWIRING-COMMENT just
;; ignores that keyword argument, and returns an :EXITING
;; rewiring.
;;
;; Finally, (COMMENT LAST-INSTRUCTION) is non-NIL (otherwise
;; MUST-TRANSFER-COMMENT-P would be NIL), so at least one of
;; LAST-ENTERING and LAST-EXITING is non-NIL, which means
;; that at least one of the :ENTERING and :EXITING keyword
;; args to MAKE-REWIRING-COMMENT is non-NIL and hence the
;; call will produce a rewiring comment.
(setf (comment penultimate-instruction)
(cl-quil::make-rewiring-comment :entering (or last-entering penultimate-entering)
:exiting (or last-exiting penultimate-exiting))))))

;; Strip the final HALT instruction.
(subseq instructions 0 (1- (length instructions)))))
140 changes: 0 additions & 140 deletions app/tests/misc-tests.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,144 +46,4 @@
(is (eq thing (quilc::special-bindings-let* ((not-special thing))
(bt:join-thread (bt:make-thread (lambda () not-special))))))))

(defun attach-rewirings-at-index (pp index &rest args &key entering exiting)
;; Like CL-QUIL-TESTS::ATTACH-REWIRINGS-TO-PROGRAM, but instead of attaching the rewiring on the
;; first/last instr of PP, attach the rewiring at the requested INDEX.
(check-type entering (or null quil::integer-vector))
(check-type exiting (or null quil::integer-vector))
(assert (or entering exiting))
(setf (quil:comment (quil::nth-instr index pp))
(apply #'quil::make-rewiring-comment args))
pp)

(deftest test-strip-final-halt-respecting-rewirings ()
;; An empty program produces an empty vector
(is (equalp #() (quilc::strip-final-halt-respecting-rewirings (quil:parse-quil ""))))

;; Only a single final HALT is stripped.
(let* ((pp (quil:parse-quil "X 0; HALT; HALT"))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))
(is (= 2 (length stripped-code)))
(is (quil::haltp (quil::vnth 1 stripped-code))))

;; Mid-program HALTs are ignored.
(let* ((pp (with-output-to-quil
"JUMP @SKIPHALT"
"HALT"
"LABEL @SKIPHALT"
"HALT"))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))
(is (= 3 (length stripped-code)))
(is (quil::haltp (quil::vnth 1 stripped-code)))
(is (not (quil::haltp (quil::vnth 2 stripped-code)))))

;; single non-halt instr
(let* ((pp (attach-rewirings-at-index (quil:parse-quil "X 0")
0
:entering #(0 1 2)
:exiting #(2 1 0)))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))
(is (= 1 (length stripped-code)))
(multiple-value-bind (entering-rewiring exiting-rewiring)
(quil::instruction-rewirings (quil::vnth 0 stripped-code))
(is (equalp #(0 1 2) (quil::rewiring-l2p entering-rewiring)))
(is (equalp #(2 1 0) (quil::rewiring-l2p exiting-rewiring)))))

;; single halt instr
(let* ((pp (attach-rewirings-at-index (quil:parse-quil "HALT")
0
:entering #(0 1 2)
:exiting #(2 1 0)))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))
(is (equalp #() stripped-code)))

;; 2-instr no halts, entering/exiting rewirings untouched
(let* ((pp (quil:parse-quil "X 0; Y 1"))
(pp (attach-rewirings-at-index pp 0 :entering #(0 1 2) :exiting #(2 1 0)))
(pp (attach-rewirings-at-index pp 1 :entering #(1 2 0) :exiting #(0 2 1)))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))
(is (= 2 (length stripped-code)))
(multiple-value-bind (entering-rewiring exiting-rewiring)
(quil::instruction-rewirings (quil::vnth 0 stripped-code))
(is (equalp #(0 1 2) (quil::rewiring-l2p entering-rewiring)))
(is (equalp #(2 1 0) (quil::rewiring-l2p exiting-rewiring))))
(multiple-value-bind (entering-rewiring exiting-rewiring)
(quil::instruction-rewirings (quil::vnth 1 stripped-code))
(is (equalp #(1 2 0) (quil::rewiring-l2p entering-rewiring)))
(is (equalp #(0 2 1) (quil::rewiring-l2p exiting-rewiring)))))

;; {2,3}-instruction terminal halt
(dolist (quil '("X 0; HALT" "H 0; CNOT 0 1; HALT"))
(labels ((attach-rewirings (&key last-entering last-exiting
penultimate-entering penultimate-exiting)
(let* ((pp (quil:parse-quil quil))
(last-index (1- (length (quil::parsed-program-executable-code pp))))
(penultimate-index (1- last-index)))

;; attach the rewirings
(when (or last-entering last-exiting)
(setf pp (attach-rewirings-at-index pp last-index
:entering last-entering
:exiting last-exiting)))
(when (or penultimate-entering penultimate-exiting)
(setf pp (attach-rewirings-at-index pp penultimate-index
:entering penultimate-entering
:exiting penultimate-exiting)))
;; return the parsed-program
pp))
(test-compatible (&rest args &key last-entering last-exiting
penultimate-entering penultimate-exiting)
(let* ((pp (apply #'attach-rewirings args))
(stripped-code (quilc::strip-final-halt-respecting-rewirings pp)))

;; final HALT was stripped
(is (= (length stripped-code) (1- (length (quil::parsed-program-executable-code pp)))))

;; rewirings were correctly copied
(multiple-value-bind (stripped-entering stripped-exiting)
(quil::instruction-rewirings (quil::vnth (1- (length stripped-code))
stripped-code))
(is (equalp (or last-entering penultimate-entering)
(and stripped-entering (quil::rewiring-l2p stripped-entering))))
(is (equalp (or last-exiting penultimate-exiting)
(and stripped-exiting (quil::rewiring-l2p stripped-exiting)))))))

(test-incompatible (&rest args &key last-entering last-exiting
penultimate-entering penultimate-exiting)
(declare (ignore last-entering last-exiting penultimate-entering penultimate-exiting))
(signals error (quilc::strip-final-halt-respecting-rewirings
(apply #'attach-rewirings args)))))

;; various compatible combos of entering/exiting rewirings
(test-compatible)
(test-compatible :last-entering #(1 2 0))
(test-compatible :last-entering #(1 2 0) :penultimate-entering #(1 2 0))
(test-compatible :last-entering #(1 2 0) :penultimate-exiting #(2 1 0))
(test-compatible :last-exiting #(0 2 1)) ; common case (probably).
(test-compatible :last-exiting #(0 2 1) :penultimate-exiting #(0 2 1))
(test-compatible :last-exiting #(0 2 1) :penultimate-entering #(0 1 2))
(test-compatible :penultimate-entering #(0 1 2))
(test-compatible :last-entering #(1 2 0)
:last-exiting #(0 2 1))
(test-compatible :last-entering #(1 2 0)
:last-exiting #(0 2 1)
:penultimate-exiting #(0 2 1))
(test-compatible :last-entering #(1 2 0)
:last-exiting #(0 2 1)
:penultimate-entering #(1 2 0))
(test-compatible :last-entering #(1 2 0)
:last-exiting #(0 2 1)
:penultimate-entering #(1 2 0)
:penultimate-exiting #(0 2 1))
(test-compatible :penultimate-entering #(0 1 2)
:penultimate-exiting #(2 1 0))
(test-compatible :last-entering #(0 1 2)
:penultimate-entering #(0 1 2)
:penultimate-exiting #(2 1 0))
(test-compatible :last-exiting #(2 1 0)
:penultimate-entering #(0 1 2)
:penultimate-exiting #(2 1 0))

;; various incompatible combos of entering/exiting rewirings
(test-incompatible :last-entering #(0 1 2) :penultimate-entering #(0 1 3))
(test-incompatible :last-exiting #(2 1 0) :penultimate-exiting #(3 1 0)))))
3 changes: 2 additions & 1 deletion cl-quil.asd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,8 @@
(:file "fusion")
(:file "simplify-arithmetic")
(:file "validate-sequence-gate")
(:file "simplification-grab-bag")))
(:file "simplification-grab-bag")
(:file "process-protoquil")))
(:file "print-program")
(:file "initialize-standard-gates")))

Expand Down
4 changes: 3 additions & 1 deletion lib/src/libquilc.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,9 @@
(return-from error-map 1)))))

(defun compile-protoquil (parsed-program chip-specification)
(compiler-hook parsed-program chip-specification :protoquil t))
(let ((compiled-program (compiler-hook parsed-program chip-specification :protoquil t)))
(cl-quil.frontend::transform 'cl-quil.frontend::process-protoquil compiled-program)
compiled-program))

(sbcl-librarian:define-api quilc (:error-map error-map
:function-prefix "quilc_")
Expand Down
80 changes: 80 additions & 0 deletions src/analysis/process-protoquil.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,80 @@
(in-package #:cl-quil.frontend)

(define-transform process-protoquil (process-protoquil)
"Removes HALT, DEFCIRCUIT, and DEFGATE instructions.")

(defun process-protoquil (parsed-program)
(setf (parsed-program-circuit-definitions parsed-program) nil
(parsed-program-gate-definitions parsed-program) nil)

;; if we're supposed to output protoQuil, we also need to
;; strip the final HALT instructions from the output
(setf (parsed-program-executable-code parsed-program)
(strip-final-halt-respecting-rewirings parsed-program)))

(defun strip-final-halt-respecting-rewirings (processed-program)
"Remove the final HALT instruction, if any, from PROCESSED-PROGRAM, retaining any attached rewiring comments."
(let* ((instructions (parsed-program-executable-code processed-program))
(last-instruction (and (plusp (length instructions))
(cl-quil::nth-instr 0 processed-program :from-end t)))
(penultimate-instruction (and (< 1 (length instructions))
(cl-quil::nth-instr 1 processed-program :from-end t)))
(must-transfer-comment-p (and (not (null penultimate-instruction))
(comment last-instruction))))

(unless (cl-quil::haltp last-instruction)
(return-from strip-final-halt-respecting-rewirings instructions))

(when must-transfer-comment-p
;; Transfer the rewiring comment from LAST-INSTRUCTION to
;; PENULTIMATE-INSTRUCTION.
(multiple-value-bind (last-entering last-exiting)
(cl-quil::instruction-rewirings last-instruction)
(multiple-value-bind (penultimate-entering penultimate-exiting)
(cl-quil::instruction-rewirings penultimate-instruction)
(flet ((assert-rewirings-compatible (rewiring-type last-rewiring penultimate-rewiring)
;; This bit of hoop-jumping guards against the
;; unlikely event that both PENULTIMATE-INSTRUCTION
;; and LAST-INSTRUCTION have rewiring comments
;; attached which might be incompatible. We check
;; to ensure that either one of the rewirings is
;; NULL, or else they are EQUALP and can safely be
;; merged.
(assert (or (or (null last-rewiring)
(null penultimate-rewiring))
(equalp last-rewiring penultimate-rewiring))
()
"Failed to strip final HALT. Instructions have incompatible ~A rewirings:~@
LAST: ~A ~A~@
PREV: ~A ~A"
rewiring-type last-instruction last-rewiring
penultimate-instruction penultimate-rewiring)))
(assert-rewirings-compatible ':ENTERING last-entering penultimate-entering)
(assert-rewirings-compatible ':EXITING last-exiting penultimate-exiting))
;; Consider the following cases for the :ENTERING rewirings
;; (the same case analysis applies to the :EXITING rewiring
;; pair as well).
;;
;; 1) If both the rewirings are non-NIL, then the
;; ASSERT-REWIRINGS-COMPATIBLE check above guarantees
;; that they are EQUALP, and it doesn't matter which one
;; we select.
;;
;; 2) If only one is non-NIL, the OR selects it.
;;
;; 3) If both are NIL, then MAKE-REWIRING-COMMENT just
;; ignores that keyword argument, and returns an :EXITING
;; rewiring.
;;
;; Finally, (COMMENT LAST-INSTRUCTION) is non-NIL (otherwise
;; MUST-TRANSFER-COMMENT-P would be NIL), so at least one of
;; LAST-ENTERING and LAST-EXITING is non-NIL, which means
;; that at least one of the :ENTERING and :EXITING keyword
;; args to MAKE-REWIRING-COMMENT is non-NIL and hence the
;; call will produce a rewiring comment.
(setf (comment penultimate-instruction)
(cl-quil::make-rewiring-comment :entering (or last-entering penultimate-entering)
:exiting (or last-exiting penultimate-exiting))))))

;; Strip the final HALT instruction.
(subseq instructions 0 (1- (length instructions)))))
6 changes: 6 additions & 0 deletions src/package.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -733,6 +733,12 @@
#:simplify-individual-instructions ; TRANSFORM
)


;; analysis/process-protoquil.lisp
(:export
#:process-protoquil ; TRANSFORM
)

(:shadow
#:pi)
)
Expand Down
Loading
Loading