[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] adding support for letrec*
From: |
Felix |
Subject: |
[Chicken-hackers] [PATCH] adding support for letrec* |
Date: |
Thu, 01 Aug 2013 12:44:28 +0200 (CEST) |
The attached patch adds support for "letrec*". Internal definitions,
"rec" and named let expand into uses of "letrec*", otherwise it is not
used explicitly in any code to avoid bootstrapping issues (one would
need a letrec*-able chicken to build the chicken with letrec*-support
otherwise). "letrec" is changed to provide the correct R[567]RS
semantics, at least with respect to access of uninitialized bindings,
but possibly not regarding weird experiments with continuations.
A few issues that should be noted:
- It is possible to detect access to uninitialized letrec as required
in R6RS (but not in R7RS) and done in a few R5RS Schemes
(e.g. Scheme48). This has an acceptable cost in interpreted code but
may be too expensive for compiled code.
- The optimizer is tuned towards detecting the pattern of
"letrec*"-expansions in the canonicalized intermediate code and will
produce less optimal code for uses of the new "letrec".
- I have added some rather silly little tests. Better tests are probably
worth adding.
- It turned out that the optimizer will reorder bindings and blindly
propagate values, as in this example:
(letrec ((foo 1)
(bar foo))
bar)) ; <- will return 1
Wether this is desirable and what should be done here is not
entirely clear to me. Personally, I don't care that much about this,
as it should only be an issue in case of incorrect code (which is
silently "repaired" in this case).
I have run all tests and so far things seem to work ok.
If "letrec*" is intended to be used in the chicken-core, then it will
be essential to provide a bootstrapping tarball (in other words, a
development snapshot) and perhaps even add the change to stability, to
increase the chance that bootstrapping tarballs are available with
which to compile the system.
cheers,
felix
>From 1e5f33da737d9053bbf4a37abfef8a7ca1199f8e Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 1 Aug 2013 11:52:57 +0200
Subject: [PATCH] Adds "letrec*" and minimal tests. "letrec*" ist not used
explicitly and only in internal expansions to avoid
bootstrapping issues. Internal defines expand into uses of
"letrec*".
---
chicken-syntax.scm | 11 ++++++-----
compiler.scm | 21 ++++++++++++++++++++-
eval.scm | 19 ++++++++++++++++++-
expand.scm | 11 ++++++++++-
extras.scm | 2 +-
manual/Non-standard macros and special forms | 7 +++++++
tests/syntax-tests.scm | 16 ++++++++++++++++
7 files changed, 78 insertions(+), 9 deletions(-)
diff --git a/chicken-syntax.scm b/chicken-syntax.scm
index ce1bdf6..29ed89d 100644
--- a/chicken-syntax.scm
+++ b/chicken-syntax.scm
@@ -422,6 +422,7 @@
`(,%let-values (,(car vbindings))
,(fold (cdr vbindings))) ) ) ))))
+;;XXX do we need letrec*-values ?
(##sys#extend-macro-environment
'letrec-values '()
(##sys#er-transformer
@@ -1056,11 +1057,11 @@
(##sys#check-syntax 'rec form '(_ _ . _))
(let ((head (cadr form)))
(if (pair? head)
- `(##core#letrec ((,(car head)
- (##core#lambda ,(cdr head)
- ,@(cddr form))))
- ,(car head))
- `(##core#letrec ((,head ,@(cddr form))) ,head))))))
+ `(##core#letrec* ((,(car head)
+ (##core#lambda ,(cdr head)
+ ,@(cddr form))))
+ ,(car head))
+ `(##core#letrec* ((,head ,@(cddr form))) ,head))))))
;;; Definitions available at macroexpansion-time:
diff --git a/compiler.scm b/compiler.scm
index fdae883..490559b 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -106,6 +106,7 @@
; (##core#let <variable> ({(<variable> <exp>)}) <body>)
; (##core#let ({(<variable> <exp>)}) <body>)
; (##core#letrec ({(<variable> <exp>)}) <body>)
+; (##core#letrec* ({(<variable> <exp>)}) <body>)
; (##core#let-location <symbol> <type> [<init>] <exp>)
; (##core#lambda <variable> <body>)
; (##core#lambda ({<variable>}+ [. <variable>]) <body>)
@@ -617,7 +618,7 @@
(append aliases e)
se2 dest ldest h ln) ) ) )
- ((##core#letrec)
+ ((##core#letrec*)
(let ((bindings (cadr x))
(body (cddr x)) )
(walk
@@ -631,6 +632,24 @@
(##core#let () ,@body) )
e se dest ldest h ln)))
+ ((##core#letrec)
+ (let* ((bindings (cadr x))
+ (vars (unzip1 bindings))
+ (tmps (map gensym vars))
+ (body (cddr x)) )
+ (walk
+ `(##core#let
+ ,(map (lambda (b)
+ (list (car b) '(##core#undefined)))
+ bindings)
+ (##core#let
+ ,(map (lambda (t b) (list t (cadr b))) tmps
bindings)
+ ,@(map (lambda (v t)
+ `(##core#set! ,v ,t))
+ vars tmps)
+ (##core#let () ,@body) ) )
+ e se dest ldest h ln)))
+
((##core#lambda)
(let ((llist (cadr x))
(obody (cddr x)) )
diff --git a/eval.scm b/eval.scm
index 8d65f2b..e6ebfbb 100644
--- a/eval.scm
+++ b/eval.scm
@@ -436,7 +436,7 @@
(##sys#setslot v2 i (##core#app
(##sys#slot vlist 0) v)) )
(##core#app body (cons v2 v)) ) ) ) ] ) ) ]
- ((##core#letrec)
+ ((##core#letrec*)
(let ((bindings (cadr x))
(body (cddr x)) )
(compile
@@ -450,6 +450,23 @@
(##core#let () ,@body) )
e h tf cntr se)))
+ ((##core#letrec)
+ (let* ((bindings (cadr x))
+ (vars (map car bindings))
+ (tmps (map gensym vars))
+ (body (cddr x)) )
+ (compile
+ `(##core#let
+ ,(map (lambda (b)
+ (list (car b) '(##core#undefined)))
+ bindings)
+ (##core#let ,(map (lambda (t b) (list t (cadr
b))) tmps bindings)
+ ,@(map (lambda (v t)
+ `(##core#set! ,v ,t))
+ vars tmps)
+ (##core#let () ,@body) ) )
+ e h tf cntr se)))
+
[(##core#lambda)
(##sys#check-syntax 'lambda x '(_ lambda-list . #(_
1)) #f se)
(let* ([llist (cadr x)]
diff --git a/expand.scm b/expand.scm
index d5f3652..2f34df3 100644
--- a/expand.scm
+++ b/expand.scm
@@ -277,7 +277,7 @@
(let ([bs (cadr body)])
(values
`(##core#app
- (##core#letrec
+ (##core#letrec*
([,bindings
(##core#loop-lambda
,(map (lambda (b) (car b)) bs) ,@(cddr
body))])
@@ -1050,6 +1050,15 @@
`(##core#let ,@(cdr x)))))
(##sys#extend-macro-environment
+ 'letrec*
+ '()
+ (##sys#er-transformer
+ (lambda (x r c)
+ (##sys#check-syntax 'letrec* x '(_ #((symbol _) 0) . #(_ 1)))
+ (check-for-multiple-bindings (cadr x) x "letrec*")
+ `(##core#letrec* ,@(cdr x)))))
+
+(##sys#extend-macro-environment
'letrec
'()
(##sys#er-transformer
diff --git a/extras.scm b/extras.scm
index f6daf1c..49ab5cf 100644
--- a/extras.scm
+++ b/extras.scm
@@ -557,7 +557,7 @@
(define (style head)
(case head
- ((lambda let* letrec define) pp-lambda)
+ ((lambda let* letrec letrec* define) pp-lambda)
((if set!) pp-if)
((cond) pp-cond)
((case) pp-case)
diff --git a/manual/Non-standard macros and special forms b/manual/Non-standard
macros and special forms
index ee22283..728ce3b 100644
--- a/manual/Non-standard macros and special forms
+++ b/manual/Non-standard macros and special forms
@@ -172,6 +172,13 @@ executed normally and the result of the last expression is
the
result of the {{and-let*}} form. See also the documentation for
[[http://srfi.schemers.org/srfi-2/srfi-2.html|SRFI-2]].
+==== letrec*
+
+<macro>(letrec* ((VARIABLE EXPRESSION) ...) BODY ...)</macro>
+
+Implements R6RS/R7RS {{letrec*}}. {{letrec*}} is similar to {{letrec}} but
+binds the variables sequentially and is to {{letrec}} what {{let*}} is to
{{let}}.
+
==== rec
<macro>(rec NAME EXPRESSION)</macro><br>
diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index c496270..a5f4323 100644
--- a/tests/syntax-tests.scm
+++ b/tests/syntax-tests.scm
@@ -1100,3 +1100,19 @@ take
((_) (begin (define req 2) (display req) (newline)))))
(bar)
(assert (eq? req 1)))
+
+
+;; letrec vs. letrec*
+
+;;XXX this fails - the optimizer substitutes "foo" for it's known constant
value
+#;(t (void) (letrec ((foo 1)
+ (bar foo))
+ bar))
+
+(t (void) (letrec ((foo (gc))
+ (bar foo))
+ bar))
+
+(t 1 (letrec* ((foo 1)
+ (bar foo))
+ bar))
--
1.7.9.5
- [Chicken-hackers] [PATCH] adding support for letrec*,
Felix <=