Megatest

gendeps.scm at [9fb9312fc1]
Login

File utils/gendeps.scm artifact 847b7e11cc part of check-in 9fb9312fc1


;; (require-library iup canvas-draw)

;; It'd be better to use codescan....

(module gendeps
   *
	
(import
 scheme
 chicken.base
 chicken.string
 chicken.process-context
 chicken.file
 chicken.io
 chicken.port
 scheme
 ;;extras
 regex
 regex-case
 matchable
 srfi-69
 )

(define (portprint p . args)
  (with-output-to-port p
    (lambda ()
      (apply print args))))

(define modules-without-mod
  "(ods|transport|portlogger|tasks|pgdb)")

(define (mofiles-adjust->dot-o inf)
  (regex-case
   inf
   ("^.*mod$"           _ (conc "mofiles/"inf".o"))
   (modules-without-mod _ (conc "mofiles/"inf".o"))
   ("pgdb"              _ (conc "cgisetup/models/"inf".o"))
   (else (conc inf".o"))))

(define (hh-push ht k1 val)
  (hash-table-set! ht k1 (cons val (hash-table-ref/default ht k1 '()))))

(define (compunit targfname files)
  (let* ((unitdata   (make-hash-table))
	 (moduledata (make-hash-table))
	 (incldata   (make-hash-table))
	 (filesdata  (make-hash-table))
	 (unitdec    (regexp "^\\(declare\\s+\\(unit\\s+([^\\s]+)\\)\\)"))
	 (unituse    (regexp "^\\(declare\\s+\\(uses\\s+([^\\s]+)\\)\\)"))
	 (moduledec  (regexp "^\\(module\\s+([\\S]+).*"))
	 (importuse  (regexp "^\\(import\\s+(.*)\\)")) ;; captures string of imports (one line)
	 (dotport    (open-output-file (conc targfname ".dot")))
	 (incdotport (open-output-file (conc targfname"-inc.dot")))
	 (incport    (open-output-file (conc targfname ".inc")))
	 )
    (portprint dotport    "digraph usedeps {")
    (portprint incdotport "digraph usedeps {")
    (portprint incport    "# To regenerate this file do:
#   (cd utils/;ck52 csc gendeps.scm) && ./utils/gendeps allunits *scm
#   cp allunits.inc build.inc
#
")
    (for-each
     (lambda (fname)
       (let* ((sname (string-substitute "\\.scm$" "" fname)))
	 (print "Processing "fname" with core name of "sname)
	 (hash-table-set! filesdata sname fname) ;; record the existance of the src file
	 (with-input-from-file fname
	   (lambda ()
	     (let loop ((inl (read-line)))
	       (if (not (eof-object? inl))
		   (begin
		     (regex-case
		      inl
		      (unitdec   (_ unitname)
				 (if (equal? sname unitname) ;; good if same
				     (if (not (hash-table-exists? unitdata unitname))
					 (hash-table-set! unitdata unitname (make-hash-table)))))
		      (unituse   (_ usingname)
				 (portprint dotport "\""usingname"\" -> \""sname"\""))
		      (moduledec (_ modname)
				 (print "Found module "modname)
				 (hash-table-set! moduledata modname sname))
		      (importuse (_ importname)
				 (print "Found import "importname)
				 (hh-push incldata importname sname))
		      (else #f))
		     (loop (read-line)))))))))
     files)
    (hash-table-for-each
     incldata
     (lambda (impname snames)
       (for-each
	(lambda (sname)
	  (if (hash-table-exists? moduledata impname)
	      (if (hash-table-exists? incldata sname)
		  (make-inc-entry incport incdotport sname impname)
		  (print "Skipping module "sname", it is not used by any other modules"))
	      (print "No module file found for import " impname)))
	snames)))
    (portprint dotport "}")
    (portprint incdotport "}")
    (close-output-port dotport)
    (close-output-port incport)
    (close-output-port incdotport)))

(define (make-inc-entry incport incdotport sname impname)
  (let* ((leftname  (mofiles-adjust->dot-o sname))
	 (rightname (mofiles-adjust->dot-o impname)))
    (portprint incport
	       (if (or (string-search ".import$" sname)
		       (string-search ".import$" impname))
		   "# "
		   "")
	       leftname" : "rightname)
    (portprint incdotport "\""impname"\" -> \""sname"\"")))

;; seen is hash of seen functions

(define usage "Usage: gendeps targfile files...
")

(define (main)
  (match
   (command-line-arguments)
   (("help")(print usage))
   ((targfile . files)
    (compunit targfile files))
   (else
    (print "ERROR: Arguments not recognised.")
    (print usage))))
)

(import
 ;; (only iup show main-loop)
 gendeps)

(main)