conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

better error message when a library file "foo.ss" does not contain 

the expected library name (foo).
This commit is contained in:
Abdulaziz Ghuloum 2008-06-05 00:58:04 -07:00
parent 81db526510
commit 6741ac2817
3 changed files with 31 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1496 1498

29
scheme/psyntax.expander.ss
View File

@ -3546,15 +3546,17 @@
macro* export-subst export-env)))))))))))))) macro* export-subst export-env))))))))))))))
(define core-library-expander (define core-library-expander
(lambda (e) (case-lambda
(let-values (((name* exp* imp* b*) (parse-library e))) [(e verify-name)
(let-values (((name ver) (parse-library-name name*))) (let-values (((name* exp* imp* b*) (parse-library e)))
(let-values (((imp* invoke-req* visit-req* invoke-code (let-values (((name ver) (parse-library-name name*)))
visit-code export-subst export-env) (verify-name name)
(library-body-expander exp* imp* b* #f))) (let-values (((imp* invoke-req* visit-req* invoke-code
(values name ver imp* invoke-req* visit-req* visit-code export-subst export-env)
invoke-code visit-code export-subst (library-body-expander exp* imp* b* #f)))
export-env)))))) (values name ver imp* invoke-req* visit-req*
invoke-code visit-code export-subst
export-env))))]))
(define (parse-top-level-program e*) (define (parse-top-level-program e*)
(syntax-match e* () (syntax-match e* ()
@ -3665,7 +3667,7 @@
;;; returns its invoke-code, visit-code, subst and env. ;;; returns its invoke-code, visit-code, subst and env.
(define library-expander (define library-expander
(case-lambda (case-lambda
[(x filename) [(x filename verify-name)
(define (build-visit-code macro*) (define (build-visit-code macro*)
(if (null? macro*) (if (null? macro*)
(build-void) (build-void)
@ -3681,7 +3683,7 @@
macro*)) macro*))
(let-values (((name ver imp* inv* vis* (let-values (((name ver imp* inv* vis*
invoke-code macro* export-subst export-env) invoke-code macro* export-subst export-env)
(core-library-expander x))) (core-library-expander x verify-name)))
(let ((id (gensym)) (let ((id (gensym))
(name name) (name name)
(ver ver) (ver ver)
@ -3701,7 +3703,10 @@
(values id name ver imp* vis* inv* (values id name ver imp* vis* inv*
invoke-code visit-code invoke-code visit-code
export-subst export-env)))] export-subst export-env)))]
[(x) (library-expander x #f)])) [(x filename)
(library-expander x filename (lambda (x) (values)))]
[(x)
(library-expander x #f (lambda (x) (values)))]))
;;; when bootstrapping the system, visit-code is not (and cannot ;;; when bootstrapping the system, visit-code is not (and cannot
;;; be) be used in the "next" system. So, we drop it. ;;; be) be used in the "next" system. So, we drop it.

14
scheme/psyntax.library-manager.ss
View File

@ -226,7 +226,19 @@
[else [else
((current-library-expander) ((current-library-expander)
(read-library-source-file file-name) (read-library-source-file file-name)
file-name)]))) file-name
(lambda (name)
(unless (equal? name x)
(assertion-violation 'import
(let-values ([(p e) (open-string-output-port)])
(display "expected to find library " p)
(write x p)
(display " in file " p)
(display file-name p)
(display ", found " p)
(write name p)
(display " instead" p)
(e))))))])))
(lambda (f) (lambda (f)
(if (procedure? f) (if (procedure? f)
f f