diff options
author | Andy Wingo <wingo@pobox.com> | 2010-06-17 10:49:00 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-06-17 13:43:26 +0200 |
commit | fb6e61ca21b397308474a6a553f7d502d0113251 (patch) | |
tree | 356949850d0d0e7a6f822140e5463704566fbc34 /module/language/tree-il.scm | |
parent | f238862e9ec7c69d69eb3941f14844501c0f5937 (diff) | |
download | guile-fb6e61ca21b397308474a6a553f7d502d0113251.tar.gz |
beginnings of letrec* support in the expander
* libguile/expand.h (SCM_EXPANDED_LETREC_IN_ORDER_P)
(SCM_MAKE_EXPANDED_LETREC): Add a new field to letrec, in-order?. Will
be used to support letrec*.
* libguile/expand.c (LETREC, expand_named_let, expand_letrec): Adapt
code.
* module/language/elisp/compile-tree-il.scm (compile-pair):
* module/ice-9/psyntax.scm (build-named-let, build-letrec): Pass #f for
in-order? to `make-letrec'.
* module/ice-9/psyntax-pp.scm: Regenerate.
* module/language/tree-il.scm: Add letrec-in-order? accessor.
(parse-tree-il, unparse-tree-il): Parse and unparse an in-order?
letrec as `letrec*'.
(tree-il->scheme): Serialize letrec*.
Diffstat (limited to 'module/language/tree-il.scm')
-rw-r--r-- | module/language/tree-il.scm | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 6811734b7..a874c3b41 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -42,7 +42,7 @@ lambda-case-inits lambda-case-gensyms lambda-case-body lambda-case-alternate <let> let? make-let let-src let-names let-gensyms let-vals let-body - <letrec> letrec? make-letrec letrec-src letrec-names letrec-gensyms letrec-vals letrec-body + <letrec> letrec? make-letrec letrec-src letrec-in-order? letrec-names letrec-gensyms letrec-vals letrec-body <fix> fix? make-fix fix-src fix-names fix-gensyms fix-vals fix-body <let-values> let-values? make-let-values let-values-src let-values-exp let-values-body <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder @@ -123,7 +123,7 @@ ;; (<lambda> meta body) ;; (<lambda-case> req opt rest kw inits gensyms body alternate) ;; (<let> names gensyms vals body) - ;; (<letrec> names gensyms vals body) + ;; (<letrec> in-order? names gensyms vals body) ;; (<dynlet> fluids vals body) (define-type (<tree-il> #:common-slots (src) #:printer print-tree-il) @@ -216,7 +216,10 @@ (make-let loc names gensyms (map retrans vals) (retrans body))) ((letrec ,names ,gensyms ,vals ,body) - (make-letrec loc names gensyms (map retrans vals) (retrans body))) + (make-letrec loc #f names gensyms (map retrans vals) (retrans body))) + + ((letrec* ,names ,gensyms ,vals ,body) + (make-letrec loc #t names gensyms (map retrans vals) (retrans body))) ((fix ,names ,gensyms ,vals ,body) (make-fix loc names gensyms (map retrans vals) (retrans body))) @@ -297,8 +300,9 @@ ((<let> names gensyms vals body) `(let ,names ,gensyms ,(map unparse-tree-il vals) ,(unparse-tree-il body))) - ((<letrec> names gensyms vals body) - `(letrec ,names ,gensyms ,(map unparse-tree-il vals) ,(unparse-tree-il body))) + ((<letrec> in-order? names gensyms vals body) + `(,(if in-order? 'letrec* 'letrec) ,names ,gensyms + ,(map unparse-tree-il vals) ,(unparse-tree-il body))) ((<fix> names gensyms vals body) `(fix ,names ,gensyms ,(map unparse-tree-il vals) ,(unparse-tree-il body))) @@ -435,8 +439,9 @@ ((<let> gensyms vals body) `(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) - ((<letrec> gensyms vals body) - `(letrec ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) + ((<letrec> in-order? gensyms vals body) + `(,(if in-order? 'letrec* 'letrec) + ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) ((<fix> gensyms vals body) ;; not a typo, we really do translate back to letrec |