diff options
author | Andy Wingo <wingo@pobox.com> | 2023-06-22 09:30:39 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-06-22 16:01:44 +0200 |
commit | a5b245d2d00719d35741112a0bab14ade119b176 (patch) | |
tree | f3f36d5f25d048624dbaa1b7d6e076cc2bdc8b5b | |
parent | b974405bce5e2b86c0efdf684bd7eef8bd886a47 (diff) | |
download | guile-a5b245d2d00719d35741112a0bab14ade119b176.tar.gz |
Wire in lower-primitives pass
* module/language/cps/optimize.scm (lower-cps/generic): Rename from
lower-cps; these are the lowerings that apply to everyone.
(select-opts-for-optimization-level): Factor out of make-cps-lowerer.
(make-backend-cps-lowerer): New procedure. For the Guile VM backend, we
have a few mandatory passes, including the new lower-primitives.
(make-cps-lowerer): Apply backend-specific lowering pass.
-rw-r--r-- | module/language/cps/optimize.scm | 44 |
1 files changed, 29 insertions, 15 deletions
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm index 6c48bc93e..ce8e51f7b 100644 --- a/module/language/cps/optimize.scm +++ b/module/language/cps/optimize.scm @@ -1,6 +1,6 @@ ;;; Continuation-passing style (CPS) intermediate language (IL) -;; Copyright (C) 2013-2018,2020,2021 Free Software Foundation, Inc. +;; Copyright (C) 2013-2018,2020,2021,2023 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 @@ -31,6 +31,7 @@ #:use-module (language cps elide-arity-checks) #:use-module (language cps licm) #:use-module (language cps loop-instrumentation) + #:use-module (language cps lower-primcalls) #:use-module (language cps peel-loops) #:use-module (language cps prune-top-level-scopes) #:use-module (language cps reify-primitives) @@ -121,7 +122,7 @@ (define (cps-optimizations) (available-optimizations 'cps)) -(define (lower-cps exp opts) +(define (lower-cps/generic exp opts) ;; FIXME: For now the closure conversion pass relies on $rec instances ;; being separated into SCCs. We should fix this to not be the case, ;; and instead move the split-rec pass back to @@ -129,22 +130,35 @@ (set! exp (split-rec exp)) (set! exp (optimize-higher-order-cps exp opts)) (set! exp (convert-closures exp)) - (set! exp (optimize-first-order-cps exp opts)) - (set! exp (reify-primitives exp)) - (set! exp (add-loop-instrumentation exp)) - (renumber exp)) + (optimize-first-order-cps exp opts)) -(define (make-cps-lowerer optimization-level opts) +(define (select-opts-for-optimization-level optimization-level opts all-opts) (define (kw-arg-ref args kw default) (match (memq kw args) ((_ val . _) val) (_ default))) (define (enabled-for-level? level) (<= level optimization-level)) - (let ((opts (let lp ((all-opts (cps-optimizations))) - (match all-opts - (() '()) - (((kw level) . all-opts) - (acons kw (kw-arg-ref opts kw (enabled-for-level? level)) - (lp all-opts))))))) - (lambda (exp env) - (lower-cps exp opts)))) + (let lp ((all-opts all-opts)) + (match all-opts + (() '()) + (((kw level) . all-opts) + (acons kw (kw-arg-ref opts kw (enabled-for-level? level)) + (lp all-opts)))))) + +(define (make-backend-cps-lowerer optimization-level opts) + (lambda (exp env) + (add-loop-instrumentation + (reify-primitives + (lower-primcalls exp))))) + +(define (make-cps-lowerer optimization-level opts) + (define generic-opts + (select-opts-for-optimization-level optimization-level opts + (cps-optimizations))) + (define lower-cps/backend + (make-backend-cps-lowerer optimization-level opts)) + (lambda (exp env) + (renumber + (lower-cps/backend + (lower-cps/generic exp generic-opts) + env)))) |