Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

genstatic fixes

Browse source
This commit is contained in:
Alex Shinn 2015-02-13 19:03:12 +09:00
parent b6fb51f1f2
commit a7877b773b
1 changed files with 29 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

68
tools/chibi-genstatic
View file

@ -270,42 +270,11 @@
(else (else
(lp modules)))))) (lp modules))))))
(define (find-c-libs args) (define (find-c-libs includes excludes cfiles)
(define (split-mod-names str) (cons (if includes
(map (lambda (m) (find-c-libs-from-module-names includes)
(map (lambda (x) (or (string->number x) (string->symbol x))) (find-c-libs-from-file-names excludes))
(string-split m #\.))) cfiles))
(string-split str #\,)))
(let lp ((ls args)
(includes #f)
(excludes '())
(cfiles '()))
(cond
((null? ls)
(cons
(if includes
(find-c-libs-from-module-names includes)
(find-c-libs-from-file-names excludes))
cfiles))
(else
(cond
((member (car ls) '("-i" "--include"))
(lp (cddr ls)
(append (or includes '()) (split-mod-names (cadr ls)))
excludes
cfiles))
((member (car ls) '("-x" "--exclude"))
(lp (cddr ls)
includes
(append excludes (split-mod-names (cadr ls)))
cfiles))
((member (car ls) '("-c" "--cfiles"))
(lp (cddr ls)
includes
excludes
(append cfiles (string-split (cadr ls) #\,))))
(else
(error "unknown arg" (car ls))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -358,11 +327,20 @@
(display (init-name (cdr lib))) (display (init-name (cdr lib)))
(display " },\n")) (display " },\n"))
(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 ((args (command-line))) (let ((args (command-line)))
(if (pair? args) (if (pair? args)
(set! wdir (path-directory (path-directory (car args))))) (set! wdir (path-directory (path-directory (car args)))))
(let lp ((args (if (pair? args) (cdr args) args)) (let lp ((args (if (pair? args) (cdr args) args))
(features '())) (features '())
(includes #f)
(excludes '())
(cfiles '()))
(cond (cond
((and (pair? args) (not (equal? "" (car args))) ((and (pair? args) (not (equal? "" (car args)))
(eqv? #\- (string-ref (car args) 0))) (eqv? #\- (string-ref (car args) 0)))
@ -370,13 +348,25 @@
((--features) ((--features)
(if (null? (cdr args)) (if (null? (cdr args))
(error "--features requires an argument")) (error "--features requires an argument"))
(lp (cddr args) (append features (string-split (cadr args) #\,)))) (lp (cddr args) (append features (string-split (cadr args) #\,))
includes excludes cfiles))
((-i --include)
(lp (cddr args) features
(append (or includes '()) (split-mod-names (cadr args)))
excludes cfiles))
((-x --exclude)
(lp (cddr args) features includes
(append excludes (split-mod-names (cadr args)))
cfiles))
((-c --cfiles)
(lp (cddr args) features includes excludes
(append cfiles (string-split (cadr args) #\,))))
(else (else
(error "unknown option" (car args))))) (error "unknown option" (car args)))))
(else (else
(if (pair? features) (if (pair? features)
(set! *features* features)) (set! *features* features))
(let* ((c-libs+c-files (find-c-libs (if (pair? args) (cdr args) args))) (let* ((c-libs+c-files (find-c-libs includes excludes cfiles))
(c-libs (car c-libs+c-files)) (c-libs (car c-libs+c-files))
(c-files (cdr c-libs+c-files)) (c-files (cdr c-libs+c-files))
(inline? #t)) (inline? #t))