better error message when a library file "foo.ss" does not contain
the expected library name (foo).
This commit is contained in:
parent
81db526510
commit
6741ac2817
|
@ -1 +1 @@
|
|||
1496
|
||||
1498
|
||||
|
|
|
@ -3546,15 +3546,17 @@
|
|||
macro* export-subst export-env))))))))))))))
|
||||
|
||||
(define core-library-expander
|
||||
(lambda (e)
|
||||
(let-values (((name* exp* imp* b*) (parse-library e)))
|
||||
(let-values (((name ver) (parse-library-name name*)))
|
||||
(let-values (((imp* invoke-req* visit-req* invoke-code
|
||||
visit-code export-subst export-env)
|
||||
(library-body-expander exp* imp* b* #f)))
|
||||
(values name ver imp* invoke-req* visit-req*
|
||||
invoke-code visit-code export-subst
|
||||
export-env))))))
|
||||
(case-lambda
|
||||
[(e verify-name)
|
||||
(let-values (((name* exp* imp* b*) (parse-library e)))
|
||||
(let-values (((name ver) (parse-library-name name*)))
|
||||
(verify-name name)
|
||||
(let-values (((imp* invoke-req* visit-req* invoke-code
|
||||
visit-code export-subst export-env)
|
||||
(library-body-expander exp* imp* b* #f)))
|
||||
(values name ver imp* invoke-req* visit-req*
|
||||
invoke-code visit-code export-subst
|
||||
export-env))))]))
|
||||
|
||||
(define (parse-top-level-program e*)
|
||||
(syntax-match e* ()
|
||||
|
@ -3665,7 +3667,7 @@
|
|||
;;; returns its invoke-code, visit-code, subst and env.
|
||||
(define library-expander
|
||||
(case-lambda
|
||||
[(x filename)
|
||||
[(x filename verify-name)
|
||||
(define (build-visit-code macro*)
|
||||
(if (null? macro*)
|
||||
(build-void)
|
||||
|
@ -3681,7 +3683,7 @@
|
|||
macro*))
|
||||
(let-values (((name ver imp* inv* vis*
|
||||
invoke-code macro* export-subst export-env)
|
||||
(core-library-expander x)))
|
||||
(core-library-expander x verify-name)))
|
||||
(let ((id (gensym))
|
||||
(name name)
|
||||
(ver ver)
|
||||
|
@ -3701,7 +3703,10 @@
|
|||
(values id name ver imp* vis* inv*
|
||||
invoke-code visit-code
|
||||
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
|
||||
;;; be) be used in the "next" system. So, we drop it.
|
||||
|
|
|
@ -226,7 +226,19 @@
|
|||
[else
|
||||
((current-library-expander)
|
||||
(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)
|
||||
(if (procedure? f)
|
||||
f
|
||||
|
|
Loading…
Reference in New Issue