Commit | Line | Data |
---|---|---|
091cf411 TTN |
1 | ;;; scan-api --- Scan and group interpreter and libguile interface elements |
2 | ||
a1a2ed53 | 3 | ;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc. |
091cf411 TTN |
4 | ;; |
5 | ;; This program is free software; you can redistribute it and/or | |
83ba2d37 NJ |
6 | ;; modify it under the terms of the GNU Lesser General Public License |
7 | ;; as published by the Free Software Foundation; either version 3, or | |
091cf411 TTN |
8 | ;; (at your option) any later version. |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
83ba2d37 | 13 | ;; Lesser General Public License for more details. |
091cf411 | 14 | ;; |
83ba2d37 NJ |
15 | ;; You should have received a copy of the GNU Lesser General Public |
16 | ;; License along with this software; see the file COPYING.LESSER. If | |
17 | ;; not, write to the Free Software Foundation, Inc., 51 Franklin | |
18 | ;; Street, Fifth Floor, Boston, MA 02110-1301 USA | |
091cf411 TTN |
19 | |
20 | ;;; Author: Thien-Thi Nguyen <ttn@gnu.org> | |
21 | ||
22 | ;;; Commentary: | |
23 | ||
e366d58b | 24 | ;; Usage: scan-api GUILE SOFILE [GROUPINGS ...] |
091cf411 TTN |
25 | ;; |
26 | ;; Invoke GUILE, an executable guile interpreter, and use nm(1) on SOFILE, a | |
27 | ;; shared-object library, to determine available interface elements, and | |
28 | ;; display them to stdout as an alist: | |
29 | ;; | |
30 | ;; ((meta ...) (interface ...)) | |
31 | ;; | |
32 | ;; The meta fields are `GUILE_LOAD_PATH', `LTDL_LIBRARY_PATH', `guile' | |
33 | ;; `libguileinterface', `sofile' and `groups'. The interface elements are in | |
34 | ;; turn sub-alists w/ keys `groups' and `scan-data'. Interface elements | |
35 | ;; initially belong in one of two groups `Scheme' or `C' (but not both -- | |
36 | ;; signal error if that happens). | |
37 | ;; | |
e366d58b TTN |
38 | ;; Optional GROUPINGS ... are files each containing a single "grouping |
39 | ;; definition" alist with each entry of the form: | |
091cf411 TTN |
40 | ;; |
41 | ;; (NAME (description "DESCRIPTION") (members SYM...)) | |
42 | ;; | |
43 | ;; All of the SYM... should be proper subsets of the interface. In addition | |
44 | ;; to `description' and `members' forms, the entry may optionally include: | |
45 | ;; | |
46 | ;; (grok USE-MODULES (lambda (x) CODE)) | |
47 | ;; | |
48 | ;; where CODE implements a group-membership predicate to be applied to `x', a | |
49 | ;; symbol. [When evaluated, CODE can assume (use-modules MODULE) has been | |
50 | ;; executed where MODULE is an element of USE-MODULES, a list. [NOT YET | |
51 | ;; IMPLEMENTED!]] | |
52 | ;; | |
53 | ;; Currently, there are two convenience predicates that operate on `x': | |
54 | ;; (in-group? x GROUP) | |
55 | ;; (name-prefix? x PREFIX) | |
d1d0c7af | 56 | ;; |
e366d58b TTN |
57 | ;; TODO: Allow for concurrent Scheme/C membership. |
58 | ;; Completely separate reporting. | |
091cf411 TTN |
59 | |
60 | ;;; Code: | |
61 | ||
091cf411 TTN |
62 | (define-module (scripts scan-api) |
63 | :use-module (ice-9 popen) | |
64 | :use-module (ice-9 rdelim) | |
65 | :use-module (ice-9 regex) | |
66 | :export (scan-api)) | |
67 | ||
a1a2ed53 AW |
68 | (define %include-in-guild-list #f) |
69 | (define %summary "Generate an API description for a Guile extension.") | |
70 | ||
091cf411 TTN |
71 | (define put set-object-property!) |
72 | (define get object-property) | |
73 | ||
e366d58b TTN |
74 | (define (add-props object . args) |
75 | (let loop ((args args)) | |
76 | (if (null? args) | |
77 | object ; retval | |
78 | (let ((key (car args)) | |
79 | (value (cadr args))) | |
80 | (put object key value) | |
81 | (loop (cddr args)))))) | |
82 | ||
091cf411 TTN |
83 | (define (scan re command match) |
84 | (let ((rx (make-regexp re)) | |
85 | (port (open-pipe command OPEN_READ))) | |
86 | (let loop ((line (read-line port))) | |
87 | (or (eof-object? line) | |
88 | (begin | |
89 | (cond ((regexp-exec rx line) => match)) | |
90 | (loop (read-line port))))))) | |
91 | ||
92 | (define (scan-Scheme! ht guile) | |
93 | (scan "^.guile.+: ([^ \t]+)([ \t]+(.+))*$" | |
94 | (format #f "~A -c '~S ~S'" | |
95 | guile | |
96 | '(use-modules (ice-9 session)) | |
97 | '(apropos ".")) | |
98 | (lambda (m) | |
99 | (let ((x (string->symbol (match:substring m 1)))) | |
100 | (put x 'Scheme (or (match:substring m 3) | |
101 | "")) | |
102 | (hashq-set! ht x #t))))) | |
103 | ||
104 | (define (scan-C! ht sofile) | |
94173d5f | 105 | (scan "^[0-9a-fA-F]+ ([B-TV-Z]) (.+)$" |
091cf411 TTN |
106 | (format #f "nm ~A" sofile) |
107 | (lambda (m) | |
108 | (let ((x (string->symbol (match:substring m 2)))) | |
109 | (put x 'C (string->symbol (match:substring m 1))) | |
110 | (and (hashq-get-handle ht x) | |
111 | (error "both Scheme and C:" x)) | |
112 | (hashq-set! ht x #t))))) | |
113 | ||
114 | (define THIS-MODULE (current-module)) | |
115 | ||
116 | (define (in-group? x group) | |
117 | (memq group (get x 'groups))) | |
118 | ||
119 | (define (name-prefix? x prefix) | |
120 | (string-match (string-append "^" prefix) (symbol->string x))) | |
121 | ||
122 | (define (add-group-name! x name) | |
123 | (put x 'groups (cons name (get x 'groups)))) | |
124 | ||
e366d58b | 125 | (define (make-grok-proc name form) |
091cf411 TTN |
126 | (let* ((predicate? (eval form THIS-MODULE)) |
127 | (p (lambda (x) | |
128 | (and (predicate? x) | |
129 | (add-group-name! x name))))) | |
130 | (put p 'name name) | |
131 | p)) | |
132 | ||
e366d58b | 133 | (define (make-members-proc name members) |
091cf411 TTN |
134 | (let ((p (lambda (x) |
135 | (and (memq x members) | |
136 | (add-group-name! x name))))) | |
137 | (put p 'name name) | |
138 | p)) | |
139 | ||
e366d58b TTN |
140 | (define (make-grouper files) ; \/^^^o/ . o |
141 | (let ((hook (make-hook 1))) ; /\____\ | |
142 | (for-each | |
143 | (lambda (file) | |
144 | (for-each | |
145 | (lambda (gdef) | |
146 | (let ((name (car gdef)) | |
147 | (members (assq-ref gdef 'members)) | |
148 | (grok (assq-ref gdef 'grok))) | |
149 | (or members grok | |
150 | (error "bad grouping, must have `members' or `grok'")) | |
151 | (add-hook! hook | |
152 | (if grok | |
153 | (add-props (make-grok-proc name (cadr grok)) | |
154 | 'description | |
155 | (assq-ref gdef 'description)) | |
156 | (make-members-proc name members)) | |
157 | #t))) ; append | |
158 | (read (open-file file OPEN_READ)))) | |
159 | files) | |
091cf411 TTN |
160 | hook)) |
161 | ||
162 | (define (scan-api . args) | |
163 | (let ((guile (list-ref args 0)) | |
164 | (sofile (list-ref args 1)) | |
e366d58b | 165 | (grouper (false-if-exception (make-grouper (cddr args)))) |
091cf411 TTN |
166 | (ht (make-hash-table 3331))) |
167 | (scan-Scheme! ht guile) | |
168 | (scan-C! ht sofile) | |
169 | (let ((all (sort (hash-fold (lambda (key value prior-result) | |
e366d58b TTN |
170 | (add-props |
171 | key | |
172 | 'string (symbol->string key) | |
173 | 'scan-data (or (get key 'Scheme) | |
174 | (get key 'C)) | |
175 | 'groups (if (get key 'Scheme) | |
176 | '(Scheme) | |
177 | '(C))) | |
178 | (and grouper (run-hook grouper key)) | |
091cf411 TTN |
179 | (cons key prior-result)) |
180 | '() | |
181 | ht) | |
182 | (lambda (a b) | |
e366d58b TTN |
183 | (string<? (get a 'string) |
184 | (get b 'string)))))) | |
e4af2baf | 185 | (format #t ";;; generated by scan-api -- do not edit!\n\n") |
091cf411 TTN |
186 | (format #t "(\n") |
187 | (format #t "(meta\n") | |
188 | (format #t " (GUILE_LOAD_PATH . ~S)\n" | |
189 | (or (getenv "GUILE_LOAD_PATH") "")) | |
190 | (format #t " (LTDL_LIBRARY_PATH . ~S)\n" | |
191 | (or (getenv "LTDL_LIBRARY_PATH") "")) | |
192 | (format #t " (guile . ~S)\n" guile) | |
193 | (format #t " (libguileinterface . ~S)\n" | |
194 | (let ((i #f)) | |
195 | (scan "(.+)" | |
196 | (format #f "~A -c '(display ~A)'" | |
197 | guile | |
198 | '(assq-ref %guile-build-info | |
199 | 'libguileinterface)) | |
200 | (lambda (m) (set! i (match:substring m 1)))) | |
201 | i)) | |
202 | (format #t " (sofile . ~S)\n" sofile) | |
203 | (format #t " ~A\n" | |
94a972ac TTN |
204 | (cons 'groups (append (if grouper |
205 | (map (lambda (p) (get p 'name)) | |
206 | (hook->list grouper)) | |
207 | '()) | |
208 | '(Scheme C)))) | |
091cf411 TTN |
209 | (format #t ") ;; end of meta\n") |
210 | (format #t "(interface\n") | |
211 | (for-each (lambda (x) | |
212 | (format #t "(~A ~A (scan-data ~S))\n" | |
213 | x | |
214 | (cons 'groups (get x 'groups)) | |
215 | (get x 'scan-data))) | |
216 | all) | |
217 | (format #t ") ;; end of interface\n") | |
218 | (format #t ") ;; eof\n"))) | |
219 | #t) | |
220 | ||
221 | (define main scan-api) | |
222 | ||
223 | ;;; scan-api ends here |