[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
2nd peek: scripts/autofrisk
From: |
Thien-Thi Nguyen |
Subject: |
2nd peek: scripts/autofrisk |
Date: |
Fri, 11 Jan 2002 11:31:15 -0800 |
well, adding "programs" support was pretty easy.
i think everything after this is cosmetic and/or grunge.
thi
_____________________________
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(scripts autofrisk)) '\'main')'
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;; autofrisk --- Generate module dependency checks for auto* tools
;; Copyright (C) 2002 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;; Boston, MA 02111-1307 USA
;;; Author: Thien-Thi Nguyen <address@hidden>
;;; Commentary:
;; Usage: autofrisk
;;
;; [todo]
;;
;; TODO:
;;; Code:
(debug-enable 'backtrace 'debug) ;; here.
(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 (spew-req module)
(format #t "GUILE_MODULE_REQUIRED~A\n" module))
(define (->varname module)
(let ((var (object->string module)))
(string-map! (lambda (c)
(if (char-set-contains? char-set:letter+digit c)
c
#\_))
var)
var))
(define (spew-avail-1 module)
(let ((v (format #f "have_guile_module~A" (->varname module))))
(format #t "GUILE_MODULE_AVAILABLE(~A, ~A)\n" v module)
v))
(define pww "probably_wont_work")
(define (spew-prog-support module progs)
(let ((vars (map (lambda (prog)
(format #f "guile_module~Asupport_~A"
(->varname 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 "false &&\n")
(format #t "~A=\"~A $~A\"\n\n" pww module pww)))
(define (spew-avail weak-edges non-critical-deps)
(format #t "\n~A=~S\n\n" pww "")
(for-each (lambda (edge)
(let* ((up (edge-up edge))
(down (edge-down edge))
(varname (spew-avail-1 up)))
(format #t "test \"$~A\" = no &&\n ~A=\"~A $~A\"~A"
varname pww down pww "\n\n")))
weak-edges)
(for-each (lambda (ncd)
(cond ((assq-ref ncd 'programs)
=> (lambda (programs)
(spew-prog-support (car ncd) programs)))))
non-critical-deps)
(format #t "if test ! \"$~A\" = \"\" ; then\n" pww)
(format #t " echo \"These modules probably won't work:\"\n")
(format #t " echo \" $~A\"\n" pww)
(format #t "fi\n"))
(define *recognized-keys* '(files
files-glob
non-critical-external
non-critical-internal
non-critical-deps))
(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 (unglob pattern)
(let ((p (open-input-pipe (format #f "echo '(' ~A ')'" pattern))))
(map symbol->string (read p))))
(define (>>ac forms)
(let* ((cfg (canonical-configuration forms))
(files (apply append (map unglob (cfg 'files-glob))))
(ncx (cfg 'non-critical-external))
(nci (cfg 'non-critical-internal))
(prog (cfg 'non-critical))
(report ((make-frisker) files))
(external (report 'external)))
(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")
(for-each spew-req strong)
(spew-avail (fold (lambda (module so-far)
(append so-far (mod-down-ls module)))
(list)
weak)
(cfg 'non-critical-deps))
(format #t "\n])\n"))))
(define (autofrisk . args)
(or (file-exists? "modules.af")
(error "no inupt file"))
(with-output-to-file "modules.af.m4"
(lambda ()
(>>ac (read-scheme-source-silently "modules.af")))))
(define main autofrisk)
;; Local variables:
;; eval: (put 'receive 'scheme-indent-function 2)
;; End:
;;; autofrisk ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- 2nd peek: scripts/autofrisk,
Thien-Thi Nguyen <=