~ chicken-core (chicken-5) 0b3a73dcf90dff2f3fd50412d6bef5a9945d648c
commit 0b3a73dcf90dff2f3fd50412d6bef5a9945d648c
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Aug 14 21:59:54 2015 +1200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Nov 2 21:29:01 2015 +0100
Process library lists when expanding imports
Moves srfi-id and library-id into the "sys" namespace, so they can be
used in both eval.scm and modules.scm. Once there's a private runtime
module, these should go there.
diff --git a/eval.scm b/eval.scm
index 03c7171c..3d2742a6 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1294,6 +1294,24 @@
'() )
(loop1 (cdr ids)) ) ) ) ) ) )
+;; 1 => srfi-1
+(define (##sys#srfi-id n)
+ (if (fixnum? n)
+ (##sys#intern-symbol
+ (##sys#string-append "srfi-" (##sys#number->string n)))
+ (##sys#syntax-error-hook 'require-extension "invalid SRFI number" n)))
+
+;; (foo bar baz) => foo.bar.baz
+(define (##sys#library-id lib)
+ (define (library-part->string id)
+ (cond ((symbol? id) (##sys#symbol->string id))
+ ((number? id) (##sys#number->string id))
+ ((##sys#error "invalid extension specifier" lib))))
+ (do ((lib (cdr lib) (cdr lib))
+ (str (library-part->string (car lib))
+ (string-append str "." (library-part->string (car lib)))))
+ ((null? lib) (##sys#intern-symbol str))))
+
(define ##sys#do-the-right-thing
(let ((vector->list vector->list))
(lambda (id comp? imp? #!optional (add-req void))
@@ -1303,25 +1321,6 @@
,@(if (and imp? (or (not builtin?) (##sys#current-module)))
`((import ,id)) ;XXX make hygienic
'())))
-
- ;; 1 => "srfi-1"
- (define (srfi-id n)
- (if (fixnum? n)
- (##sys#intern-symbol
- (##sys#string-append "srfi-" (##sys#number->string n)))
- (##sys#syntax-error-hook 'require-extension "invalid SRFI number" n)))
-
- ;; (foo bar baz) => "foo.bar.baz"
- (define (library-id lib)
- (define (library-part->string id)
- (cond ((symbol? id) (##sys#symbol->string id))
- ((number? id) (##sys#number->string id))
- ((##sys#error "invalid extension specifier" lib))))
- (do ((lib (cdr lib) (cdr lib))
- (str (library-part->string (car lib))
- (string-append str "." (library-part->string (car lib)))))
- ((null? lib) (##sys#intern-symbol str))))
-
(define (doit id #!optional (impid id))
(cond ((or (memq id builtin-features)
(and comp? (memq id builtin-features/compiled)))
@@ -1394,7 +1393,7 @@
(exp
`(##core#begin
,@(map (lambda (n)
- (let ((rid (srfi-id n)))
+ (let ((rid (##sys#srfi-id n)))
(let-values (((exp f2 _) (doit rid)))
(set! f (or f f2))
exp)))
@@ -1404,15 +1403,15 @@
(let follow ((id2 id))
(if (and (pair? id2) (pair? (cdr id2)))
(if (and (eq? 'srfi (car id2)) (null? (cddr id2))) ; only allow one number
- (doit (srfi-id (cadr id2)) id)
+ (doit (##sys#srfi-id (cadr id2)) id)
(follow (cadr id2)))
(doit id2 id))))
((chicken)
(if (memq (cadr id) ##sys#core-chicken-modules)
- (doit (cadr id) (library-id id))
- (doit (library-id id))))
+ (doit (cadr id) (##sys#library-id id))
+ (doit (##sys#library-id id))))
(else
- (doit (library-id id)))))
+ (doit (##sys#library-id id)))))
((symbol? id)
(doit id))
(else
diff --git a/modules.scm b/modules.scm
index d85ef426..9b5cdaf9 100644
--- a/modules.scm
+++ b/modules.scm
@@ -602,12 +602,9 @@
(values name name vexp sexp iexp)))
(define (import-spec spec)
(cond ((symbol? spec) (import-name spec))
- ((or (not (list? spec)) (< (length spec) 2))
- (##sys#syntax-error-hook loc "invalid import specification" spec))
+ ((null? (cdr spec)) (import-name (car spec))) ; single library component
((and (c %srfi (car spec)) (fixnum? (cadr spec)) (null? (cddr spec))) ; only one number
- (import-name
- (##sys#intern-symbol
- (##sys#string-append "srfi-" (##sys#number->string (cadr spec))))))
+ (import-name (##sys#srfi-id (cadr spec))))
(else
(let ((head (car spec))
(imports (cddr spec)))
@@ -686,7 +683,8 @@
(##sys#string-append (tostr pref) (##sys#symbol->string (car imp))))
(cdr imp) ) )
(values name `(,head ,form ,pref) (map ren impv) (map ren imps) impi)))
- (else (##sys#syntax-error-hook loc "invalid import specification" spec))))))))
+ (else
+ (import-name (##sys#library-id spec)))))))))
(##sys#check-syntax loc x '(_ . #(_ 1)))
(let ((cm (##sys#current-module)))
(for-each
Trap