[Guile-commits] GNU Guile branch, master, updated. v2.1.0-894-gc4a209b

[Andy Wingo]

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=c4a209b96ff7ea75d3d74aa956223768a352d6d9

The branch, master has been updated
       via  c4a209b96ff7ea75d3d74aa956223768a352d6d9 (commit)
      from  1d8b325994e4062e215c2501b7aa615f3672214d (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 c4a209b96ff7ea75d3d74aa956223768a352d6d9
Author: Andy Wingo <address@hidden>
Date:   Tue Apr 8 21:41:42 2014 +0200

    New pass to avoid free variable creation for self-recursion
    
    * module/language/cps/self-references.scm: New pass, avoids the need for
      self-recursion to allocate free variables.
    
    * module/Makefile.am:
    * module/language/cps/compile-bytecode.scm: Wire up the new pass.

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

Summary of changes:
 module/Makefile.am                       |    1 +
 module/language/cps/compile-bytecode.scm |    2 +
 module/language/cps/self-references.scm  |   79 ++++++++++++++++++++++++++++++
 3 files changed, 82 insertions(+), 0 deletions(-)
 create mode 100644 module/language/cps/self-references.scm

diff --git a/module/Makefile.am b/module/Makefile.am
index 335e14c..a6b20af 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -133,6 +133,7 @@ CPS_LANG_SOURCES =                                          
\
   language/cps/prune-top-level-scopes.scm                      \
   language/cps/reify-primitives.scm                            \
   language/cps/renumber.scm                                    \
+  language/cps/self-references.scm                             \
   language/cps/slot-allocation.scm                             \
   language/cps/simplify.scm                                    \
   language/cps/spec.scm                                                \
diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 77edf64..3d95b8c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -40,6 +40,7 @@
   #:use-module (language cps prune-top-level-scopes)
   #:use-module (language cps reify-primitives)
   #:use-module (language cps renumber)
+  #:use-module (language cps self-references)
   #:use-module (language cps simplify)
   #:use-module (language cps slot-allocation)
   #:use-module (language cps specialize-primcalls)
@@ -72,6 +73,7 @@
          (exp (run-pass exp elide-values #:elide-values? #t))
          (exp (run-pass exp prune-bailouts #:prune-bailouts? #t))
          (exp (run-pass exp eliminate-common-subexpressions #:cse? #t))
+         (exp (run-pass exp resolve-self-references #:resolve-self-references? 
#t))
          (exp (run-pass exp eliminate-dead-code #:eliminate-dead-code? #t))
          (exp (run-pass exp simplify #:simplify? #t)))
     ;; Passes that are needed:
diff --git a/module/language/cps/self-references.scm 
b/module/language/cps/self-references.scm
new file mode 100644
index 0000000..bde37a6
--- /dev/null
+++ b/module/language/cps/self-references.scm
@@ -0,0 +1,79 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
+
+;;; Commentary:
+;;;
+;;; A pass that prunes successors of expressions that bail out.
+;;;
+;;; Code:
+
+(define-module (language cps self-references)
+  #:use-module (ice-9 match)
+  #:use-module (language cps)
+  #:export (resolve-self-references))
+
+(define* (resolve-self-references fun #:optional (env '()))
+  (define (subst var)
+    (or (assq-ref env var) var))
+
+  (define (visit-cont cont)
+    (rewrite-cps-cont cont
+      (($ $cont label ($ $kargs names vars body))
+       (label ($kargs names vars ,(visit-term body))))
+      (($ $cont label ($ $kentry self tail clause))
+       (label ($kentry self ,tail
+                ,(and clause (visit-cont clause)))))
+      (($ $cont label ($ $kclause arity body alternate))
+       (label ($kclause ,arity ,(visit-cont body)
+                        ,(and alternate (visit-cont alternate)))))
+      (_ ,cont)))
+
+  (define (visit-term term)
+    (rewrite-cps-term term
+      (($ $letrec names vars funs body)
+       ($letrec names vars (map visit-recursive-fun funs vars)
+                ,(visit-term body)))
+      (($ $letk conts body)
+       ($letk ,(map visit-cont conts)
+         ,(visit-term body)))
+      (($ $continue k src exp)
+       ($continue k src ,(visit-exp exp)))))
+
+  (define (visit-exp exp)
+    (rewrite-cps-exp exp
+      ((or ($ $void) ($ $const) ($ $prim)) ,exp)
+      (($ $fun) ,(resolve-self-references exp env))
+      (($ $call proc args)
+       ($call (subst proc) ,(map subst args)))
+      (($ $callk k proc args)
+       ($callk k (subst proc) ,(map subst args)))
+      (($ $primcall name args)
+       ($primcall name ,(map subst args)))
+      (($ $values args)
+       ($values ,(map subst args)))
+      (($ $prompt escape? tag handler)
+       ($prompt escape? (subst tag) handler))))
+
+  (define (visit-recursive-fun fun var)
+    (match fun
+      (($ $fun src meta free (and cont ($ $cont _ ($ $kentry self))))
+       (resolve-self-references fun (acons var self env)))))
+
+  (rewrite-cps-exp fun
+    (($ $fun src meta free cont)
+     ($fun src meta (map subst free) ,(visit-cont cont)))))


hooks/post-receive
-- 
GNU Guile