Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-08 13:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

recursively install library-include-declarations

Browse source
This commit is contained in:
Alex Shinn 2017-01-14 16:23:17 +09:00
parent 302ee50075
commit 789b448e54
1 changed files with 47 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
lib/chibi/snow/package.scm
View file

@ -430,38 +430,63 @@
#f))) #f)))
(else #f))) (else #f)))
(define (library-analyze-body impl config body dir)
(let lp ((ls body) (include-decls '()) (res '()))
(cond
((null? ls) (values (reverse res) (reverse include-decls)))
(else
(let ((decl (car ls)))
(case (and (pair? decl) (car decl))
((cond-expand)
(cond
((find (lambda (x) (check-cond-expand impl config (car x)))
(cdar ls))
=> (lambda (x) (lp (append (cdr x) (cdr ls)) include-decls res)))
(else (lp (cdr ls) include-decls res))))
((include-library-declarations)
(let* ((ls (if (pair? (cddr decl))
`((include-library-declarations ,@(cddr decl))
,@(cdr ls))
(cdr ls)))
(file (make-path dir (cadr decl)))
(dir (path-directory file))
(include-decls (cons file include-decls))
(sexp (call-with-input-file file port->sexp-list)))
(if (and (pair? sexp) (list? sexp))
(let-values (((lib sub-include-decls)
(library-analyze-body impl config sexp dir)))
(lp ls
(append (reverse sub-include-decls) include-decls)
(append (reverse lib) res)))
(lp ls include-decls res))))
(else
(lp (cdr ls)
include-decls
(if (pair? decl) (cons decl res) res)))))))))
;; We can't use the native library system introspection since we may ;; We can't use the native library system introspection since we may
;; be analyzing a library which can't be loaded in the native system. ;; be analyzing a library which can't be loaded in the native system.
(define (library-analyze impl config file) (define (library-analyze impl config file)
(let ((sexp (call-with-input-file file read))) (let ((sexp (call-with-input-file file read)))
(and (list? sexp) (and (list? sexp)
(memq (car sexp) '(define-library library define-module module)) (memq (car sexp) '(define-library library define-module module))
(let analyze ((ls (cddr sexp))) (pair? sexp)
(cond (pair? (cdr sexp))
((null? ls) '()) (library-analyze-body impl config (cddr sexp) (path-directory file)))))
(else
(append
(case (caar ls)
((cond-expand)
(cond
((find (lambda (x) (check-cond-expand impl config (car x)))
(cdar ls))
=> (lambda (x) (analyze (cdr x))))
(else (analyze (cdr ls)))))
(else (list (car ls))))
(analyze (cdr ls)))))))))
(define (library-include-files impl config file) (define (library-include-files impl config file)
(let ((lib (library-analyze impl config file)) (let-values (((lib include-decls) (library-analyze impl config file))
(dir (path-directory file))) ((dir) (path-directory file)))
(append-map (append
(lambda (x) (map (lambda (y) (make-path dir y)) (cdr x))) (append-map
(filter (lambda (x) (and (pair? x) (memq (car x) '(include include-ci)))) (lambda (x) (map (lambda (y) (make-path dir y)) (cdr x)))
lib)))) (filter (lambda (x) (and (pair? x) (memq (car x) '(include include-ci))))
lib))
include-decls)))
(define (library-shared-include-files impl config file) (define (library-shared-include-files impl config file)
(let ((lib (library-analyze impl config file)) (let-values (((lib include-decls) (library-analyze impl config file))
(dir (path-directory file))) ((dir) (path-directory file)))
(append-map (append-map
(lambda (x) (map (lambda (y) (make-path dir y)) (cdr x))) (lambda (x) (map (lambda (y) (make-path dir y)) (cdr x)))
(filter (lambda (x) (and (pair? x) (eq? (car x) 'include-shared))) (filter (lambda (x) (and (pair? x) (eq? (car x) 'include-shared)))