guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 05/10: Port self-references pass to CPS2


From: Andy Wingo
Subject: [Guile-commits] 05/10: Port self-references pass to CPS2
Date: Thu, 04 Jun 2015 22:57:50 +0000

wingo pushed a commit to branch master
in repository guile.

commit ff1a02bd09fe8a58315b57a8c63f92c802a19972
Author: Andy Wingo <address@hidden>
Date:   Wed Jun 3 17:44:37 2015 +0200

    Port self-references pass to CPS2
    
    * module/language/cps2/self-references.scm: New pass, ported from CPS.
    * module/language/cps2/optimize.scm: Wire up the self references pass.
    * module/Makefile.am: Add new file.
---
 module/Makefile.am                       |    1 +
 module/language/cps2/optimize.scm        |    3 +-
 module/language/cps2/self-references.scm |   79 ++++++++++++++++++++++++++++++
 3 files changed, 82 insertions(+), 1 deletions(-)

diff --git a/module/Makefile.am b/module/Makefile.am
index e7108aa..666175c 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -160,6 +160,7 @@ CPS2_LANG_SOURCES =                                         
\
   language/cps2/renumber.scm                                   \
   language/cps2/optimize.scm                                   \
   language/cps2/simplify.scm                                   \
+  language/cps2/self-references.scm                            \
   language/cps2/spec.scm                                       \
   language/cps2/specialize-primcalls.scm                       \
   language/cps2/type-fold.scm                                  \
diff --git a/module/language/cps2/optimize.scm 
b/module/language/cps2/optimize.scm
index 68b9523..ba8699f 100644
--- a/module/language/cps2/optimize.scm
+++ b/module/language/cps2/optimize.scm
@@ -31,6 +31,7 @@
   #:use-module (language cps2 elide-values)
   #:use-module (language cps2 prune-top-level-scopes)
   #:use-module (language cps2 prune-bailouts)
+  #:use-module (language cps2 self-references)
   #:use-module (language cps2 simplify)
   #:use-module (language cps2 specialize-primcalls)
   #:use-module (language cps2 type-fold)
@@ -70,7 +71,7 @@
   (run-pass! prune-bailouts #:prune-bailouts? #t)
   (run-pass! eliminate-common-subexpressions #:cse? #t)
   (run-pass! type-fold #:type-fold? #t)
-  ;; (run-pass! resolve-self-references #:resolve-self-references? #t)
+  (run-pass! resolve-self-references #:resolve-self-references? #t)
   ;; (run-pass! eliminate-dead-code #:eliminate-dead-code? #t)
   ;; (run-pass! simplify #:simplify? #t)
 
diff --git a/module/language/cps2/self-references.scm 
b/module/language/cps2/self-references.scm
new file mode 100644
index 0000000..20ac56f
--- /dev/null
+++ b/module/language/cps2/self-references.scm
@@ -0,0 +1,79 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2013, 2014, 2015 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 replaces free references to recursive functions with
+;;; bound references.
+;;;
+;;; Code:
+
+(define-module (language cps2 self-references)
+  #:use-module (ice-9 match)
+  #:use-module ((srfi srfi-1) #:select (fold))
+  #:use-module (language cps2)
+  #:use-module (language cps2 utils)
+  #:use-module (language cps intmap)
+  #:use-module (language cps intset)
+  #:export (resolve-self-references))
+
+(define* (resolve-self-references cps #:optional (label 0) (env empty-intmap))
+  (define (subst var)
+    (intmap-ref env var (lambda (var) var)))
+
+  (define (rename-exp label cps names vars k src exp)
+    (let ((exp (rewrite-exp exp
+                 ((or ($ $const) ($ $prim)) ,exp)
+                 (($ $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)))
+                 (($ $branch k ($ $values (arg)))
+                  ($branch k ($values ((subst arg)))))
+                 (($ $branch k ($ $primcall name args))
+                  ($branch k ($primcall name ,(map subst args))))
+                 (($ $values args)
+                  ($values ,(map subst args)))
+                 (($ $prompt escape? tag handler)
+                  ($prompt escape? (subst tag) handler)))))
+      (intmap-replace! cps label
+                       (build-cont
+                         ($kargs names vars ($continue k src ,exp))))))
+
+  (define (visit-exp cps label names vars k src exp)
+    (match exp
+      (($ $fun label)
+       (resolve-self-references cps label env))
+      (($ $rec names vars (($ $fun labels) ...))
+       (fold (lambda (label var cps)
+               (match (intmap-ref cps label)
+                 (($ $kfun src meta self)
+                  (resolve-self-references cps label
+                                           (intmap-add env var self)))))
+             cps labels vars))
+      (_ (rename-exp label cps names vars k src exp))))
+  
+  (intset-fold (lambda (label cps)
+                 (match (intmap-ref cps label)
+                   (($ $kargs names vars ($ $continue k src exp))
+                    (visit-exp cps label names vars k src exp))
+                   (_ cps)))
+               (compute-function-body cps label)
+               cps))



reply via email to

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