[Guile-commits] GNU Guile branch, wip-cps-bis, updated. v2.1.0-191-g6a3e828

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6a3e82845ed52dfd3e7711ba4a759091d7b8c2a4

The branch, wip-cps-bis has been updated
       via  6a3e82845ed52dfd3e7711ba4a759091d7b8c2a4 (commit)
       via  1bbe826fed721a4cfc1b1a9f7cc2052a5e646d7e (commit)
      from  e4737b29e423e8031abac97722ba3a2131c2e311 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6a3e82845ed52dfd3e7711ba4a759091d7b8c2a4
Author: Mark H Weaver <address@hidden>
Date:   Thu Aug 15 23:14:19 2013 -0400

    RTL Compiler: Convert 'list' primcall into nested 'cons' primcalls.
    
    * module/language/tree-il/compile-cps.scm (convert): Convert 'list'
      primcalls into nested 'cons' primcalls before conversion to CPS.

commit 1bbe826fed721a4cfc1b1a9f7cc2052a5e646d7e
Author: Mark H Weaver <address@hidden>
Date:   Thu Aug 15 23:12:14 2013 -0400

    RTL Compiler: Fix <let-values> pattern in RTL to CPS conversion.
    
    * module/language/tree-il/compile-cps.scm (convert): Fix pattern.

-----------------------------------------------------------------------

Summary of changes:
 module/language/tree-il/compile-cps.scm |   33 +++++++++++++++++++-----------
 1 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index f89a842..e0b72bc 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -23,7 +23,7 @@
 
 (define-module (language tree-il compile-cps)
   #:use-module (ice-9 match)
-  #:use-module ((srfi srfi-1) #:select (fold filter-map))
+  #:use-module ((srfi srfi-1) #:select (fold fold-right filter-map))
   #:use-module (srfi srfi-26)
   #:use-module ((system foreign) #:select (make-pointer pointer->scm))
   #:use-module (language cps)
@@ -42,7 +42,7 @@
                  <lambda> <lambda-case>
                  <let> <letrec> <fix> <let-values>
                  <prompt> <abort>
-                 make-conditional make-const
+                 make-conditional make-const make-primcall
                  tree-il-src
                  tree-il-fold))
   #:export (compile-cps))
@@ -318,15 +318,24 @@
          (build-cps-term ($continue k ($call proc args)))))))
 
     (($ <primcall> src name args)
-     (if (branching-primitive? name)
-         (convert (make-conditional src exp (make-const #f #t)
-                                    (make-const #f #f))
-                  k subst)
-         (convert-args args
-           (lambda (args)
-             (if (eq? name 'values)
-                 (build-cps-term ($continue k ($values args)))
-                 (build-cps-term ($continue k ($primcall name args))))))))
+     (case name
+       ((list)
+        (convert (fold-right (lambda (elem tail)
+                               (make-primcall src 'cons
+                                              (list elem tail)))
+                             (make-const src '())
+                             args)
+                 k subst))
+       (else
+        (if (branching-primitive? name)
+            (convert (make-conditional src exp (make-const #f #t)
+                                       (make-const #f #f))
+                     k subst)
+            (convert-args args
+              (lambda (args)
+                (if (eq? name 'values)
+                    (build-cps-term ($continue k ($values args)))
+                    (build-cps-term ($continue k ($primcall name args))))))))))
 
     ;; Prompts with inline handlers.
     (($ <prompt> src escape-only? tag body
@@ -465,7 +474,7 @@
                ,(capture-toplevel-scope src scope kscope))))))
 
     (($ <let-values> src exp
-        ($ <lambda-case> lsrc req () rest #f () syms body #f))
+        ($ <lambda-case> lsrc req #f rest #f () syms body #f))
      (let ((names (append req (if rest (list rest) '()))))
        (let-gensyms (ktrunc kargs)
          (build-cps-term


hooks/post-receive
-- 
GNU Guile