summaryrefslogtreecommitdiff
path: root/module/language/tree-il.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-06-17 10:49:00 +0200
committerAndy Wingo <wingo@pobox.com>2010-06-17 13:43:26 +0200
commitfb6e61ca21b397308474a6a553f7d502d0113251 (patch)
tree356949850d0d0e7a6f822140e5463704566fbc34 /module/language/tree-il.scm
parentf238862e9ec7c69d69eb3941f14844501c0f5937 (diff)
downloadguile-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.scm19
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