Newer
Older
;; Classes used by asdf-dependency-grovel.
;; Originally, this file just held some classes. Now it holds a bunch of
;; stuff. It should probably be renamed, or reorganized.
(cl:in-package #:asdf-dependency-grovel)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Used in a few macros; not exported. Why isn't this a standard CL macro?
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(mapcar #'(lambda (name) `(,name (gensym))) names) ,@body))
(defmacro do-until (condition &body body)
`(do () (,condition) ,@body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Heaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A binary minheap, which can be used as a priority queue.
(flet ((heap-key-function (heap) (car heap))
(heap-vector (heap) (cdr heap))
(parent-index (index) (values (floor (1- index) 2)))
(child-indices (index)
(let ((left (1+ (* 2 index))))
(values left (1+ left))))
(item-key (item) (car item))
(item-obj (item) (cdr item)))
(defun make-heap (&key key)
"Make an empty min-heap. The :key argument should be a function mapping
elements of the heap to a priority value (typically a number) by which
that item will be sorted. If no :key function is given, the element
itself is used as the priority value."
(unless key
(setf key (lambda (x) x)))
(cons key (make-array 0 :adjustable t :fill-pointer t)))
(defun heap-insert (obj heap)
(let* ((key (funcall (heap-key-function heap) obj))
(item (cons key obj))
(vec (heap-vector heap))
(index (vector-push-extend item vec)))
(do-until (= index 0)
(let ((pindex (parent-index index)))
(if (>= key (item-key (elt vec pindex)))
(return)
(psetf (elt vec index) (elt vec pindex)
(elt vec pindex) (elt vec index)
index pindex)))))
(values))
(defun heap-pop (heap)
"Remove the element with the smallest priority-value from the heap and
return two values: the element removed (or nil if the heap was already
empty), and a boolean that is nil if the heap was indeed already empty or
t otherwise."
(when (heap-empty-p heap)
(return-from heap-pop (values nil nil)))
(let* ((vec (heap-vector heap))
(min-obj (item-obj (elt vec 0)))
(item (vector-pop vec))
(length (fill-pointer vec)))
(when (> length 0)
(let ((key (item-key item))
(index 0))
(loop
(multiple-value-bind (lindex rindex) (child-indices index)
(cond ((>= lindex length)
(return))
((>= rindex length)
(if (<= key (item-key (elt vec lindex)))
(return)
(setf (elt vec index) (elt vec lindex)
index lindex)))
(t (let ((lkey (item-key (elt vec lindex)))
(rkey (item-key (elt vec rindex))))
(cond ((and (<= key lkey)
(<= key rkey))
(return))
((<= lkey rkey)
(setf (elt vec index) (elt vec lindex)
index lindex))
(t
(setf (elt vec index) (elt vec rindex)
index rindex))))))))
(setf (elt vec index) item)))
(values min-obj t)))
(defun heap-count (heap)
"Return the number of elements in the heap."
(fill-pointer (heap-vector heap)))
(defun heap-empty-p (heap)
"Return t if the heap is empty, nil otherwise."
(= 0 (heap-count heap))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hashsets ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hash-set abstraction, since CL doesn't seem to have a set datatype.
(defun make-hashset (&key (test 'eql))
"Create a new hashset with the specified test function."
(make-hash-table :test test))
(defun hashset-count (hashset)
"Return the number of items in the hashset."
(hash-table-count hashset))
(defun hashset-empty-p (hashset)
"Return t if the hashset is empty, nil otherwise."
(= 0 (hashset-count hashset)))
(defun hashset-contains-p (item hashset)
"Return t if the item is in the hashset, nil otherwise."
(gethash item hashset))
(defun hashset-add (item hashset)
"Add an item to the hashset."
(setf (gethash item hashset) t))
(defun hashset-remove (item hashset)
"Remove an item from the hashset."
(remhash item hashset))
(defmacro loop-hashset ((item hashset) &rest rest)
"Loop macro for hashsets."
`(loop :for ,item :being :the :hash-keys :in ,hashset
,@rest))
(defmacro do-hashset ((item hashset) &body body)
"Like dolist, but for hashsets."
`(loop-hashset (,item ,hashset)
:do (progn ,@body)))
(defun hashset-pop (hashset)
"Remove and return an arbitrary item from the hashset."
(do-hashset (k hashset)
(hashset-remove k hashset)
(return-from hashset-pop k)))
(defun hashset-subset-p (set1 set2)
"Return t if `set1' is a subset of `set2', nil otherwise."
(do-hashset (item set1)
(unless (hashset-contains-p item set2)
(return-from hashset-subset-p nil)))
t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Classes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Francois-Rene Rideau
committed
(defclass simple-print-object-mixin ()
())
(defun collect-slots (object slots)
(loop :for slot-spec :in slots :nconc
(if (functionp slot-spec)
(funcall slot-spec object)
(destructuring-bind (slot &optional
(fun #'identity)
(keyword (intern (symbol-name slot) :keyword)))
(if (consp slot-spec) slot-spec (list slot-spec))
(when (slot-boundp object slot)
(list keyword (funcall fun (slot-value object slot))))))))
(defun simple-print-object (object stream &key identity (slots (slots-to-print object)))
(print-unreadable-object (object stream :type t :identity identity)
(write (collect-slots object slots) :stream stream)))
(defgeneric slots-to-print (object)
(:method-combination append))
(defmethod print-object ((object simple-print-object-mixin) stream)
(simple-print-object object stream :slots (slots-to-print object)))
Francois-Rene Rideau
committed
(defclass constituent (simple-print-object-mixin)
((parent
:initarg :parent
:reader constituent-parent
:documentation "The parent constituent directly containing this one,
or nil if the constituent has no parent.")
(children
:initform nil
:reader constituent-children
:documentation "A list of direct children of this constituent.")
(index
:initform 0
:reader constituent-index
:documentation "The index of this constituent within its parent (if any).")
(uses
:initform (make-hashset :test 'equal)
:accessor constituent-uses
:documentation "A hashset of things used by this constituent.")
(provisions
:initform (make-hashset :test 'equal)
:accessor constituent-provisions
:documentation "A hashset of things provided by this constituent.")))
Francois-Rene Rideau
committed
(defmethod slots-to-print append ((con constituent))
`(,#'(lambda (x) (list :designator (constituent-designator x)))
(children ,#'length)
index
(uses ,#'hash-table-count)
(provisions ,#'hash-table-count)))
(defmethod initialize-instance :after ((con constituent) &key)
(let ((parent (slot-value con 'parent)))
(when parent
(setf (slot-value con 'index)
(length (slot-value parent 'children)))
(push con (slot-value parent 'children)))))
;; The top-level constituent. This is instantiated by
;; with-constituent-groveling, and will have a nil parent. The only reason to
;; have this as a separate class is so that we can overload
;; constituent-designator to return the empty list for top-level constituents.
(defclass top-constituent (constituent)
())
;; A constituent representing an ASDF component.
(defclass asdf-component-constituent (constituent)
((component
:initarg :component
:initform (error "must supply a component")
:reader asdf-component-constituent-component
:documentation "The ASDF component.")))
Francois-Rene Rideau
committed
(defmethod slots-to-print append ((con asdf-component-constituent))
'(component))
;; A constituent representing a file.
(defclass file-constituent (constituent)
((path
:initarg :path
:initform (error "must supply a path")
:reader file-constituent-path
:documentation "The path of the file.")))
;; A constituent representing a Lisp form. The constituent for a top-level
;; form would generally have a file-constituent as a parent.
(defclass form-constituent (constituent)
((position
:initarg :position
:initform nil
:reader form-constituent-position
:documentation "The position in the file at which the form starts.")
(summary
:initarg :summary
:initform nil
:reader form-constituent-summary
:documentation "A human-readable string summarizing the form.")))
;; A temporary constituent, typically made with a nil parent. This is used to
;; collect uses and provisions into one place (e.g. for sharpdot
;; instrumentation) before adding them to another constituent using the
;; transfer-constituent function.
(defclass temp-constituent (constituent)
((label
:initarg :label
:initform (error "must supply a label")
:reader temp-constituent-label
:documentation "The label to use as the summary of this constituent.")))
Francois-Rene Rideau
committed
(defmethod slots-to-print append ((con temp-constituent))
'(label))
(defun new-temp-constituent ()
"Create a new temp-constituent with an automatically generated label."
(make-instance 'temp-constituent
:label (cons (gensym) (and *current-constituent*
(constituent-designator
*current-constituent*)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Methods ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgeneric constituent-designator (con)
(:documentation "Return the unique designator of the constituent."))
(defmethod constituent-designator ((con null))
nil)
(defmethod constituent-designator ((con top-constituent))
t)
(defmethod constituent-designator ((con constituent))
(list* (class-of con) (constituent-index con)
(constituent-designator (constituent-parent con))))
(defmethod constituent-designator ((con form-constituent))
(list* :form (constituent-index con)
(constituent-designator (constituent-parent con))))
(defmethod constituent-designator ((con asdf-component-constituent))
Francois-Rene Rideau
committed
(asdf::component-find-path (asdf-component-constituent-component con))
(constituent-designator (constituent-parent con))))
(defmethod constituent-designator ((con file-constituent))
(list* :file
(file-constituent-path con)
(constituent-designator (constituent-parent con))))
Matthew Steele
committed
(defgeneric constituent-summary (con)
(:documentation "Return a summary of the identity of the constituent."))
Matthew Steele
committed
(defmethod constituent-summary ((con constituent))
(constituent-designator con))
(defmethod constituent-summary ((con form-constituent))
(list (constituent-designator con)
(form-constituent-position con)
Matthew Steele
committed
(form-constituent-summary con)))
(defmethod constituent-summary ((con temp-constituent))
(temp-constituent-label con))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro walk-constituents-preorder ((constituent top) &body body)
"Like dolist, but visits constituents in a preorder traversal."
(with-gensyms (visit walk con child)
`(labels ((,visit (,constituent) ,@body)
(,walk (,con)
(,visit ,con)
(dolist (,child (constituent-children ,con))
(,walk ,child))))
(,walk ,top))))
(defmacro walk-constituents-postorder ((constituent top) &body body)
"Like dolist, but visits constituents in a postorder traversal."
(with-gensyms (visit walk con child)
`(labels ((,visit (,constituent) ,@body)
(,walk (,con)
(dolist (,child (constituent-children ,con))
(,walk ,child))
(,visit ,con)))
(,walk ,top))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun constituent-descendant-p (con1 con2)
"Return t if con1 is a descendant of con2, nil otherwise."
(and con1 (or (eql con1 con2)
(constituent-descendant-p (constituent-parent con1) con2))))
(defun constituent-add-use (use con)
"Add a use to the constituent. The use should be a list of two elements: the
name of the thing used, and a symbol indicating the kind of thing used,
e.g. '(*foo* defvar)."
(hashset-add use (constituent-uses con)))
(defun constituent-add-provision (provision con)
"Add a provision to the constituent. The provision should be a list of two
elements: the name of the thing provided, and a symbol indicating the kind
of thing provided, e.g. '(*foo* defvar)."
(hashset-add provision (constituent-provisions con)))
(defun propagate-constituent-downward (con)
"Copy all uses and provisions from the constituent to all its descendants,
and do the same for each descendant."
(dolist (child (constituent-children con))
(do-hashset (provision (constituent-provisions con))
(constituent-add-provision provision child))
(do-hashset (use (constituent-uses con))
(constituent-add-use use child))
(propagate-constituent-downward child)))
(defun propagate-constituent-upward (con)
"Copy all uses and provisions from the constituent's descendants to it,
and do the same for each descendant."
(dolist (child (constituent-children con))
(propagate-constituent-upward child)
(do-hashset (provision (constituent-provisions child))
(constituent-add-provision provision con))
(do-hashset (use (constituent-uses child))
(constituent-add-use use con))))
(defun constituent-provision-table (top)
"Create a hash table mapping provisions to constituents that provide them."
(let ((table (make-hash-table :test 'equal)))
(walk-constituents-preorder (con top)
(do-hashset (provision (constituent-provisions con))
(push con (gethash provision table))))
table))
(defun constituent-dependency-table (top)
"Create a table mapping constituents to constituents to lists of reasons."
(let ((provisions (constituent-provision-table top))
(table (make-hash-table :test 'eql)))
(walk-constituents-preorder (con top)
(let ((subtable (make-hash-table :test 'eql)))
(setf (gethash con table) subtable)
(do-hashset (use (constituent-uses con))
;; You don't depend on something you yourself provide (this is
;; important for similar declarations that sometimes appear in
;; multiple files, e.g. defvars).
(unless (hashset-contains-p use (constituent-provisions con))
(dolist (dep (gethash use provisions))
;; You don't depend on something provided by one of your
;; descendants or ancestors.
(unless (or (constituent-descendant-p con dep)
(constituent-descendant-p dep con))
(push use (gethash dep subtable))))))))
table))
(defun get-file-constituents (top)
"Return a list of file-constituents that are descendants of the given
constituent."
(walk-constituents-postorder (con top)
(typecase con (file-constituent (push con file-constituents))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Graph ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass dnode ()
((parent
:initarg :parent
:initform (error "must supply a parent")
:reader dnode-parent
:documentation "The parent of all constituents in this node.")
(constituents
:initform (make-hashset :test 'eql)
:reader dnode-constituents
:documentation "The set of constituents in this node.")
(that-depend-on
:initform (make-hashset :test 'eql)
:reader dnodes-that-depend-on
:documentation "The set of nodes that depend on this node.")
(needs
:initform (make-hashset :test 'eql)
:reader dnodes-needed-by
:documentation "The set of nodes that this node depends on.")))
(defun make-dnode (constituent)
"Create a new dnode containing a single constituent."
(let ((dnode (make-instance 'dnode
:parent (constituent-parent constituent))))
(hashset-add constituent (dnode-constituents dnode))
(defun cyclic-reachable-p (graph start-node end-node)
"Return t if `end-node' is cyclic-reachable from `start-node', nil othewise.
If nodes A and B have the same parent, then node B is said to be
cyclic-reachable from a node A if there is a way to get from A to B that
passes through a node with a different parent (this implies that merging
nodes A and B would create a cycle between two nodes with different
parents)."
(assert (hashset-contains-p start-node graph))
(assert (hashset-contains-p end-node graph))
(let* ((parent (dnode-parent start-node))
(start-state (list start-node nil))
(stack (list start-state))
(visited (make-hashset :test 'equal)))
(assert (eql parent (dnode-parent end-node)))
(hashset-add start-state visited)
(do () ((null stack) nil) ;; If the stack is emptied, the answer is "no".
(destructuring-bind (dnode tainted) (pop stack)
(cond (tainted
(when (eql dnode end-node)
;; If this assertion fails, then the graph must be cyclic.
(assert (not (eql start-node end-node)))
(return t))) ;; The answer is "yes".
((not (eql (dnode-parent dnode) parent))
(setf tainted t)))
(do-hashset (child (dnodes-needed-by dnode))
(assert (hashset-contains-p child graph))
(let ((new-state (list child tainted)))
(unless (hashset-contains-p new-state visited)
(hashset-add new-state visited)
(push new-state stack))))))))
(defun try-to-merge-dnodes (graph dnode1 dnode2)
"Either merge the nodes and return t, or do nothing and return nil."
(assert (not (eql dnode1 dnode2)))
(assert (eql (dnode-parent dnode1) (dnode-parent dnode2)))
(assert (hashset-contains-p dnode1 graph))
(assert (hashset-contains-p dnode2 graph))
;; If dnode2 is cyclic-reachable from dnode1 (or vice-versa), we can't merge.
(when (or (cyclic-reachable-p graph dnode1 dnode2)
(cyclic-reachable-p graph dnode2 dnode1))
(return-from try-to-merge-dnodes nil))
;; Merge constituents of dnode2 into dnode1.
(do-hashset (con (dnode-constituents dnode2))
(hashset-add con (dnode-constituents dnode1)))
;; Nodes that needed dnode2 now need dnode1 instead.
(do-hashset (dnode3 (dnodes-that-depend-on dnode2))
(hashset-remove dnode2 (dnodes-needed-by dnode3))
(hashset-add dnode1 (dnodes-needed-by dnode3))
(hashset-add dnode3 (dnodes-that-depend-on dnode1)))
;; Nodes that dnode2 needed are now needed by dnode1 instead.
(do-hashset (dnode3 (dnodes-needed-by dnode2))
(hashset-remove dnode2 (dnodes-that-depend-on dnode3))
(hashset-add dnode1 (dnodes-that-depend-on dnode3))
(hashset-add dnode3 (dnodes-needed-by dnode1)))
;; Remove any self edge on dnode1, in case the merging created one.
(hashset-remove dnode1 (dnodes-needed-by dnode1))
(hashset-remove dnode1 (dnodes-that-depend-on dnode1))
;; Remove dnode2 from the graph.
(hashset-remove dnode2 graph)
t)
(defun build-merged-graph (top-constituent)
(let ((graph (make-hashset :test 'eql))
(dnode-lookup (make-hash-table :test 'eql))
(dnode-sets nil)
(dependencies (constituent-dependency-table top-constituent)))
;; Populate the graph with nodes.
(dolist (file-con (get-file-constituents top-constituent))
(let ((dnode-set (make-hashset :test 'eql)))
(dolist (child (constituent-children file-con))
(let ((dnode (make-dnode child)))
(setf (gethash child dnode-lookup) dnode)
(hashset-add dnode dnode-set)
(hashset-add dnode graph)))
(push dnode-set dnode-sets)))
;; Populate the nodes with dependencies.
(loop :for con1 :being :each :hash-key :in dnode-lookup
:using (:hash-value dnode1) :do
(loop :for con2 :being :each :hash-key :in (gethash con1 dependencies)
:for dnode2 := (gethash con2 dnode-lookup)
:when dnode2 :do
(hashset-add dnode1 (dnodes-that-depend-on dnode2))
(hashset-add dnode2 (dnodes-needed-by dnode1))))
(fail-if-not-acyclic graph "during build-merged-graph")
;; Try to merge nodes from the same parent.
(dolist (dnode-set (nreverse dnode-sets))
(do-until (hashset-empty-p dnode-set)
(let* ((dnode1 (hashset-pop dnode-set)))
(do-hashset (dnode2 dnode-set)
(when (try-to-merge-dnodes graph dnode1 dnode2)
(hashset-remove dnode2 dnode-set))))))
(fail-if-not-acyclic graph "after build-merged-graph")
(defun find-a-cycle-if-any (graph)
"If the graph contains a cycle, return a list of the dnodes involved; if
there is no cycle, return nil."
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
(let ((expanded (make-hashset :test 'eql))
(stack nil))
(do-hashset (dnode graph)
(push (list dnode) stack))
(do-until (null stack)
(let* ((chain (pop stack))
(head (car chain)))
(hashset-add head expanded)
(do-hashset (next (dnodes-needed-by head))
(when (member next chain :test 'eql)
(return-from find-a-cycle-if-any chain))
(unless (hashset-contains-p next expanded)
(push (cons next chain) stack)))))
nil))
(defun fail-if-not-acyclic (graph message)
(let ((cycle (find-a-cycle-if-any graph)))
(when cycle
(error (format nil "There was a cycle (~A):~%~{ dnode:~%~{ ~S~%~}~}"
message
(loop :for dnode :in cycle :collect
(loop-hashset (con (dnode-constituents dnode))
:collect (constituent-summary con))))))))
(defun topologically-stable-sort-graph (graph parents)
(fail-if-not-acyclic graph "before topologically-stable-sort-graph")
(let* ((sorted-list nil)
(finished (make-hashset :test 'eql)) ;; nodes in sorted-list
(enqueued (make-hashset :test 'eql)) ;; nodes ever to be in heap
(key-table (make-hash-table :test 'eql)) ;; maps dnodes to keys
(heap (make-heap :key (lambda (dnode) (gethash dnode key-table)))))
;; Populate the key-table.
(let ((parents-table (make-hash-table :test 'eql)))
(loop :for parent :in parents :for index :from 1
:do (setf (gethash parent parents-table) index))
(do-hashset (dnode graph)
(let ((index (gethash (dnode-parent dnode) parents-table)))
(assert index)
(setf (gethash dnode key-table)
(- (+ (* 10000 index) ;; this is a gross hack
(loop-hashset (con (dnode-constituents dnode))
:minimize (constituent-index con))))))))
;; Initialize heap to all nodes that no other node depends on -- such
;; nodes can safely come at the _end_ of the list, and thus can be _pushed_
;; onto sorted-list _first_.
(do-hashset (dnode graph)
(when (hashset-empty-p (dnodes-that-depend-on dnode))
(hashset-add dnode enqueued)
(heap-insert dnode heap)))
;; Work until the heap has been emptied.
(do-until (heap-empty-p heap)
;; Pop the next item off the heap, and push it onto sorted-list.
(let ((dnode (heap-pop heap)))
(assert (hashset-contains-p dnode enqueued))
(assert (not (hashset-contains-p dnode finished)))
(hashset-add dnode finished)
(push dnode sorted-list)
;; Now that this node is in sorted-list, examine nodes that depend on
;; this one. Enqueue any such nodes that 1) have never been enqueued,
;; and 2) are not depended on by anything that isn't already in
;; sorted-list. Each node in the graph will thus be enqueued just
;; after the last node that depends on it is enqueued.
(do-hashset (other (dnodes-needed-by dnode))
(when (and (not (hashset-contains-p other enqueued))
(hashset-subset-p (dnodes-that-depend-on other) finished))
(hashset-add other enqueued)
(heap-insert other heap)))))
;; When we're done, every node from the graph should now be in sorted-list,
;; in topological order.
(assert (= (length sorted-list) (hashset-count graph)))
(assert (or (null sorted-list)
(hashset-empty-p (dnodes-needed-by (first sorted-list)))))
sorted-list))
#|
(defun topologically-sort-graph (graph)
"Given an acyclic graph of nodes, return a list of the nodes in topological
order (that is, each node comes before all nodes that depend on it)."
(fail-if-not-acyclic graph "before topologically-sort-graph")
(let ((sorted-list nil)
(finished (make-hashset :test 'eql)) ;; nodes in sorted-list
(enqueued (make-hashset :test 'eql)) ;; nodes ever to be in stack
(stack nil))
;; Initialize stack to all nodes that no other node depends on -- such
;; nodes can safely come at the _end_ of the list, and thus can be _pushed_
;; onto sorted-list _first_.
(do-hashset (dnode graph)
(when (hashset-empty-p (dnodes-that-depend-on dnode))
(hashset-add dnode enqueued)
(push dnode stack)))
;; Work until the stack has been emptied.
;; Pop the next item off the stack, and push it onto sorted-list.
(let ((dnode (pop stack)))
(assert (hashset-contains-p dnode enqueued))
(assert (not (hashset-contains-p dnode finished)))
(hashset-add dnode finished)
(push dnode sorted-list)
;; Now that this node is in sorted-list, examine nodes that depend on
;; this one. Enqueue any such nodes that 1) have never been enqueued,
;; and 2) are not depended on by anything that isn't already in
;; sorted-list. Each node in the graph will thus be enqueued just
;; after the last node that depends on it is enqueued.
(do-hashset (other (dnodes-needed-by dnode))
(when (and (not (hashset-contains-p other enqueued))
(hashset-subset-p (dnodes-that-depend-on other) finished))
(hashset-add other enqueued)
(push other stack)))))
;; When we're done, every node from the graph should now be in sorted-list,
;; in topological order.
(assert (= (length sorted-list) (hashset-count graph)))
(assert (or (null sorted-list)
(hashset-empty-p (dnodes-needed-by (first sorted-list)))))
sorted-list))
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;