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

* added error stubs for the various import modifiers

This commit is contained in:
Abdulaziz Ghuloum 2007-05-04 09:45:41 -04:00
parent 19b1df212f
commit f9d0e76422
2 changed files with 45 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

46
src/libsyntax.ss
View File

@ -1946,7 +1946,12 @@
(cond
[(memq x ls) ls]
[else (cons x ls)]))
(define (get-import-subst/libs imp*)
(define (set-union ls1 ls2)
(cond
[(null? ls1) ls2]
[(memq (car ls1) ls2) (set-union (cdr ls1) ls2)]
[else (cons (car ls1) (set-union (cdr ls1) ls2))]))
(define (get-import-subst/libs-old imp*)
(define (merge-substs s subst)
(cond
[(null? s) subst]
@ -1976,6 +1981,45 @@
(let-values ([(s _r) (library-subst/env lib)])
(values (merge-substs s subst)
(set-cons lib lib*)))))]))
(define (get-import-subst/libs imp*)
(define (merge-substs s subst)
(cond
[(null? s) subst]
[else
(let ([a (car s)])
(let ([name (car a)] [label (cdr a)])
(cond
[(assq name subst) =>
(lambda (x)
(cond
[(eq? (cdr x) label)
(merge-substs (cdr s) subst)]
[else
(error 'import
"two imports of ~s with different bindings"
name)]))]
[else
(cons a (merge-substs (cdr s) subst))])))]))
(define (get-import spec)
(unless (pair? spec)
(error 'import "invalid import spec ~s" spec))
(case (car spec)
[(rename) (error #f "rename found")]
[(except) (error #f "except found")]
[(only) (error #f "only found")]
[(prefix) (error #f "prefix found")]
[else
(let ([lib (find-library-by-name spec)])
(let-values ([(s _r) (library-subst/env lib)])
(values s (list lib))))]))
(cond
[(null? imp*) (values '() '())]
[else
(let-values ([(subst1 lib1*)
(get-import-subst/libs (cdr imp*))])
(let-values ([(subst2 lib2*) (get-import (car imp*))])
(values (merge-substs subst1 subst2)
(set-union lib1* lib2*))))]))
(define (make-top-rib subst)
(let ([rib (make-empty-rib)])
(for-each