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

* chi-library now enforces that imported ids cannot be defined 

in the body of the library
This commit is contained in:
Abdulaziz Ghuloum 2007-04-29 21:59:06 -04:00
parent cf3ff29874
commit 726d53ac1b
3 changed files with 12 additions and 8 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.

6
src/libcafe.ss
View File

@ -87,7 +87,7 @@ description:
v*))))])))))) v*))))]))))))
(wait eval escape-k))) (wait eval escape-k)))
(define new-cafe (define do-new-cafe
(lambda (eval) (lambda (eval)
(dynamic-wind (dynamic-wind
(lambda () (set! eval-depth (fxadd1 eval-depth))) (lambda () (set! eval-depth (fxadd1 eval-depth)))
@ -99,10 +99,10 @@ description:
(primitive-set! 'new-cafe (primitive-set! 'new-cafe
(case-lambda (case-lambda
[() (new-cafe eval)] [() (do-new-cafe eval)]
[(p) [(p)
(unless (procedure? p) (unless (procedure? p)
(error 'new-cafe "~s is not a procedure" p)) (error 'new-cafe "~s is not a procedure" p))
(new-cafe p)])) (do-new-cafe p)]))
) )

14
src/syntax.ss
View File

@ -1363,11 +1363,11 @@
"cannot handle ~s" "cannot handle ~s"
type)]))))])))))) type)]))))]))))))
(define chi-library-internal (define chi-library-internal
(lambda (e* r rib) (lambda (e* r rib kwd*)
(define return (define return
(lambda (init* r mr lhs* lex* rhs*) (lambda (init* r mr lhs* lex* rhs*)
(values init* r mr (reverse lhs*) (reverse lex*) (reverse rhs*)))) (values init* r mr (reverse lhs*) (reverse lex*) (reverse rhs*))))
(let f ([e* e*] [r r] [mr r] [lhs* '()] [lex* '()] [rhs* '()] [kwd* '()]) (let f ([e* e*] [r r] [mr r] [lhs* '()] [lex* '()] [rhs* '()] [kwd* kwd*])
(cond (cond
[(null? e*) (return e* r mr lhs* lex* rhs*)] [(null? e*) (return e* r mr lhs* lex* rhs*)]
[else [else
@ -1379,7 +1379,9 @@
[(define) [(define)
(let-values ([(id rhs) (parse-define e)]) (let-values ([(id rhs) (parse-define e)])
(when (bound-id-member? id kwd*) (when (bound-id-member? id kwd*)
(stx-error id "undefined identifier")) (stx-error id "cannt redefine identifier"))
(when (bound-id-member? id lhs*)
(stx-error id "multiple definition"))
(let ([lex (gen-lexical id)] (let ([lex (gen-lexical id)]
[lab (gen-label id)]) [lab (gen-label id)])
(extend-rib! rib id lab) (extend-rib! rib id lab)
@ -1415,9 +1417,11 @@
(let-values ([(name exp* b*) (parse-library e)]) (let-values ([(name exp* b*) (parse-library e)])
(let ([rib (make-scheme-rib)] (let ([rib (make-scheme-rib)]
[r (make-scheme-env)]) [r (make-scheme-env)])
(let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)]) (let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)]
[kwd* (map (lambda (sym mark*) (stx sym mark* (list rib)))
(rib-sym* rib) (rib-mark** rib))])
(let-values ([(init* r mr lhs* lex* rhs*) (let-values ([(init* r mr lhs* lex* rhs*)
(chi-library-internal b* r rib)]) (chi-library-internal b* r rib kwd*)])
(build-letrec no-source (build-letrec no-source
lex* lex*
(chi-rhs* rhs* r mr) (chi-rhs* rhs* r mr)