~ chicken-core (chicken-5) 5c70f58b6c562c5449d8b1709da663af36fe1445
commit 5c70f58b6c562c5449d8b1709da663af36fe1445
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Aug 31 11:44:50 2011 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Aug 31 11:44:50 2011 +0200
show correct extension-id when complaining about a missing extension
diff --git a/compiler.scm b/compiler.scm
index 91dc28ab..a68b01fa 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -600,7 +600,8 @@
(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 realid)
+ (##sys#do-the-right-thing id #t imp?)))
(unless (or f
(and (symbol? id)
(or (feature? id)
@@ -609,7 +610,7 @@
id 'require-extension)
#f)) ) )
(warning
- (sprintf "extension `~A' is currently not installed" id)))
+ (sprintf "extension `~A' is currently not installed" realid)))
`(##core#begin ,exp ,(loop (cdr ids))) ) ) ) )
e se dest ldest h) ) )
diff --git a/eval.scm b/eval.scm
index 35a45f8f..5aec2ce2 100644
--- a/eval.scm
+++ b/eval.scm
@@ -686,7 +686,7 @@
(let loop ([ids (##sys#strip-syntax (cadr x))])
(if (null? ids)
'(##core#undefined)
- (let-values (((exp _)
+ (let-values (((exp f real-id)
(##sys#do-the-right-thing (car ids) #f imp?)))
`(##core#begin ,exp ,(loop (cdr ids))) ) ) )
e #f tf cntr se) ) ]
@@ -1262,7 +1262,7 @@
(if comp?
(memq id builtin-features/compiled)
(##sys#feature? id) ) )
- (values (impform '(##core#undefined) impid #t) #t) )
+ (values (impform '(##core#undefined) impid #t) #t id) )
((memq id ##sys#core-library-modules)
(values
(impform
@@ -1270,7 +1270,7 @@
`(##core#declare (uses ,id))
`(##sys#load-library ',id #f) )
impid #f)
- #t) )
+ #t id) )
((memq id ##sys#core-syntax-modules)
(values
(impform
@@ -1278,7 +1278,7 @@
`(##core#declare (uses ,id))
`(##sys#load-library ',id #f) )
impid #t)
- #t) )
+ #t id) )
((memq id ##sys#explicit-library-modules)
(let* ((info (##sys#extension-information id 'require-extension))
(nr (assq 'import-only info))
@@ -1293,7 +1293,7 @@
`(##sys#load-library ',id #f) )
'(##core#undefined))
impid #f))
- #t) ) )
+ #t id) ) )
(else
(let ((info (##sys#extension-information id 'require-extension)))
(cond (info
@@ -1314,14 +1314,14 @@
(cond (rr (cdr rr))
(else (list id)) ) ) ) ) ) ) )
impid #f)
- #t) ) )
+ #t id) ) )
(else
(add-req id #f)
(values
(impform
`(##sys#require ',id)
impid #f)
- #f)))))))
+ #f id)))))))
(cond ((and (pair? id) (symbol? (car id)))
(case (car id)
((srfi)
@@ -1334,7 +1334,7 @@
(set! f (or f f2))
exp)))
(cdr id)))))
- (values exp f)))
+ (values exp f id))) ;XXX `id' not fully correct
((rename except only prefix)
(let follow ((id2 id))
(if (and (pair? id2) (pair? (cdr id2)))
Trap