refactor chip-contiguous-subschedule-from-last-instructions to non-re…

…cursive

src/addresser/outgoing-schedule.lisp

@@ -123,39 +123,45 @@ 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)
+  "mark-predecessors-seen performs a breadth 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 (first queue))
+                   (predecessors (gethash v earlier-instrs))
+                   )
+               (setf queue (cdr queue))
+               (loop for predecessor in predecessors 
+                     do (unless (gethash predecessor seen)
+                          (setf (gethash predecessor seen) t)
+                          (setf queue (append queue (list predecessor)))))
+               )))
+  )
+
+(defun chip-contiguous-subschedule-from-last-instructions (schedule resource)
+  "chip-contiguous-subschedule-from-last-instruction 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.
+    (loop while leaves
+          do (let ((instr (first leaves)))
+               (setq leaves (cdr leaves))
                (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)))
+                         (resource-subsetp (instruction-resources instr) resource)) 
                     (push instr sched)
-                    (map nil #'bottoms-up (reverse (gethash instr earlier-instrs))))))))
-      (map nil #'bottoms-up last-instrs)
-      sched)))
+                    (setf (gethash instr seen) t)
+                    (setf leaves (append leaves (reverse (gethash instr earlier-instrs)))))
+                   ((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."