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*))))]))))))
(wait eval escape-k)))
(define new-cafe
(define do-new-cafe
(lambda (eval)
(dynamic-wind
(lambda () (set! eval-depth (fxadd1 eval-depth)))
@ -99,10 +99,10 @@ description:
(primitive-set! 'new-cafe
(case-lambda
[() (new-cafe eval)]
[() (do-new-cafe eval)]
[(p)
(unless (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"
type)]))))]))))))
(define chi-library-internal
(lambda (e* r rib)
(lambda (e* r rib kwd*)
(define return
(lambda (init* r mr lhs* lex* 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
[(null? e*) (return e* r mr lhs* lex* rhs*)]
[else
@ -1379,7 +1379,9 @@
[(define)
(let-values ([(id rhs) (parse-define e)])
(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)]
[lab (gen-label id)])
(extend-rib! rib id lab)
@ -1415,9 +1417,11 @@
(let-values ([(name exp* b*) (parse-library e)])
(let ([rib (make-scheme-rib)]
[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*)
(chi-library-internal b* r rib)])
(chi-library-internal b* r rib kwd*)])
(build-letrec no-source
lex*
(chi-rhs* rhs* r mr)