Make chip-contiguous-subschedule-from-last-instructions non-recursive

src/addresser/outgoing-schedule.lisp

@@ -108,54 +108,36 @@ BEFORE-INST to make use of RESOURCE."
         :when (carving-point-p resource instr)
           :maximize (chip-schedule-end-time schedule instr)))
 
-(defun chip-schedule-from-carving-point (schedule resource point)
-  "Returns the (time-ordered) subsequence of instructions from SCHEDULE which intersect RESOURCE and which start on or after the time POINT.
-
-If POINT is generated by CHIP-SCHEDULE-RESOURCE-CARVING-POINT, then the resulting subsequence has a further \"information light-cone\" property: SCHEDULE will have no other instructions which can receive information from RESOURCE from after POINT."
-  ;; NOTE: This could be written in such a way that GETHASH is called only once:
-  ;;       grab it inside of LOOP and attach it to INSTR by a CONS cell, then
-  ;;       change SORT's KEY to grab that value, then strip the cells away at end.
-  (sort
-   (loop :for instr :being :the :hash-keys :of (chip-schedule-times schedule)
-         :when (and (<= point (chip-schedule-start-time schedule instr))
-                    (resources-intersect-p resource (instruction-resources instr)))
-           :collect instr)
-   #'<
-   :key (lambda (i) (gethash i (chip-schedule-times schedule)))))
-
-;; TODO Make this non-recursive so we can avoid blowing the stack on
-;; veeeerrrrry deep programs.
-(defun chip-contiguous-subschedule-from-last-instructions (schedule resource) 
-  "Returns an unordered contiguous subsequence of instructions from SCHEDULE where each instruction is in the dependency graph of the last instructions in SCHEDULE and touches only resources in RESOURCE."
+(defun mark-predecessors-seen (instr earlier-instrs seen)
+  "Performs a depth first search on INSTR as the root node and marks all of its descendants as true in hash-table SEEN."
+  (let ((stack (list instr)))
+    (loop :while stack :do
+      (let ((predecessors (gethash (pop stack) earlier-instrs)))
+        (dolist (predecessor predecessors)
+          (unless (gethash predecessor seen)
+            (setf (gethash predecessor seen) t)
+            (push predecessor stack)))))))
+
+(defun chip-contiguous-subschedule-from-last-instructions (schedule resource)
+  "Returns an unordered list of instructions from SCHEDULE such that each instruction involves a subset of RESOURCE. Traversal of the schedule begins from the latest scheduled instructions and works backwards into earlier instructions until an instruction uses resources not in RESOURCE."
   (let* ((lsched         (chip-schedule-data schedule))
-         (last-instrs    (lscheduler-last-instrs lsched))
          (earlier-instrs (lscheduler-earlier-instrs lsched))
          (seen           (make-hash-table))
+         (leaves         (lscheduler-last-instrs lsched))
          (sched          nil))
-    (labels ((mark-predecessors-seen (instr)
-               (cond ((resource= (instruction-resources instr)
-                                 resource)
-                      (setf (gethash instr seen) t))
-                     ((resource-subsetp (instruction-resources instr)
-                                        resource)
-                      (map nil #'mark-predecessors-seen (gethash instr earlier-instrs)))))
-             (bottoms-up (instr)
-               ;; Recursively explorer earlier instructions in the
-               ;; schedule. Instructions are collected if their
-               ;; resources are a subset of RESOURCE. If a carving
-               ;; point is encountered, mark all earlier instructions
-               ;; as seen.
-               (unless (gethash instr seen)
-                 (setf (gethash instr seen) t)
-                 (cond
-                   ((carving-point-p resource instr)
-                    (map nil #'mark-predecessors-seen (reverse (gethash instr earlier-instrs))))
-                   ((and (resources-intersect-p resource (instruction-resources instr))
-                         (not (carving-point-p resource instr)))
-                    (push instr sched)
-                    (map nil #'bottoms-up (reverse (gethash instr earlier-instrs))))))))
-      (map nil #'bottoms-up last-instrs)
-      sched)))
+    (loop :while leaves :do
+      (let ((instr (pop leaves)))
+        (unless (gethash instr seen)
+          (setf (gethash instr seen) t)
+          (cond
+            ((and (resources-intersect-p resource (instruction-resources instr))
+                  (resource-subsetp (instruction-resources instr) resource)) 
+             (push instr sched)
+             (dolist (earlier-instr (gethash instr earlier-instrs))
+               (push earlier-instr leaves)))
+            ((carving-point-p resource instr)
+             (mark-predecessors-seen instr earlier-instrs seen))))))
+    sched))
 
 (defun chip-schedule-qubit-times (schedule)
   "Find the first time a qubit is available, for each qubit in the schedule."

tests/addresser-tests.lisp

@@ -100,3 +100,26 @@
                    (quil::chip-contiguous-subschedule-from-last-instructions
                     sched (quil::make-qubit-resource 0 2))
                    expected-subschedule))))))
+
+(deftest test-fidelity-addresser-subschedule-on-deep-circuit ()
+  (let* ((chip (quil::build-nq-fully-connected-chip 3))
+         (sched (quil::make-chip-schedule chip))
+         (h0 (build-gate "H" nil 0))
+         (circuit-depth 25000))
+    (loop :for i :from 1 :to circuit-depth :do
+      (progn 
+        ;; these gates will exercise depth in the outer dfs, ie in 
+        ;; chip-contiguous-subschedule-from-last-instructions.
+        (quil::chip-schedule-append sched (build-gate "H" nil 0))
+        ;; these gates will exercise depth in the inner dfs, ie in
+        ;; mark-predecessors-seen.
+        (quil::chip-schedule-append sched (build-gate "H" nil 1))))
+    (flet ((is-h0 (gate)
+             (and (string= (quil::application-operator-root-name gate)
+                         (quil::application-operator-root-name h0))
+                (equalp (quil::application-parameters gate)
+                        (quil::application-parameters h0)))))
+      (let ((result (quil::chip-contiguous-subschedule-from-last-instructions sched (quil::make-qubit-resource 0))))
+        (is (= (length result) circuit-depth))
+        (is (every #'is-h0 result))))))
+