diff --git a/dfs.scm b/dfs.scm index 03cce9a..8f0d552 100644 --- a/dfs.scm +++ b/dfs.scm @@ -1,3 +1,28 @@ +;;; +;;; merge(?) sort for general purpose: +;;; ================================== +;;; +;;; (sort predicate list-to-be-sorted to-sort-in-list) ---> sorted-list +;;; +;;; where +;;; +;;; predicate : (lambda (a b) ...) with a x b ---> {#t, #f} +;;; e.g. (lambda (a b) (> a b)) +;;; list-to-be-sorted : e.g. '(4 2 5 1 3) +;;; to-sort-in-list : e.g. '(6) +;;; +;;; will produce the result '(6 5 4 3 2 1). +;;; +(define (sort pred todo done) + (if (null? todo) + done + (sort pred (cdr todo) (insert pred (car todo) done)))) + +(define (insert pred item ls) + (if (or (null? ls) (pred item (car ls))) + (cons item ls) + (cons (car ls) (insert pred item (cdr ls))))) + (define time 0) (define-enumerated-type color :color @@ -59,7 +84,8 @@ ;;; ;;; where ;;; -;;; dag : '(#{:dfs} ...) +;;; dag : '(#{:dfs} ...) ; representation of a given +;;; directed acyclic graph) ;;; auto-leafs? : #t (by default) or #f ;;; sorted-dag : the sorted dag ;;; @@ -81,9 +107,9 @@ ;; (sort pred todo-list done-list) (sort (lambda (current position) (< (dfs-ftime current) (dfs-ftime position))) - ;; - ;; the result of this should be the dag with the ftimes - ;; + ;; + ;; the result of this should be the dag with the ftimes + ;; (let for-all-nodes ((node-name (car node-names)) (nodes-to-do (cdr node-names)) (current-dag dag)) @@ -131,7 +157,8 @@ (color white) 0 #f))) (set! current-dag (dfs-visit (cons leaf current-dag) leaf auto-leafs?))) - (error "dfs-visit: incomplete dag!")))) + (error "dfs-visit: unresolveable adjacency: " + current-adj)))) (if (not (null? todo-adjs)) (for-all-adjs (car todo-adjs) (cdr todo-adjs))))) (set! time (+ time 1))