summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-06-22 09:30:39 +0200
committerAndy Wingo <wingo@pobox.com>2023-06-22 16:01:44 +0200
commita5b245d2d00719d35741112a0bab14ade119b176 (patch)
treef3f36d5f25d048624dbaa1b7d6e076cc2bdc8b5b
parentb974405bce5e2b86c0efdf684bd7eef8bd886a47 (diff)
downloadguile-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.scm44
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))))