diff options
author | Andy Wingo <wingo@pobox.com> | 2009-04-17 11:19:42 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-04-17 11:19:42 +0200 |
commit | 6d66647d5b2c6649bb4dade734f6d583d10d797c (patch) | |
tree | 3c05d62af67617f0949fbe4a4228ac3564da0be5 /scripts/scan-api | |
parent | 798244609bfd3b4d2b12f722d9130d47abcfeb1a (diff) | |
download | guile-6d66647d5b2c6649bb4dade734f6d583d10d797c.tar.gz |
guile-tools is a scheme script that loads scheme modules
* meta/guile-tools: Changed to be a scheme script. Instead of looking for
executables in a "scripts dir", we just look for modules in (scripts),
and load the modules directly.
* module/Makefile.am:
* module/scripts/: Move the scripts into module/ so they can be compiled.
Rename scripts from `foo' to `foo.scm'.
* libguile/Makefile.am: Invoke the snarf->texi code via guile-tools.
* configure.in:
* .gitignore: Update for changes.
Diffstat (limited to 'scripts/scan-api')
-rwxr-xr-x | scripts/scan-api | 225 |
1 files changed, 0 insertions, 225 deletions
diff --git a/scripts/scan-api b/scripts/scan-api deleted file mode 100755 index 3ea10dbe6..000000000 --- a/scripts/scan-api +++ /dev/null @@ -1,225 +0,0 @@ -#!/bin/sh -# aside from this initial boilerplate, this is actually -*- scheme -*- code -main='(module-ref (resolve-module '\''(scripts scan-api)) '\'main')' -exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@" -!# -;;; scan-api --- Scan and group interpreter and libguile interface elements - -;; Copyright (C) 2002, 2006 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301 USA - -;;; Author: Thien-Thi Nguyen <ttn@gnu.org> - -;;; Commentary: - -;; 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 -;; display them to stdout as an alist: -;; -;; ((meta ...) (interface ...)) -;; -;; The meta fields are `GUILE_LOAD_PATH', `LTDL_LIBRARY_PATH', `guile' -;; `libguileinterface', `sofile' and `groups'. The interface elements are in -;; turn sub-alists w/ keys `groups' and `scan-data'. Interface elements -;; initially belong in one of two groups `Scheme' or `C' (but not both -- -;; signal error if that happens). -;; -;; Optional GROUPINGS ... are files each containing a single "grouping -;; definition" alist with each entry of the form: -;; -;; (NAME (description "DESCRIPTION") (members SYM...)) -;; -;; All of the SYM... should be proper subsets of the interface. In addition -;; to `description' and `members' forms, the entry may optionally include: -;; -;; (grok USE-MODULES (lambda (x) CODE)) -;; -;; where CODE implements a group-membership predicate to be applied to `x', a -;; symbol. [When evaluated, CODE can assume (use-modules MODULE) has been -;; executed where MODULE is an element of USE-MODULES, a list. [NOT YET -;; IMPLEMENTED!]] -;; -;; Currently, there are two convenience predicates that operate on `x': -;; (in-group? x GROUP) -;; (name-prefix? x PREFIX) -;; -;; TODO: Allow for concurrent Scheme/C membership. -;; Completely separate reporting. - -;;; Code: - -(define-module (scripts scan-api) - :use-module (ice-9 popen) - :use-module (ice-9 rdelim) - :use-module (ice-9 regex) - :export (scan-api)) - -(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))) - (let loop ((line (read-line port))) - (or (eof-object? line) - (begin - (cond ((regexp-exec rx line) => match)) - (loop (read-line port))))))) - -(define (scan-Scheme! ht guile) - (scan "^.guile.+: ([^ \t]+)([ \t]+(.+))*$" - (format #f "~A -c '~S ~S'" - guile - '(use-modules (ice-9 session)) - '(apropos ".")) - (lambda (m) - (let ((x (string->symbol (match:substring m 1)))) - (put x 'Scheme (or (match:substring m 3) - "")) - (hashq-set! ht x #t))))) - -(define (scan-C! ht sofile) - (scan "^[0-9a-fA-F]+ ([B-TV-Z]) (.+)$" - (format #f "nm ~A" sofile) - (lambda (m) - (let ((x (string->symbol (match:substring m 2)))) - (put x 'C (string->symbol (match:substring m 1))) - (and (hashq-get-handle ht x) - (error "both Scheme and C:" x)) - (hashq-set! ht x #t))))) - -(define THIS-MODULE (current-module)) - -(define (in-group? x group) - (memq group (get x 'groups))) - -(define (name-prefix? x prefix) - (string-match (string-append "^" prefix) (symbol->string x))) - -(define (add-group-name! x name) - (put x 'groups (cons name (get x 'groups)))) - -(define (make-grok-proc name form) - (let* ((predicate? (eval form THIS-MODULE)) - (p (lambda (x) - (and (predicate? x) - (add-group-name! x name))))) - (put p 'name name) - p)) - -(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-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)) - (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) - (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<? (get a 'string) - (get b 'string)))))) - (format #t ";;; generated by scan-api -- do not edit!\n\n") - (format #t "(\n") - (format #t "(meta\n") - (format #t " (GUILE_LOAD_PATH . ~S)\n" - (or (getenv "GUILE_LOAD_PATH") "")) - (format #t " (LTDL_LIBRARY_PATH . ~S)\n" - (or (getenv "LTDL_LIBRARY_PATH") "")) - (format #t " (guile . ~S)\n" guile) - (format #t " (libguileinterface . ~S)\n" - (let ((i #f)) - (scan "(.+)" - (format #f "~A -c '(display ~A)'" - guile - '(assq-ref %guile-build-info - 'libguileinterface)) - (lambda (m) (set! i (match:substring m 1)))) - i)) - (format #t " (sofile . ~S)\n" sofile) - (format #t " ~A\n" - (cons 'groups (append (if grouper - (map (lambda (p) (get p 'name)) - (hook->list grouper)) - '()) - '(Scheme C)))) - (format #t ") ;; end of meta\n") - (format #t "(interface\n") - (for-each (lambda (x) - (format #t "(~A ~A (scan-data ~S))\n" - x - (cons 'groups (get x 'groups)) - (get x 'scan-data))) - all) - (format #t ") ;; end of interface\n") - (format #t ") ;; eof\n"))) - #t) - -(define main scan-api) - -;;; scan-api ends here |