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

* moved the position of the rib argument to chi-body* to the end 

in (ikarus syntax).
This commit is contained in:
Abdulaziz Ghuloum 2007-05-09 06:39:42 -04:00
parent 3be2a9d9af
commit e414b2daca
2 changed files with 12 additions and 12 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.

24
src/ikarus.syntax.ss
View File

@ -1667,7 +1667,7 @@
(let-values ([(e* r mr lex* rhs* mod** kwd*) (let-values ([(e* r mr lex* rhs* mod** kwd*)
(chi-body* (map (lambda (x) (add-subst rib x)) (chi-body* (map (lambda (x) (add-subst rib x))
(syntax->list e*)) (syntax->list e*))
rib r mr '() '() '() '())]) r mr '() '() '() '() rib)])
(when (null? e*) (when (null? e*)
(stx-error e* "no expression in body")) (stx-error e* "no expression in body"))
(let ([rhs* (chi-rhs* rhs* r mr)] (let ([rhs* (chi-rhs* rhs* r mr)]
@ -1678,7 +1678,7 @@
(define chi-library-internal (define chi-library-internal
(lambda (e* rib) (lambda (e* rib)
(let-values ([(e* r mr lex* rhs* mod** _kwd*) (let-values ([(e* r mr lex* rhs* mod** _kwd*)
(chi-body* e* rib '() '() '() '() '() '())]) (chi-body* e* '() '() '() '() '() '() rib)])
(values (append (apply append (reverse mod**)) e*) (values (append (apply append (reverse mod**)) e*)
r mr (reverse lex*) (reverse rhs*))))) r mr (reverse lex*) (reverse rhs*)))))
(define chi-internal-module (define chi-internal-module
@ -1703,7 +1703,7 @@
[e* (map (lambda (x) (add-subst rib x)) [e* (map (lambda (x) (add-subst rib x))
(syntax->list e*))]) (syntax->list e*))])
(let-values ([(e* r mr lex* rhs* mod** kwd*) (let-values ([(e* r mr lex* rhs* mod** kwd*)
(chi-body* e* rib r mr lex* rhs* mod** kwd*)]) (chi-body* e* r mr lex* rhs* mod** kwd* rib)])
(let ([exp-lab* (let ([exp-lab*
(map (lambda (x) (map (lambda (x)
(or (id->label (add-subst rib x)) (or (id->label (add-subst rib x))
@ -1721,7 +1721,7 @@
(cons (cons lab (cons '$module iface)) mr) (cons (cons lab (cons '$module iface)) mr)
mod** kwd*))))))))) mod** kwd*)))))))))
(define chi-body* (define chi-body*
(lambda (e* rib r mr lex* rhs* mod** kwd*) (lambda (e* r mr lex* rhs* mod** kwd* rib)
(cond (cond
[(null? e*) (values e* r mr lex* rhs* mod** kwd*)] [(null? e*) (values e* r mr lex* rhs* mod** kwd*)]
[else [else
@ -1737,9 +1737,9 @@
[lab (gen-label id)]) [lab (gen-label id)])
(extend-rib/check! rib id lab) (extend-rib/check! rib id lab)
(chi-body* (cdr e*) (chi-body* (cdr e*)
rib (add-lexical lab lex r) mr (add-lexical lab lex r) mr
(cons lex lex*) (cons rhs rhs*) (cons lex lex*) (cons rhs rhs*)
mod** kwd*)))] mod** kwd* rib)))]
[(define-syntax) [(define-syntax)
(let-values ([(id rhs) (parse-define-syntax e)]) (let-values ([(id rhs) (parse-define-syntax e)])
(when (bound-id-member? id kwd*) (when (bound-id-member? id kwd*)
@ -1749,30 +1749,30 @@
(extend-rib/check! rib id lab) (extend-rib/check! rib id lab)
(let ([b (make-eval-transformer expanded-rhs)]) (let ([b (make-eval-transformer expanded-rhs)])
(chi-body* (cdr e*) (chi-body* (cdr e*)
rib (cons (cons lab b) r) (cons (cons lab b) mr) (cons (cons lab b) r) (cons (cons lab b) mr)
lex* rhs* lex* rhs*
mod** kwd*))))] mod** kwd* rib))))]
[(module) [(module)
(let-values ([(lex* rhs* m-exp-id* m-exp-lab* r mr mod** kwd*) (let-values ([(lex* rhs* m-exp-id* m-exp-lab* r mr mod** kwd*)
(chi-internal-module e r mr lex* rhs* mod** kwd*)]) (chi-internal-module e r mr lex* rhs* mod** kwd*)])
(for-each (for-each
(lambda (id lab) (extend-rib/check! rib id lab)) (lambda (id lab) (extend-rib/check! rib id lab))
m-exp-id* m-exp-lab*) m-exp-id* m-exp-lab*)
(chi-body* (cdr e*) rib r mr lex* rhs* mod** kwd*))] (chi-body* (cdr e*) r mr lex* rhs* mod** kwd* rib))]
[(begin) [(begin)
(syntax-match e () (syntax-match e ()
[(_ x* ...) [(_ x* ...)
(chi-body* (append x* (cdr e*)) (chi-body* (append x* (cdr e*))
rib r mr lex* rhs* mod** kwd*)])] r mr lex* rhs* mod** kwd* rib)])]
[(global-macro) (error 'chi-body "global macro")] [(global-macro) (error 'chi-body "global macro")]
[(local-macro) [(local-macro)
(chi-body* (chi-body*
(cons (add-subst rib (chi-local-macro value e)) (cdr e*)) (cons (add-subst rib (chi-local-macro value e)) (cdr e*))
rib r mr lex* rhs* mod** kwd*)] r mr lex* rhs* mod** kwd* rib)]
[(macro) [(macro)
(chi-body* (chi-body*
(cons (add-subst rib (chi-macro value e)) (cdr e*)) (cons (add-subst rib (chi-macro value e)) (cdr e*))
rib r mr lex* rhs* mod** kwd*)] r mr lex* rhs* mod** kwd* rib)]
[else [else
(values e* r mr lex* rhs* mod** kwd*)]))))]))) (values e* r mr lex* rhs* mod** kwd*)]))))])))
(define (expand-transformer expr r) (define (expand-transformer expr r)