refactor chip-contiguous-subschedule-from-last-instructions to non-recursive

Author: erichulburd

src/addresser/outgoing-schedule.lisp

@@ -123,39 +123,38 @@ If POINT is generated by CHIP-SCHEDULE-RESOURCE-CARVING-POINT, then the resultin
    #'<
    :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 ((queue (list instr)))
+    (loop :while queue :do 
+      (let* ((v (pop queue))
+             (predecessors (gethash v earlier-instrs)))
+        (loop :for predecessor :in predecessors :do 
+          (unless (gethash predecessor seen)
+            (setf (gethash predecessor seen) t)
+            (push predecessor queue)))))))
+
+(defun chip-contiguous-subschedule-from-last-instructions (schedule resource)
+  "loops over the last instructions in the SCHEDULE and returns an arbitrarily ordered list of instructions in the SCHEDULE that are contiguous and involve a subset of resources 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)
+             ;; reverse loop across INSTR's EARLIER-INSTRS and prepend to LEAVES.
+             (loop :for earlier-instr :in (gethash instr earlier-instrs) :do
+               (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."