mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

(add-props): New proc.

Browse source 
(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.
This commit is contained in:
Thien-Thi Nguyen 2002-05-10 22:17:39 +00:00
parent 5cb3f60097
commit e366d58b79
1 changed files with 50 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

86
scripts/scan-api
View file

@ -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")