chicken-hackers
[Top][All Lists]
Advanced

[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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]