mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-04 19:56:36 +02:00
supporting explicit module list with -i/--include
This commit is contained in:
Alex Shinn
parent
ac704414c6
commit
eac57054ce
1 changed files with 116 additions and 63 deletions
|
|
@ -1,4 +1,4 @@
|
|||
#! /usr/bin/env chibi-scheme
|
||||
#!/usr/bin/env chibi-scheme
|
||||
|
||||
;; This is a build-only tool (not installed) used to generate the
|
||||
;; clibs.c file used by Chibi for a SEXP_USE_STATIC_LIBS=1 build,
|
||||
|
|
@ -6,9 +6,24 @@
|
|||
;; dynamically included statically into libchibi-scheme (though not
|
||||
;; necessarily statically linked).
|
||||
;;
|
||||
;; usage: find <dir> -name \*.sld | chibi-genstatic [-x <mods> ...] > clibs.c
|
||||
;; Usage:
|
||||
;; find <dir> -name \*.sld | chibi-genstatic [-x <mods> ...] > clibs.c
|
||||
;; chibi-genstatic -i <mods> > clibs.c
|
||||
;;
|
||||
;; where <mods> is a list of modules _not_ to generate static bindings for.
|
||||
;; In the first form, chibi-genstatic takes a list of module file
|
||||
;; names on stdin to generate static bindings for, excluding any
|
||||
;; modules specified with -x (or --exclude).
|
||||
;;
|
||||
;; In the second form, we take an explicit list of module names as
|
||||
;; options with -i or --include (-x is still honored and takes
|
||||
;; precedence).
|
||||
;;
|
||||
;; Both -i and -x may be specified multiple times, or multiple module
|
||||
;; names can be separated with commas.
|
||||
;;
|
||||
;; Examples:
|
||||
;; find lib -name \*.sld | chibi-genstatic -x chibi.net -x srfi.18 > clibs.c
|
||||
;; chibi-genstatic -i chibi.ast,srfi.69 > clibs.c
|
||||
;;
|
||||
;; This is only intended for libraries in the core distribution, and
|
||||
;; currently makes the assumption that the .sld files contain a
|
||||
|
|
@ -16,16 +31,14 @@
|
|||
;; your own libraries included statically, be sure to follow this
|
||||
;; convention.
|
||||
;;
|
||||
;; This relies on an external find, instead of one from (chibi
|
||||
;; Note: This relies on an external find, instead of one from (chibi
|
||||
;; filesystem), because the latter is a dynamically loaded library
|
||||
;; which presents a bootstrapping issue on platforms with no dynamic
|
||||
;; loading.
|
||||
|
||||
(import (scheme)
|
||||
(chibi pathname)
|
||||
(only (meta) find-module))
|
||||
|
||||
(define c-libs '())
|
||||
(only (chibi pathname) path-directory)
|
||||
(only (meta) find-module module-name->file))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -45,13 +58,6 @@
|
|||
((eqv? c (string-ref str i)) (lp (+ i 1) (+ i 1) (collect)))
|
||||
(else (lp from (+ i 1) res))))))
|
||||
|
||||
(define (string-scan c str . o)
|
||||
(let ((limit (string-length str)))
|
||||
(let lp ((i (if (pair? o) (car o) 0)))
|
||||
(cond ((>= i limit) #f)
|
||||
((eqv? c (string-ref str i)) i)
|
||||
(else (lp (+ i 1)))))))
|
||||
|
||||
(define (string-replace str c r)
|
||||
(let ((len (string-length str)))
|
||||
(let lp ((from 0) (i 0) (res '()))
|
||||
|
|
@ -65,13 +71,19 @@
|
|||
(or (char-alphabetic? c) (char-numeric? c) (memv c '(#\_ #\- #\! #\?))))
|
||||
|
||||
(define (c-escape str)
|
||||
(define (hex ch) (number->string (char->integer ch) 16))
|
||||
(let ((len (string-length str)))
|
||||
(let lp ((from 0) (i 0) (res '()))
|
||||
(define (collect) (if (= i from) res (cons (substring str from i) res)))
|
||||
(cond
|
||||
((>= i len) (string-concatenate (reverse (collect))))
|
||||
((not (c-char? (string-ref str i))) (lp (+ i 1) (+ i 1) (cons "_" (cons (number->string (char->integer (string-ref str i)) 16) (collect)))))
|
||||
(else (lp from (+ i 1) res))))))
|
||||
((>= i len)
|
||||
(string-concatenate (reverse (collect))))
|
||||
((not (c-char? (string-ref str i)))
|
||||
(lp (+ i 1)
|
||||
(+ i 1)
|
||||
(cons "_" (cons (hex (string-ref str i)) (collect)))))
|
||||
(else
|
||||
(lp from (+ i 1) res))))))
|
||||
|
||||
(define (mangle x)
|
||||
(string-replace
|
||||
|
|
@ -88,11 +100,39 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (init-name mod)
|
||||
(string-append "sexp_init_lib_"
|
||||
(string-concatenate (map mangle mod) "_")))
|
||||
(define (find-c-libs-from-module-names modules)
|
||||
(define (strip-dot-slash path)
|
||||
(if (and (>= (string-length path) 2)
|
||||
(eq? #\. (string-ref path 0))
|
||||
(eq? #\/ (string-ref path 1)))
|
||||
(substring path 2)
|
||||
path))
|
||||
(define (shared-file-name mod-name name)
|
||||
(string-append
|
||||
(path-directory
|
||||
(strip-dot-slash (find-module-file (module-name->file mod-name))))
|
||||
"/" name))
|
||||
(define (find-c-lib mod-name)
|
||||
(cond
|
||||
((find-module mod-name)
|
||||
=> (lambda (mod)
|
||||
(cond
|
||||
((assq 'include-shared (vector-ref mod 2))
|
||||
=> (lambda (x)
|
||||
(cons (shared-file-name mod-name (cadr x)) mod-name)))
|
||||
(else #f))))
|
||||
(else #f)))
|
||||
(let lp ((ls modules)
|
||||
(c-libs '()))
|
||||
(cond
|
||||
((null? ls)
|
||||
c-libs)
|
||||
((find-c-lib (car ls))
|
||||
=> (lambda (x) (lp (cdr ls) (cons x c-libs))))
|
||||
(else
|
||||
(lp (cdr ls) c-libs)))))
|
||||
|
||||
(define (find-c-libs excluded-c-libs)
|
||||
(define (find-c-libs-from-file-names excluded)
|
||||
(define (extract-module-name file)
|
||||
(call-with-input-file file
|
||||
(lambda (in)
|
||||
|
|
@ -106,29 +146,49 @@
|
|||
'(define-library define-module library module)))
|
||||
(cadr expr))
|
||||
(else (lp))))))))
|
||||
(define (process file)
|
||||
(let ((mod-name (extract-module-name file)))
|
||||
(cond
|
||||
((and mod-name
|
||||
(not (member mod-name excluded-c-libs))
|
||||
(find-module mod-name))
|
||||
=> (lambda (mod)
|
||||
(cond
|
||||
((assq 'include-shared (vector-ref mod 2))
|
||||
=> (lambda (x)
|
||||
(set! c-libs
|
||||
(cons (cons (string-append
|
||||
(path-directory file)
|
||||
"/"
|
||||
(cadr x))
|
||||
mod-name)
|
||||
c-libs))))))))))
|
||||
(let lp ()
|
||||
(let lp ((modules '()))
|
||||
(let ((file (read-line)))
|
||||
(cond
|
||||
((not (or (eof-object? file) (equal? "" file)))
|
||||
(process file)
|
||||
(lp))))))
|
||||
((or (eof-object? file) (equal? "" file))
|
||||
(find-c-libs-from-module-names modules))
|
||||
((extract-module-name file)
|
||||
=> (lambda (name)
|
||||
(lp (if (member name excluded) modules (cons name modules)))))
|
||||
(else
|
||||
(lp modules))))))
|
||||
|
||||
(define (find-c-libs args)
|
||||
(define (split-mod-names str)
|
||||
(map (lambda (m)
|
||||
(map (lambda (x) (or (string->number x) (string->symbol x)))
|
||||
(string-split m #\.)))
|
||||
(string-split str #\,)))
|
||||
(let lp ((ls args)
|
||||
(includes #f)
|
||||
(excludes '()))
|
||||
(cond
|
||||
((null? ls)
|
||||
(if includes
|
||||
(find-c-libs-from-module-names includes)
|
||||
(find-c-libs-from-file-names excludes)))
|
||||
(else
|
||||
(cond
|
||||
((member (car ls) '("-i" "--include"))
|
||||
(lp (cddr ls)
|
||||
(append (or includes '()) (split-mod-names (cadr ls)))
|
||||
excludes))
|
||||
((member (car ls) '("-x" "--exclude"))
|
||||
(lp (cddr ls)
|
||||
includes
|
||||
(append excludes (split-mod-names (cadr ls)))))
|
||||
(else
|
||||
(error "unknown arg" (car ls))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (init-name mod)
|
||||
(string-append "sexp_init_lib_"
|
||||
(string-concatenate (map mangle mod) "_")))
|
||||
|
||||
(define (include-c-lib lib)
|
||||
(display "#define sexp_init_library ")
|
||||
|
|
@ -150,23 +210,16 @@
|
|||
(display " },\n"))
|
||||
|
||||
(define (main args)
|
||||
(if (not (null? args)) (set! args (cdr args)))
|
||||
(find-c-libs
|
||||
(if (and (pair? args) (member (car args) '("-x" "--exclude")))
|
||||
(map (lambda (m)
|
||||
(map (lambda (x) (or (string->number x) (string->symbol x)))
|
||||
(string-split m #\.)))
|
||||
(cdr args))
|
||||
'()))
|
||||
(newline)
|
||||
(for-each include-c-lib c-libs)
|
||||
(newline)
|
||||
(display "typedef struct {\n")
|
||||
(display " const char *name;\n")
|
||||
(display " sexp_init_proc init;\n")
|
||||
(display "} sexp_library_entry_t;\n")
|
||||
(newline)
|
||||
(display "static sexp_library_entry_t sexp_static_libraries[] = {\n")
|
||||
(for-each init-c-lib c-libs)
|
||||
(display " { NULL, NULL }\n")
|
||||
(display "};\n\n"))
|
||||
(let ((c-libs (find-c-libs (if (pair? args) (cdr args) args))))
|
||||
(newline)
|
||||
(for-each include-c-lib c-libs)
|
||||
(newline)
|
||||
(display "typedef struct {\n")
|
||||
(display " const char *name;\n")
|
||||
(display " sexp_init_proc init;\n")
|
||||
(display "} sexp_library_entry_t;\n")
|
||||
(newline)
|
||||
(display "static sexp_library_entry_t sexp_static_libraries[] = {\n")
|
||||
(for-each init-c-lib c-libs)
|
||||
(display " { NULL, NULL }\n")
|
||||
(display "};\n\n")))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue