wingo pushed a commit to branch main
in repository guile.
commit 941c757ab7cdfe029f17bc26876b9d710eea18db
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Aug 17 11:47:21 2023 +0200
Introduce target-runtime parameter for backend-specific CPS lowering
* module/system/base/target.scm (target-runtime): New export.
* module/language/cps/optimize.scm (make-cps-lowerer): Load a
backend-specific lowering module dynamically.
* module/language/cps/guile-vm.scm: New module for lowering to Guile's
VM.
* module/language/cps/guile-vm/loop-instrumentation.scm:
* module/language/cps/guile-vm/lower-primcalls.scm:
* module/language/cps/guile-vm/reify-primitives.scm: Move here, from
parent dir.
* am/bootstrap.am: Update for new file list.
---
am/bootstrap.am | 8 +++--
module/language/cps/guile-vm.scm | 40 ++++++++++++++++++++++
.../cps/{ => guile-vm}/loop-instrumentation.scm | 4 +--
.../cps/{ => guile-vm}/lower-primcalls.scm | 2 +-
.../cps/{ => guile-vm}/reify-primitives.scm | 2 +-
module/language/cps/optimize.scm | 20 +++++------
module/system/base/target.scm | 10 ++++++
7 files changed, 67 insertions(+), 19 deletions(-)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index ff0d1799e..a71946958 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -98,12 +98,9 @@ SOURCES = \
language/cps/intmap.scm \
language/cps/intset.scm \
language/cps/licm.scm \
- language/cps/loop-instrumentation.scm \
- language/cps/lower-primcalls.scm \
language/cps/optimize.scm \
language/cps/peel-loops.scm \
language/cps/prune-top-level-scopes.scm \
- language/cps/reify-primitives.scm \
language/cps/renumber.scm \
language/cps/return-types.scm \
language/cps/rotate-loops.scm \
@@ -122,6 +119,11 @@ SOURCES = \
language/cps/verify.scm \
language/cps/with-cps.scm \
\
+ language/cps/guile-vm.scm \
+ language/cps/guile-vm/loop-instrumentation.scm\
+ language/cps/guile-vm/lower-primcalls.scm \
+ language/cps/guile-vm/reify-primitives.scm \
+ \
ice-9/and-let-star.scm \
ice-9/arrays.scm \
ice-9/atomic.scm \
diff --git a/module/language/cps/guile-vm.scm b/module/language/cps/guile-vm.scm
new file mode 100644
index 000000000..f330128f2
--- /dev/null
+++ b/module/language/cps/guile-vm.scm
@@ -0,0 +1,40 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 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
+;;; 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 program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; Backend-specific lowering and optimization when targetting Guile's
+;;; bytecode virtual machine.
+;;;
+;;; Code:
+
+(define-module (language cps guile-vm)
+ #:use-module (ice-9 match)
+ #:use-module (language cps guile-vm loop-instrumentation)
+ #:use-module (language cps guile-vm lower-primcalls)
+ #:use-module (language cps guile-vm reify-primitives)
+ #:export (make-lowerer
+ available-optimizations))
+
+(define (make-lowerer optimization-level opts)
+ (lambda (exp env)
+ (add-loop-instrumentation
+ (reify-primitives
+ (lower-primcalls exp)))))
+
+(define (available-optimizations)
+ '())
diff --git a/module/language/cps/loop-instrumentation.scm
b/module/language/cps/guile-vm/loop-instrumentation.scm
similarity index 94%
rename from module/language/cps/loop-instrumentation.scm
rename to module/language/cps/guile-vm/loop-instrumentation.scm
index 2f5f1fe26..c7ae95a37 100644
--- a/module/language/cps/loop-instrumentation.scm
+++ b/module/language/cps/guile-vm/loop-instrumentation.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2016, 2017, 2018, 2020 Free Software Foundation, Inc.
+;; Copyright (C) 2016, 2017, 2018, 2020, 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
@@ -22,7 +22,7 @@
;;;
;;; Code:
-(define-module (language cps loop-instrumentation)
+(define-module (language cps guile-vm loop-instrumentation)
#:use-module (ice-9 match)
#:use-module (language cps)
#:use-module (language cps utils)
diff --git a/module/language/cps/lower-primcalls.scm
b/module/language/cps/guile-vm/lower-primcalls.scm
similarity index 99%
rename from module/language/cps/lower-primcalls.scm
rename to module/language/cps/guile-vm/lower-primcalls.scm
index f1787b3f2..66e84ed6f 100644
--- a/module/language/cps/lower-primcalls.scm
+++ b/module/language/cps/guile-vm/lower-primcalls.scm
@@ -25,7 +25,7 @@
;;;
;;; Code:
-(define-module (language cps lower-primcalls)
+(define-module (language cps guile-vm lower-primcalls)
#:use-module (ice-9 match)
#:use-module (language cps)
#:use-module (language cps intmap)
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/guile-vm/reify-primitives.scm
similarity index 99%
rename from module/language/cps/reify-primitives.scm
rename to module/language/cps/guile-vm/reify-primitives.scm
index 7faba6013..a78284fab 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/guile-vm/reify-primitives.scm
@@ -24,7 +24,7 @@
;;;
;;; Code:
-(define-module (language cps reify-primitives)
+(define-module (language cps guile-vm reify-primitives)
#:use-module (ice-9 match)
#:use-module (language cps)
#:use-module (language cps utils)
diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm
index ce8e51f7b..17c2c42d1 100644
--- a/module/language/cps/optimize.scm
+++ b/module/language/cps/optimize.scm
@@ -30,11 +30,8 @@
#:use-module (language cps devirtualize-integers)
#: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)
#:use-module (language cps renumber)
#:use-module (language cps rotate-loops)
#:use-module (language cps return-types)
@@ -47,6 +44,7 @@
#:use-module (language cps type-fold)
#:use-module (language cps verify)
#:use-module (system base optimize)
+ #:use-module (system base target)
#:export (optimize-higher-order-cps
optimize-first-order-cps
cps-optimizations
@@ -122,6 +120,11 @@
(define (cps-optimizations)
(available-optimizations 'cps))
+(define (make-backend-cps-lowerer optimization-level opts)
+ (let* ((iface (resolve-interface `(language cps ,(target-runtime))))
+ (make-lowerer (module-ref iface 'make-lowerer)))
+ (make-lowerer optimization-level 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,
@@ -132,7 +135,7 @@
(set! exp (convert-closures exp))
(optimize-first-order-cps exp opts))
-(define (select-opts-for-optimization-level optimization-level opts all-opts)
+(define (select-optimizations optimization-level opts all-opts)
(define (kw-arg-ref args kw default)
(match (memq kw args)
((_ val . _) val)
@@ -145,16 +148,9 @@
(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)))
+ (select-optimizations optimization-level opts (cps-optimizations)))
(define lower-cps/backend
(make-backend-cps-lowerer optimization-level opts))
(lambda (exp env)
diff --git a/module/system/base/target.scm b/module/system/base/target.scm
index cc4c23654..e845b9947 100644
--- a/module/system/base/target.scm
+++ b/module/system/base/target.scm
@@ -26,6 +26,8 @@
target-cpu target-vendor target-os
+ target-runtime
+
target-endianness target-word-size
target-max-size-t
@@ -157,6 +159,14 @@
"Return the vendor name of the target platform."
(triplet-vendor (target-type)))
+(define target-runtime
+ (make-parameter
+ 'guile-vm
+ (lambda (val)
+ "Determine what kind of virtual machine we are targetting. Usually this
+is @code{guile-vm} when generating bytecode for Guile's virtual machine."
+ val)))
+
(define (target-os)
"Return the operating system name of the target platform."
(triplet-os (target-type)))
