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

* (ikarus syntax) now recognized letrec* (untested).

This commit is contained in:
Abdulaziz Ghuloum 2007-05-09 06:09:37 -04:00
parent 5c2220f9bb
commit f5a980efd6
2 changed files with 30 additions and 21 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.

51
src/ikarus.syntax.ss
View File

@ -78,7 +78,10 @@
(lambda () '(#%void))) (lambda () '(#%void)))
(define build-letrec (define build-letrec
(lambda (ae vars val-exps body-exp) (lambda (ae vars val-exps body-exp)
(if (null? vars) body-exp `(letrec ,(map list vars val-exps) ,body-exp))))) (if (null? vars) body-exp `(letrec ,(map list vars val-exps) ,body-exp))))
(define build-letrec*
(lambda (ae vars val-exps body-exp)
(if (null? vars) body-exp `(letrec* ,(map list vars val-exps) ,body-exp)))))
(define top-mark* '(top)) (define top-mark* '(top))
(define top-marked? (define top-marked?
(lambda (m*) (memq 'top m*))) (lambda (m*) (memq 'top m*)))
@ -591,26 +594,31 @@
(build-lambda no-source '() (car rhs*)) (build-lambda no-source '() (car rhs*))
(build-lambda no-source (car lex**) (build-lambda no-source (car lex**)
(f (cdr lex**) (cdr rhs*)))))])))))]))) (f (cdr lex**) (cdr rhs*)))))])))))])))
(define letrec-transformer (module (letrec-transformer letrec*-transformer)
(lambda (e r mr) (define helper
(syntax-match e () (lambda (e r mr letrec?)
[(_ ([lhs* rhs*] ...) b b* ...) (syntax-match e ()
(if (not (valid-bound-ids? lhs*)) [(_ ([lhs* rhs*] ...) b b* ...)
(stx-error e "duplicate identifiers") (if (not (valid-bound-ids? lhs*))
(let ([lex* (map gen-lexical lhs*)] (stx-error e "duplicate identifiers")
[lab* (map gen-label lhs*)]) (let ([lex* (map gen-lexical lhs*)]
(let ([rib (make-full-rib lhs* lab*)] [lab* (map gen-label lhs*)])
[r (add-lexicals lab* lex* r)]) (let ([rib (make-full-rib lhs* lab*)]
(let ([body (chi-internal [r (add-lexicals lab* lex* r)])
(add-subst rib (cons b b*)) (let ([body (chi-internal
r mr)] (add-subst rib (cons b b*))
[rhs* (chi-expr* r mr)]
(map (lambda (x) [rhs* (chi-expr*
(add-subst rib x)) (map (lambda (x)
rhs*) (add-subst rib x))
r mr)]) rhs*)
(build-letrec no-source r mr)])
lex* rhs* body)))))]))) ((if letrec? build-letrec build-letrec*)
no-source lex* rhs* body)))))])))
(define letrec-transformer
(lambda (e r mr) (helper e r mr #t)))
(define letrec*-transformer
(lambda (e r mr) (helper e r mr #f))))
(define type-descriptor-transformer (define type-descriptor-transformer
(lambda (e r mr) (lambda (e r mr)
(syntax-match e () (syntax-match e ()
@ -1460,6 +1468,7 @@
[(case-lambda) case-lambda-transformer] [(case-lambda) case-lambda-transformer]
[(let-values) let-values-transformer] [(let-values) let-values-transformer]
[(letrec) letrec-transformer] [(letrec) letrec-transformer]
[(letrec*) letrec*-transformer]
[(case) case-transformer] [(case) case-transformer]
[(if) if-transformer] [(if) if-transformer]
[(when) when-transformer] [(when) when-transformer]