;; simple dependency checking code

(require 'sets)
(require 'sort)

(define DEPENDENCY-DB
  (list
    (cons 'addr 
           (list 'symbl 'malloc 'mem 'errtext 'proc))
    (cons 'bkptexec
           (list 'bkroot 'sdserver 'addr 'symbl 'trace 'enlib 'dasm 
                  'cpu 'malloc 'stack 'errtext 'proc))
    (cons 'bkroot
           (list 'sdserver 'errtext))
    (cons 'cpu 
           (list 'sdserver 'enlib 'malloc 'bkroot 'addr 'errtext 'cliulib))
    (cons 'cliulib
           (list )) ;; no dependency
    (cons 'dasm 
           (list 'addr 'enlib 'errtext 'malloc 'mem 'trace 'strlib 'symbl))
    (cons 'errtext 
           (list 'cliulib))
    (cons 'enlib
           (list 'errtext))
    (cons 'event
           (list  'bkroot 'evttmplt 'malloc 'trig 'addr 'errtext))
    (cons 'evttmplt
           (list 'errtext 'malloc))
    (cons 'lascii
           (list 'symbl 'addr 'errtext))
    (cons 'ldr
           (list 'sdserver 'symbl 'enlib 'addr 'errtext))
    (cons 'map
           (list 'sdserver 'addr 'enlib 'errtext))
    (cons 'mem
           (list 'sdserver 'addr 'malloc 'enlib 'errtext 'bkroot 'proc))
    (cons 'malloc 
           (list 'errtext))
    (cons 'proc
           (list )) ;; no dependency
    (cons 'strlib
           (list )) ;; no dependency
    (cons 'sdserver
           (list 'errtext 'wscom 'strlib 'malloc))
    (cons 'symbl
           (list 'addr 'ldr 'enlib 'stkservr 'cpu 'malloc 'errtext))
    (cons 'stkservr
           (list 'symbl 'malloc 'enlib 'addr 'mem 'cpu 'varservr 
                'errtext))
    (cons 'swat
           (list 'errtext 'event 'trig 'evttmplt 'sdserver 'symbl 'addr))
    (cons 'trace
           (list 'addr 'dasm 'enlib 'errtext 'event 'evttmplt 'malloc 
                 'sdserver 'strlib 'trig))
    (cons 'trig
           (list 'addr 'dasm 'enlib 'errtext 'event 'evttmplt 'malloc 
                 'sdserver 'strlib 'trig))
    (cons 'varservr
           (list 'sdserver 'malloc 'enlib 'event 'evttmplt 'errtext))
    (cons 'wscomm
          (list 'errtext 'strlib))
) )

(define (GET-DEPENDENTS <component>)
  (cond ((assq <component> dependency-db) => cdr)
        (else '())
) )

(define (DEPENDS-ON <component>)
  (let ( (depends (assq <component> dependency-db)) )
    (if (not depends)
        '()
        (let loop ( (visited (set-empty))
                    (current (car depends))
                    (rest    (cdr depends))
                    (found   (list->set depends))
                  )
           (cond
              ((set-member? current visited)
               (if (null? rest)
                   (list-sort (set->list found) symbol<=?)
                   (loop visited (car rest) (cdr rest) found))
              )
              ((null? rest)  ;; found 'em all
               (list-sort 
                  (set->list
		     (set-union found
                                (list->set (get-dependents current))))
		  symbol<=?)
              )
              (else
               (loop (set-adjoin visited current)
                     (car rest)
                     (cdr rest)
                     (set-union found 
                                (list->set (get-dependents current))
               )     )
              )
           ) ; end-cond
    ) ; end-let loop
) ) ) ;; end depends-on

(define (show-dependencies . <optional-port>)
  (let ( (port (cond
	        ((null? <optional-port>)  (current-output-port))
                ((output-port? (car <optional-port>))
                 (car <optional-port>))
	        (else (current-output-port))))
       )
    (for-each (lambda (bucket)
                (newline port)
		(display (car bucket) port)
		(display ": " port)
		(newline port)
		(pp (list-sort
		     (set->list
		      (depends-on (car bucket)))
		     symbol<=?)
		      port))
	      dependency-db)
) )

(define (SYMBOL<=? s1 s2)
  (string<=? (symbol->string s1) (symbol->string s2))
)

;;                      --- E O F ---                   ;;