diff options
author | Thien-Thi Nguyen <ttn@gnuvola.org> | 2002-05-10 22:17:39 +0000 |
---|---|---|
committer | Thien-Thi Nguyen <ttn@gnuvola.org> | 2002-05-10 22:17:39 +0000 |
commit | e366d58b793d6dfbe8a0f08522494aa843287930 (patch) | |
tree | 29ee1c2c0002530ec27f71e6b1b11807f4a96642 /scripts | |
parent | 5cb3f60097eb9f1520e59d1af459e077f4b612d9 (diff) | |
download | guile-e366d58b793d6dfbe8a0f08522494aa843287930.tar.gz |
(add-props): New proc.
(make-grok-proc): Renamed from `make-grok-hook'.
(make-members-proc): Renamed from `make-members-hook'.
(make-grouper): Renamed from `make-grouping-hook'. Update callers.
Add handling for multiple grouping-defs files.
(scan-api): Add handling for multiple grouping-defs files.
Cache `symbol->string' result; adjust `sort' usage.
Diffstat (limited to 'scripts')
-rwxr-xr-x | scripts/scan-api | 86 |
1 files changed, 50 insertions, 36 deletions
diff --git a/scripts/scan-api b/scripts/scan-api index 3a6e9b3d4..c527505f7 100755 --- a/scripts/scan-api +++ b/scripts/scan-api @@ -26,7 +26,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;;; Commentary: -;; Usage: scan-api GUILE SOFILE [GROUPINGS] +;; Usage: scan-api GUILE SOFILE [GROUPINGS ...] ;; ;; Invoke GUILE, an executable guile interpreter, and use nm(1) on SOFILE, a ;; shared-object library, to determine available interface elements, and @@ -40,8 +40,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;; initially belong in one of two groups `Scheme' or `C' (but not both -- ;; signal error if that happens). ;; -;; Optional arg GROUPINGS is a file containing a grouping definition alist, -;; each entry of which has the form: +;; Optional GROUPINGS ... are files each containing a single "grouping +;; definition" alist with each entry of the form: ;; ;; (NAME (description "DESCRIPTION") (members SYM...)) ;; @@ -59,8 +59,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;; (in-group? x GROUP) ;; (name-prefix? x PREFIX) ;; -;; TODO: Move symbol->string to hash-fold to make sorting more efficient. -;; Allow for concurrent Scheme/C membership. +;; TODO: Allow for concurrent Scheme/C membership. +;; Completely separate reporting. ;;; Code: @@ -73,6 +73,15 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (define put set-object-property!) (define get object-property) +(define (add-props object . args) + (let loop ((args args)) + (if (null? args) + object ; retval + (let ((key (car args)) + (value (cadr args))) + (put object key value) + (loop (cddr args)))))) + (define (scan re command match) (let ((rx (make-regexp re)) (port (open-pipe command OPEN_READ))) @@ -115,7 +124,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (define (add-group-name! x name) (put x 'groups (cons name (get x 'groups)))) -(define (make-grok-hook name form) +(define (make-grok-proc name form) (let* ((predicate? (eval form THIS-MODULE)) (p (lambda (x) (and (predicate? x) @@ -123,53 +132,58 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" (put p 'name name) p)) -(define (make-members-hook name members) +(define (make-members-proc name members) (let ((p (lambda (x) (and (memq x members) (add-group-name! x name))))) (put p 'name name) p)) -(define (make-grouping-hook file) - (let ((hook (make-hook 1))) - (for-each (lambda (gdef) - (let ((name (car gdef)) - (members (assq-ref gdef 'members)) - (grok (assq-ref gdef 'grok))) - (or members grok - (error "bad grouping, must have `members' or `grok'")) - (add-hook! hook - (if grok - (make-grok-hook name (cadr grok)) - (make-members-hook name members)) - #t))) ; append - (read (open-file file "r"))) +(define (make-grouper files) ; \/^^^o/ . o + (let ((hook (make-hook 1))) ; /\____\ + (for-each + (lambda (file) + (for-each + (lambda (gdef) + (let ((name (car gdef)) + (members (assq-ref gdef 'members)) + (grok (assq-ref gdef 'grok))) + (or members grok + (error "bad grouping, must have `members' or `grok'")) + (add-hook! hook + (if grok + (add-props (make-grok-proc name (cadr grok)) + 'description + (assq-ref gdef 'description)) + (make-members-proc name members)) + #t))) ; append + (read (open-file file OPEN_READ)))) + files) hook)) (define (scan-api . args) (let ((guile (list-ref args 0)) (sofile (list-ref args 1)) - (grouping-hook (false-if-exception - (make-grouping-hook (list-ref args 2)))) + (grouper (false-if-exception (make-grouper (cddr args)))) (ht (make-hash-table 3331))) (scan-Scheme! ht guile) (scan-C! ht sofile) (let ((all (sort (hash-fold (lambda (key value prior-result) - (put key 'scan-data - (or (get key 'Scheme) - (get key 'C))) - (put key 'groups - (if (get key 'Scheme) - '(Scheme) - '(C))) - (and grouping-hook - (run-hook grouping-hook key)) + (add-props + key + 'string (symbol->string key) + 'scan-data (or (get key 'Scheme) + (get key 'C)) + 'groups (if (get key 'Scheme) + '(Scheme) + '(C))) + (and grouper (run-hook grouper key)) (cons key prior-result)) '() ht) (lambda (a b) - (string<? (symbol->string a) - (symbol->string b)))))) + (string<? (get a 'string) + (get b 'string)))))) (format #t ";;; generated ~A UTC by scan-api -- do not edit!\n\n" (strftime "%Y-%m-%d %H:%M:%S" (gmtime (current-time)))) (format #t "(\n") @@ -190,9 +204,9 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" i)) (format #t " (sofile . ~S)\n" sofile) (format #t " ~A\n" - (cons 'groups (if grouping-hook + (cons 'groups (if grouper (map (lambda (p) (get p 'name)) - (hook->list grouping-hook)) + (hook->list grouper)) '(Scheme C)))) (format #t ") ;; end of meta\n") (format #t "(interface\n") |