123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219 |
- (define-module (scripts autofrisk)
- :autoload (ice-9 popen) (open-input-pipe)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-8)
- :use-module (srfi srfi-13)
- :use-module (srfi srfi-14)
- :use-module (scripts read-scheme-source)
- :use-module (scripts frisk)
- :export (autofrisk))
- (define %include-in-guild-list #f)
- (define %summary "Generate snippets for use in configure.ac files.")
- (define *recognized-keys* '(files-glob
- non-critical-external
- non-critical-internal
- programs
- pww-varname))
- (define (canonical-configuration forms)
- (let ((chk (lambda (condition . x)
- (or condition (apply error "syntax error:" x)))))
- (chk (list? forms) "input not a list")
- (chk (every list? forms) "non-list element")
- (chk (every (lambda (form) (< 1 (length form))) forms) "list too short")
- (let ((un #f))
- (chk (every (lambda (form)
- (let ((key (car form)))
- (and (symbol? key)
- (or (eq? 'quote key)
- (memq key *recognized-keys*)
- (begin
- (set! un key)
- #f)))))
- forms)
- "unrecognized key:" un))
- (let ((bunched (map (lambda (key)
- (fold (lambda (form so-far)
- (or (and (eq? (car form) key)
- (cdr form)
- (append so-far (cdr form)))
- so-far))
- (list key)
- forms))
- *recognized-keys*)))
- (lambda (key)
- (assq-ref bunched key)))))
- (define (>>strong modules)
- (for-each (lambda (module)
- (format #t "GUILE_MODULE_REQUIRED~A\n" module))
- modules))
- (define (safe-name module)
- (let ((var (object->string module)))
- (string-map! (lambda (c)
- (if (char-set-contains? char-set:letter+digit c)
- c
- #\_))
- var)
- var))
- (define *pww* "probably_wont_work")
- (define (>>weak weak-edges)
- (for-each (lambda (edge)
- (let* ((up (edge-up edge))
- (down (edge-down edge))
- (var (format #f "have_guile_module~A" (safe-name up))))
- (format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" var up)
- (format #t "test \"$~A\" = no &&\n ~A=\"~A $~A\"~A"
- var *pww* down *pww* "\n\n")))
- weak-edges))
- (define (>>program module progs)
- (let ((vars (map (lambda (prog)
- (format #f "guile_module~Asupport_~A"
- (safe-name module)
- prog))
- progs)))
- (for-each (lambda (var prog)
- (format #t "AC_PATH_PROG(~A, ~A)\n" var prog))
- vars progs)
- (format #t "test \\\n")
- (for-each (lambda (var)
- (format #t " \"$~A\" = \"\" -o \\\n" var))
- vars)
- (format #t "~A &&\n~A=\"~A $~A\"\n\n"
- (list-ref (list "war = peace"
- "freedom = slavery"
- "ignorance = strength")
- (random 3))
- *pww* module *pww*)))
- (define (>>programs programs)
- (for-each (lambda (form)
- (>>program (car form) (cdr form)))
- programs))
- (define (unglob pattern)
- (let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
- (map symbol->string (read p))))
- (define (>>checks forms)
- (let* ((cfg (canonical-configuration forms))
- (files (apply append (map unglob (cfg 'files-glob))))
- (ncx (cfg 'non-critical-external))
- (nci (cfg 'non-critical-internal))
- (report ((make-frisker) files))
- (external (report 'external)))
- (let ((pww-varname (cfg 'pww-varname)))
- (or (null? pww-varname) (set! *pww* (car pww-varname))))
- (receive (weak strong)
- (partition (lambda (module)
- (or (member module ncx)
- (every (lambda (i)
- (member i nci))
- (map edge-down (mod-down-ls module)))))
- external)
- (format #t "AC_DEFUN([AUTOFRISK_CHECKS],[\n\n")
- (>>strong strong)
- (format #t "\n~A=~S\n\n" *pww* "")
- (>>weak (fold (lambda (module so-far)
- (append so-far (mod-down-ls module)))
- (list)
- weak))
- (>>programs (cfg 'programs))
- (format #t "AC_SUBST(~A)\n])\n\n" *pww*))))
- (define (>>summary)
- (format #t
- (symbol->string
- '#{
- AC_DEFUN([AUTOFRISK_SUMMARY],[
- if test ! "$~A" = ""
- p=" ***"
- echo "$p"
- echo "$p NOTE:"
- echo "$p The following modules probably won't work:"
- echo "$p $~A"
- echo "$p They can be installed anyway, and will work if their"
- echo "$p dependencies are installed later. Please see README."
- echo "$p"
- fi
- ])
- }#)
- *pww* *pww*))
- (define (autofrisk . args)
- (let ((file (if (null? args) "modules.af" (car args))))
- (or (file-exists? file)
- (error "could not find input file:" file))
- (with-output-to-file (format #f "~A.m4" file)
- (lambda ()
- (>>checks (read-scheme-source-silently file))
- (>>summary)))))
- (define main autofrisk)
|