summaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
authorThien-Thi Nguyen <ttn@gnuvola.org>2002-05-10 22:17:39 +0000
committerThien-Thi Nguyen <ttn@gnuvola.org>2002-05-10 22:17:39 +0000
commite366d58b793d6dfbe8a0f08522494aa843287930 (patch)
tree29ee1c2c0002530ec27f71e6b1b11807f4a96642 /scripts
parent5cb3f60097eb9f1520e59d1af459e077f4b612d9 (diff)
downloadguile-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-xscripts/scan-api86
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")