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

CFG path contraction condition was removing entry blocks #912

Merged
merged 2 commits into from
Jan 23, 2024
Merged

CFG path contraction condition was removing entry blocks #912

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6328e88
CFG path contraction condition was removing entry blocks
macrologist Jan 18, 2024
2ea7e70
Test path contraction doesn't drop valid labeled blocks
macrologist Jan 22, 2024
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
57 changes: 36 additions & 21 deletions src/cfg.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -226,7 +226,7 @@ Return the following values:
;; is the current block non-empty?
(unless (zerop (length (basic-block-code blk)))
;; build a new block with an unconditional edge coming from the old one
(let ((new-blk (find-or-make-block-from-label cfg (label (princ-to-string (gensym "RESET-"))))))
(let ((new-blk (make-instance 'basic-block :name (gensym "RESET-"))))
(link-blocks blk
(unconditional-edge new-blk))
(setf blk new-blk)))
Expand Down Expand Up @@ -415,9 +415,15 @@ Return the following values:
(let ((blk (pop dirty)))
(when (= 1 (num-edges-in blk))
(let ((parent (first (parents-without-self blk))))
;; Check each merging condition until one has been reached, which then applies a specific operation to merge the blocks.
;; Check each merging condition until one has been
;; reached, which then applies a specific operation to
;; merge the blocks.
(cond
;; Condition 1) Extended self-loops can be merged into smaller self loops if there is only 1 edge incoming (excluding self loops, 1 child, if the child is the same block as the parent, and if there is no code within the block
;; Condition 1) Extended self-loops can be merged into
;; smaller self loops if there is only 1 edge incoming
;; (excluding self loops, 1 child, if the child is the
;; same block as the parent, and if there is no code
;; within the block
((and
(= 1 (length (children blk)))
(eq parent (first (children blk)))
Expand Down Expand Up @@ -453,27 +459,36 @@ Return the following values:
;; Add the parent to the node list
(add-dirty-block parent))

;; Condition 2) Paths can be contracted when a block has one parent, that parent has one outgoing edge, and neither are the exit or entry block. There is
;; also the extra condition that and edge cannot be contracted if doing so would cause previously isolated code to be possibly run within a loop.
((and (or (empty-block-p blk)
(not (> (length (children parent)) 1)))
(or (empty-block-p parent)
(not (find blk (incoming blk))))
(= 1 (length (children parent)))
(or (and (typep parent 'preserved-block)
(typep blk 'preserved-block))
(and (not (typep parent 'preserved-block))
(not (typep blk 'preserved-block))))
(or (typep blk 'reset-block)
(not (basic-block-out-rewiring parent))
(not (basic-block-in-rewiring blk))
(equalp (basic-block-out-rewiring parent)
(basic-block-in-rewiring blk))))

;; Condition 2) Paths can be contracted when a block
;; has one parent, that parent has one outgoing edge,
;; and neither are the exit or entry block. There is
;; also the extra condition that and edge cannot be
;; contracted if doing so would cause previously
;; isolated code to be possibly run within a loop.
((and
(or (empty-block-p parent)
(not (find blk (incoming blk))))
(= 1 (length (children parent)))
(or (not (labeled blk))
(and (= 1 (length (incoming blk)))
(adt:match outgoing-edge (outgoing parent)
(unconditional-edge t)
(_ nil))))
(or (and (typep parent 'preserved-block)
(typep blk 'preserved-block))
(and (not (typep parent 'preserved-block))
(not (typep blk 'preserved-block))))
(or (typep blk 'reset-block)
(not (basic-block-out-rewiring parent))
(not (basic-block-in-rewiring blk))
(equalp (basic-block-out-rewiring parent)
(basic-block-in-rewiring blk))))

;; The conditions are met to sequentially merge these blocks
(let ((new-blk (merge-sequentially parent blk)))
;; After getting a merged block, update the CFG
;; Update the references of affected blocks within the cfg

(dolist (child (children new-blk))
(setf (incoming child)
(substitute new-blk blk (incoming child))))
Expand Down Expand Up @@ -581,7 +596,7 @@ Return the following values:
(let* ((code (parsed-program-executable-code pp))
(entry (make-instance 'basic-block :name (gensym "ENTRY-BLK-") :outgoing terminating-edge))
(cfg (make-instance 'cfg :entry-point entry
:blocks (list entry))))
:blocks (list entry))))
(flet ((next (current-block)
(or current-block (make-instance 'basic-block))))
(loop :with finished-block := nil
Expand Down
30 changes: 30 additions & 0 deletions tests/cfg-tests.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -157,6 +157,35 @@
(quil::print-code-list (quil::basic-block-code merged-blk) out))
(format nil "X 0~%Y 0~%Z 0~%")))))




(defun test-contract-paths-with-loops (src)
(let* ((p (quil::parse-quil src))
(cfg (cl-quil::program-cfg p :dce t :simplify t))
(blocks (quil::cfg-blocks cfg)))
;; test that every label that appears in a conditional or
;; unconditional edge points to a block that remains in the
;; simplified CFG
(flet ((labeled-block-exists-p (blk)
(or (not (quil::labeled blk))
(find (gethash (quil::label-name (quil::labeled blk)) (quil::label-table cfg))
blocks))))
(is (every (lambda (blk)
(adt:match quil::outgoing-edge (quil::outgoing blk)
((quil::conditional-edge _ thenblk elseblk)
(and (labeled-block-exists-p thenblk)
(labeled-block-exists-p elseblk)))
((quil::unconditional-edge tgtblk)
(labeled-block-exists-p tgtblk))
(_ t)))
blocks)))))

(deftest test-path-contractions-with-loops ()
(test-contract-paths-with-loops "DECLARE ro BIT;DECLARE shot_count INTEGER[1];LABEL @START;SUB shot_count[0] 1;JUMP-UNLESS @END shot_count[0];JUMP @START;LABEL @END")
(test-contract-paths-with-loops "LABEL @START-LOOP;CCNOT 0 1 2;JUMP @START-LOOP"))


(deftest test-block-fusion-empty-single-unconditional-self-loop ()
"Tests the operation of block fusion when the CFG has an unconditional self-loop with a single empty block."
(let* ((p (quil::parse-quil "LABEL @START;H 0;JUMP @LOOPER;LABEL @LOOPER;JUMP @START"))
Expand Down Expand Up @@ -211,3 +240,4 @@ This is a regression test for https://github.com/rigetti/quilc/issues/244"
(let* ((program (parse "RESET; PRAGMA PRESERVE_BLOCK; X 0; PRAGMA END_PRESERVE_BLOCK"))
(cfg (quil::program-cfg program)))
(is (typep (quil::entry-point cfg) 'quil::reset-block))))

Loading