diff --git a/module/Makefile.am b/module/Makefile.am index 65f7f5a94..bf706b992 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -153,6 +153,7 @@ CPS2_LANG_SOURCES = \ language/cps2/contification.scm \ language/cps2/dce.scm \ language/cps2/effects-analysis.scm \ + language/cps2/elide-values.scm \ language/cps2/prune-top-level-scopes.scm \ language/cps2/renumber.scm \ language/cps2/optimize.scm \ diff --git a/module/language/cps2/elide-values.scm b/module/language/cps2/elide-values.scm new file mode 100644 index 000000000..ff04789fb --- /dev/null +++ b/module/language/cps2/elide-values.scm @@ -0,0 +1,88 @@ +;;; 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: +;;; +;;; Primcalls that don't correspond to VM instructions are treated as if +;;; they are calls, and indeed the later reify-primitives pass turns +;;; them into calls. Because no return arity checking is done for these +;;; primitives, if a later optimization pass simplifies the primcall to +;;; a VM operation, the tail of the simplification has to be a +;;; primcall to 'values. Most of these primcalls can be elided, and +;;; that is the job of this pass. +;;; +;;; Code: + +(define-module (language cps2 elide-values) + #: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 (elide-values)) + +(define (inline-values cps k src args) + (match (intmap-ref cps k) + (($ $ktail) + (with-cps cps + (build-term + ($continue k src ($values args))))) + (($ $kreceive ($ $arity req () rest () #f) kargs) + (cond + ((and (not rest) (= (length args) (length req))) + (with-cps cps + (build-term + ($continue kargs src ($values args))))) + ((and rest (>= (length args) (length req))) + (let () + (define (build-rest cps k tail) + (match tail + (() + (with-cps cps + (build-term ($continue k src ($const '()))))) + ((v . tail) + (with-cps cps + (letv rest) + (letk krest ($kargs ('rest) (rest) + ($continue k src ($primcall 'cons (v rest))))) + ($ (build-rest krest tail)))))) + (with-cps cps + (letv rest) + (letk krest ($kargs ('rest) (rest) + ($continue kargs src + ($values ,(append (list-head args (length req)) + (list rest)))))) + ($ (build-rest krest (list-tail args (length req))))))) + (else (with-cps cps #f)))))) + +(define (elide-values conts) + (with-fresh-name-state conts + (persistent-intmap + (intmap-fold + (lambda (label cont out) + (match cont + (($ $kargs names vars ($ $continue k src ($ $primcall 'values args))) + (call-with-values (lambda () (inline-values out k src args)) + (lambda (out term) + (if term + (let ((cont (build-cont ($kargs names vars ,term)))) + (intmap-replace! out label cont)) + out)))) + (_ out))) + conts + conts)))) diff --git a/module/language/cps2/optimize.scm b/module/language/cps2/optimize.scm index d6400ed4c..151196f76 100644 --- a/module/language/cps2/optimize.scm +++ b/module/language/cps2/optimize.scm @@ -27,6 +27,7 @@ #:use-module (language cps2 constructors) #:use-module (language cps2 contification) #:use-module (language cps2 dce) + #:use-module (language cps2 elide-values) #:use-module (language cps2 prune-top-level-scopes) #:use-module (language cps2 simplify) #:use-module (language cps2 specialize-primcalls) @@ -62,7 +63,7 @@ (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! 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)