Megatest

gendeps.scm at [07b32b8669]
Login

File utils/gendeps.scm artifact a6a7866112 part of check-in 07b32b8669


;; (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 (mofiles-adjust->dot-o inf)
  (regex-case
   inf
   ("^.*mod$" _ (conc "mofiles/"inf".o"))
   ("pgdb"    _ (conc "cgisetup/models/"inf".o"))
   (else (conc inf".o"))))

(define (compunit targfname files)
  (let* ((unitdata   (make-hash-table))
	 (moduledata (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")))
	 (incport    (open-output-file (conc targfname ".inc")))
	 )
    (portprint dotport "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"\"")
				 (portprint incport
					    (if (or (string-search ".import$" sname)
						    (string-search ".import$" usingname))
						"# "
						"")
					    (mofiles-adjust->dot-o sname)" : "
					    (mofiles-adjust->dot-o usingname)))
		      ;; (moduledec (_ modname)    (print "Module:   " modname))
		      ;; (importuse (_ importname) (print "Imports: " importname))
		      (else #f))
		     (loop (read-line)))))))))
     files)
    (portprint dotport "}")
    (close-output-port dotport)
    (close-output-port incport)))

;; 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)