~ chicken-core (chicken-5) 5ca3094f92b6d0c1e103df0bc0cb7e5ebe6f5e20
commit 5ca3094f92b6d0c1e103df0bc0cb7e5ebe6f5e20
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Feb 5 12:14:07 2010 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Feb 5 12:14:07 2010 +0100
strip extensions-specifiers and -ids in require-extension
diff --git a/compiler.scm b/compiler.scm
index 1868ba6c..12af8c50 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -594,11 +594,13 @@
((##core#require-extension)
(let ((imp? (caddr x)))
(walk
- (let loop ([ids (cadr x)])
+ (let loop ([ids (##sys#strip-syntax (cadr x))])
(if (null? ids)
'(##core#undefined)
(let ([id (car ids)])
- (let-values ([(exp f) (##sys#do-the-right-thing id #t imp?)])
+ (let-values ([(exp f)
+ (##sys#do-the-right-thing
+ id #t imp?)])
(unless (or f
(and (symbol? id)
(or (feature? id)
diff --git a/eval.scm b/eval.scm
index ead28611..d114149b 100644
--- a/eval.scm
+++ b/eval.scm
@@ -706,11 +706,12 @@
[(##core#require-extension)
(let ((imp? (caddr x)))
(compile
- (let loop ([ids (cadr x)])
+ (let loop ([ids (##sys#strip-syntax (cadr x))])
(if (null? ids)
'(##core#undefined)
- (let-values ([(exp _)
- (##sys#do-the-right-thing (car ids) #f imp?)])
+ (let-values ([(exp _)
+ (##sys#do-the-right-thing
+ (car ids) #f imp?)])
`(##core#begin ,exp ,(loop (cdr ids))) ) ) )
e #f tf cntr se) ) ]
@@ -1280,17 +1281,20 @@
id #f)
#f)))))))
(if (and (pair? id) (symbol? (car id)))
- (let ((a (assq (##sys#slot id 0) ##sys#extension-specifiers)))
+ (let ((a (assq (##sys#slot id 0)
+ ##sys#extension-specifiers)))
(if a
(let ((a ((##sys#slot a 1) id)))
- (cond ((string? a) (values `(load ,a) #f))
+ (cond ((string? a) (values `(load ,a) #f)) ;XXX hygiene
((vector? a)
(let loop ((specs (vector->list a))
(exps '())
(f #f) )
(if (null? specs)
(values `(##core#begin ,@(reverse exps)) f)
- (let-values (((exp fi) (##sys#do-the-right-thing (car specs) comp? imp?)))
+ (let-values (((exp fi)
+ (##sys#do-the-right-thing
+ (car specs) comp? imp?)))
(loop (cdr specs)
(cons exp exps)
(or fi f) ) ) ) ) )
@@ -1304,7 +1308,8 @@
(define (set-extension-specifier! name proc)
(##sys#check-symbol name 'set-extension-specifier!)
- (let ([a (assq name ##sys#extension-specifiers)])
+ (let* ((name (##sys#strip-syntax name))
+ (a (assq name ##sys#extension-specifiers)))
(if a
(let ([old (##sys#slot a 1)])
(##sys#setslot a 1 (lambda (spec) (proc spec old))) )
Trap