Proper resolution of dependencies

This commit is contained in:
Justin Ethier 2016-07-11 21:19:55 -04:00
parent 8e983a9bfa
commit 8d8c6fcd06

View file

@ -304,55 +304,46 @@
;; Given a list of alists (library-name . imports), return an ordered ;; Given a list of alists (library-name . imports), return an ordered
;; list of library names such that each lib is encounted after the ;; list of library names such that each lib is encounted after the
;; libraries it imports (it's dependencies). ;; libraries it imports (it's dependencies).
(define (lib:get-dep-list libs/deps) (define lib:get-dep-list resolve-dependencies)
; Overall strategy is:
; for each library ;; Goal is to resolve a list of dependencies into the appropriate order such
; compute index of result that is after any libs that lib imports ;; that no node is encountered before its dependencies.
; compute index of result that is before any libs that import lib ;; We also need to raise an error if a circular dependency is found
; if there is a 'hole' then insert lib into result in that space ;;
; otherwise, throw an error (unfortunate but will identify problems) ;; A dependency list consists of: (name . edges)
; ;; Where edges are all of the dependencies of name.
; To test, run this from hello directory: ;;
; (pp (lib:get-all-import-deps '((scheme base) (scheme eval) (scheme base) ;; nodes is a list of many dependency lists.
; (scheme read) (scheme eval) (libs lib1) (libs lib2)))) ;;
; ;; Based on code from:
(let ((result '())) ;; http://www.electricmonk.nl/log/2008/08/07/dependency-resolving-algorithm/
(define (resolve-dependencies nodes)
(define (append-cell! cell value) (set-cdr! cell (cons value (cdr cell))))
(define (make-cell) (cons #f '()))
(define get-cell cdr)
(define (node->edges name) (assoc name nodes))
;; Create a new node that depends on all the others
(define (master-dependency)
(cons '(#f) (map car nodes)))
(define (dep-resolve node resolved seen)
; DEBUG: (write node) (newline)
(append-cell! seen node)
(for-each (for-each
(lambda (lib/dep) (lambda (edge)
(cond (cond
((null? result) ((not (assoc edge (get-cell resolved)))
(set! result (cons lib/dep '()))) (if (assoc edge (get-cell seen))
(else (error "Circular dependency detected" node edge))
(let ((idx-my-imports 0) ; lib must be placed after this (dep-resolve (node->edges edge) resolved seen))))
(idx-imports-me (length result))) ; lib must be before any libs that import it (cdr (node->edges (car node))))
(define (loop i) (append-cell! resolved node)
(cond resolved)
((= i (length result))
'done)
(else
;; Does lib import this one?
(if (and
(> i idx-my-imports)
(member (car (list-ref result i)) (cdr lib/dep)))
(set! idx-my-imports i))
;; Does this one import lib? (set! nodes (cons (master-dependency) nodes))
(if (and (let* ((resolved (dep-resolve (node->edges '(#f)) (make-cell) (make-cell)))
(< i idx-imports-me) (deps (reverse (cdr (get-cell resolved))))) ;; cdr to get rid of master list
(member (car lib/dep) (cdr (list-ref result i)))) (map car deps)))
(set! idx-imports-me i))
(loop (+ i 1)))))
(loop 0)
;(pp `(JAE DEBUG ,result ,lib/dep ,idx-imports-me ,idx-my-imports))
(if (<= idx-my-imports idx-imports-me)
(list-insert-at! result lib/dep
(if (= idx-my-imports idx-imports-me)
idx-my-imports
(+ 1 idx-my-imports)))
(error "Unable to import library, possibly due to a circular dependency:" lib/dep))))
))
libs/deps)
(map car result)))
)) ))