[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/05: Port inline-constructors pass to CPS2
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/05: Port inline-constructors pass to CPS2 |
Date: |
Tue, 02 Jun 2015 10:23:02 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 42f9bdabb53f997fa043a6168ecc37e4e9effd17
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 11:30:21 2015 +0200
Port inline-constructors pass to CPS2
* module/language/cps2/constructors.scm: New file.
* module/language/cps2/optimize.scm: Enable inline-constructors pass.
* module/Makefile.am: Add new file to build.
---
module/Makefile.am | 1 +
module/language/cps2/constructors.scm | 98 +++++++++++++++++++++++++++++++++
module/language/cps2/optimize.scm | 14 ++++-
3 files changed, 111 insertions(+), 2 deletions(-)
diff --git a/module/Makefile.am b/module/Makefile.am
index b02a8f6..587d7b5 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -149,6 +149,7 @@ CPS_LANG_SOURCES =
\
CPS2_LANG_SOURCES = \
language/cps2.scm \
language/cps2/compile-cps.scm \
+ language/cps2/constructors.scm \
language/cps2/contification.scm \
language/cps2/dce.scm \
language/cps2/effects-analysis.scm \
diff --git a/module/language/cps2/constructors.scm
b/module/language/cps2/constructors.scm
new file mode 100644
index 0000000..e4973f2
--- /dev/null
+++ b/module/language/cps2/constructors.scm
@@ -0,0 +1,98 @@
+;;; 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:
+;;;
+;;; Constructor inlining turns "list" primcalls into a series of conses,
+;;; and does similar transformations for "vector".
+;;;
+;;; Code:
+
+(define-module (language cps2 constructors)
+ #:use-module (ice-9 match)
+ #:use-module (language cps2)
+ #:use-module (language cps2 utils)
+ #:use-module (language cps2 with-cps)
+ #:use-module (language cps intmap)
+ #:export (inline-constructors))
+
+(define (inline-list out k src args)
+ (define (build-list out args k)
+ (match args
+ (()
+ (with-cps out
+ (build-term ($continue k src ($const '())))))
+ ((arg . args)
+ (with-cps out
+ (letv tail)
+ (letk ktail ($kargs ('tail) (tail)
+ ($continue k src
+ ($primcall 'cons (arg tail)))))
+ ($ (build-list args ktail))))))
+ (with-cps out
+ (letv val)
+ (letk kvalues ($kargs ('val) (val)
+ ($continue k src
+ ($primcall 'values (val)))))
+ ($ (build-list args kvalues))))
+
+(define (inline-vector out k src args)
+ (define (initialize out vec args n)
+ (match args
+ (()
+ (with-cps out
+ (build-term ($continue k src ($primcall 'values (vec))))))
+ ((arg . args)
+ (with-cps out
+ (let$ next (initialize vec args (1+ n)))
+ (letk knext ($kargs () () ,next))
+ ($ (with-cps-constants ((idx n))
+ (build-term ($continue knext src
+ ($primcall 'vector-set! (vec idx arg))))))))))
+ (with-cps out
+ (letv vec)
+ (let$ body (initialize vec args 0))
+ (letk kalloc ($kargs ('vec) (vec) ,body))
+ ($ (with-cps-constants ((len (length args))
+ (init #f))
+ (build-term ($continue kalloc src
+ ($primcall 'make-vector (len init))))))))
+
+(define (find-constructor-inliner name)
+ (match name
+ ('list inline-list)
+ ('vector inline-vector)
+ (_ #f)))
+
+(define (inline-constructors conts)
+ (with-fresh-name-state conts
+ (persistent-intmap
+ (intmap-fold
+ (lambda (label cont out)
+ (match cont
+ (($ $kargs names vars ($ $continue k src ($ $primcall name args)))
+ (let ((inline (find-constructor-inliner name)))
+ (if inline
+ (call-with-values (lambda () (inline out k src args))
+ (lambda (out term)
+ (intmap-replace! out label
+ (build-cont ($kargs names vars ,term)))))
+ out)))
+ (_ out)))
+ conts
+ conts))))
diff --git a/module/language/cps2/optimize.scm
b/module/language/cps2/optimize.scm
index bc5b83e..bfc43c1 100644
--- a/module/language/cps2/optimize.scm
+++ b/module/language/cps2/optimize.scm
@@ -24,6 +24,7 @@
(define-module (language cps2 optimize)
#:use-module (ice-9 match)
+ #:use-module (language cps2 constructors)
#:use-module (language cps2 contification)
#:use-module (language cps2 dce)
#:use-module (language cps2 prune-top-level-scopes)
@@ -43,8 +44,8 @@
program)))
;; This series of assignments to `env' used to be a series of let*
- ;; bindings of `env', as you would imagine. In compiled code this is
- ;; fine because the compiler is able to allocate all let*-bound
+ ;; bindings of `program', as you would imagine. In compiled code this
+ ;; is fine because the compiler is able to allocate all let*-bound
;; variable to the same slot, which also means that the garbage
;; collector doesn't have to retain so many copies of the term being
;; optimized. However during bootstrap, the interpreter doesn't do
@@ -58,5 +59,14 @@
(run-pass! prune-top-level-scopes #:prune-top-level-scopes? #t)
(run-pass! simplify #:simplify? #t)
(run-pass! contify #:contify? #t)
+ (run-pass! inline-constructors #:inline-constructors? #t)
+ ;; (run-pass! specialize-primcalls #:specialize-primcalls? #t)
+ ;; (run-pass! elide-values #:elide-values? #t)
+ ;; (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! eliminate-dead-code #:eliminate-dead-code? #t)
+ ;; (run-pass! simplify #:simplify? #t)
program)