diff options
| -rw-r--r-- | bootstrap/Makefile.am | 1 | ||||
| -rw-r--r-- | module/Makefile.am | 1 | ||||
| -rw-r--r-- | module/language/cps/optimize.scm | 3 | ||||
| -rw-r--r-- | module/language/cps/specialize-numbers.scm | 91 |
4 files changed, 96 insertions, 0 deletions
diff --git a/bootstrap/Makefile.am b/bootstrap/Makefile.am index 093ee8540..2d9caac38 100644 --- a/bootstrap/Makefile.am +++ b/bootstrap/Makefile.am @@ -99,6 +99,7 @@ SOURCES = \ language/cps/slot-allocation.scm \ language/cps/spec.scm \ language/cps/specialize-primcalls.scm \ + language/cps/specialize-numbers.scm \ language/cps/split-rec.scm \ language/cps/type-checks.scm \ language/cps/type-fold.scm \ diff --git a/module/Makefile.am b/module/Makefile.am index f835ceb73..6cb160314 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -149,6 +149,7 @@ SOURCES = \ language/cps/slot-allocation.scm \ language/cps/spec.scm \ language/cps/specialize-primcalls.scm \ + language/cps/specialize-numbers.scm \ language/cps/split-rec.scm \ language/cps/type-checks.scm \ language/cps/type-fold.scm \ diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm index 571d5ffd8..7d4dc2fe2 100644 --- a/module/language/cps/optimize.scm +++ b/module/language/cps/optimize.scm @@ -37,6 +37,7 @@ #:use-module (language cps self-references) #:use-module (language cps simplify) #:use-module (language cps specialize-primcalls) + #:use-module (language cps specialize-numbers) #:use-module (language cps type-fold) #:use-module (language cps verify) #:export (optimize-higher-order-cps @@ -104,6 +105,7 @@ (simplify #:simplify? #t)) (define-optimizer optimize-first-order-cps + (specialize-numbers #:specialize-numbers? #t) (hoist-loop-invariant-code #:licm? #t) (eliminate-common-subexpressions #:cse? #t) (eliminate-dead-code #:eliminate-dead-code? #t) @@ -123,5 +125,6 @@ #:cse? #t #:type-fold? #t #:resolve-self-references? #t + #:specialize-numbers? #t #:licm? #t #:rotate-loops? #t)) diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm new file mode 100644 index 000000000..002abe59d --- /dev/null +++ b/module/language/cps/specialize-numbers.scm @@ -0,0 +1,91 @@ +;;; Continuation-passing style (CPS) intermediate language (IL) + +;; Copyright (C) 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: +;;; +;;; Some arithmetic operations have multiple implementations: one +;;; polymorphic implementation that works on all kinds of numbers, like +;;; `add', and one or more specialized variants for unboxed numbers of +;;; some kind, like `fadd'. If we can replace a polymorphic +;;; implementation with a monomorphic implementation, we should do so -- +;;; it will speed up the runtime and avoid boxing numbers. +;;; +;;; A polymorphic operation can be specialized if its result is +;;; specialized. To specialize an operation, we manually unbox its +;;; arguments and box its return value, relying on CSE to remove boxes +;;; where possible. +;;; +;;; Code: + +(define-module (language cps specialize-numbers) + #:use-module (ice-9 match) + #:use-module (language cps) + #:use-module (language cps intmap) + #:use-module (language cps renumber) + #:use-module (language cps types) + #:use-module (language cps utils) + #:use-module (language cps with-cps) + #:export (specialize-numbers)) + +(define (specialize-f64-binop cps k src op a b) + (let ((fop (match op + ('add 'fadd) + ('sub 'fsub) + ('mul 'fmul) + ('div 'fdiv)))) + (with-cps cps + (letv f64-a f64-b result) + (letk kbox ($kargs ('result) (result) + ($continue k src + ($primcall 'f64->scm (result))))) + (letk kop ($kargs ('f64-b) (f64-b) + ($continue kbox src + ($primcall fop (f64-a f64-b))))) + (letk kunbox-b ($kargs ('f64-a) (f64-a) + ($continue kop src + ($primcall 'scm->f64 (b))))) + (build-term + ($continue kunbox-b src + ($primcall 'scm->f64 (a))))))) + +(define (specialize-numbers cps) + (define (visit-cont label cont cps types) + (match cont + (($ $kfun) + (values cps (infer-types cps label))) + (($ $kargs names vars + ($ $continue k src + ($ $primcall (and op (or 'add 'sub 'mul 'div)) (a b)))) + (match (intmap-ref cps k) + (($ $kargs (_) (result)) + (call-with-values (lambda () + (lookup-post-type types label result 0)) + (lambda (type min max) + (values + (if (eqv? type &flonum) + (with-cps cps + (let$ body (specialize-f64-binop k src op a b)) + (setk label ($kargs names vars ,body))) + cps) + types)))))) + (_ (values cps types)))) + + ;; Type inference wants a renumbered graph; OK. + (let ((cps (renumber cps))) + (with-fresh-name-state cps + (values (intmap-fold visit-cont cps cps #f))))) |