From d99d03039db1622577bd019b2311fc3487924d33 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 4 Jul 2023 14:11:27 +0200 Subject: [PATCH] Rework 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. * module/language/cps/hoot.scm: New module for lowering to Wasm/GC via Hoot. * module/language/cps/guile-vm/tailify.scm: * module/language/cps/guile-vm/unify-returns.scm: Move here, from parent dir. * am/bootstrap.am: Update for new file list. --- am/bootstrap.am | 14 ++-- module/language/cps/guile-vm.scm | 40 ++++++++++ .../{ => guile-vm}/loop-instrumentation.scm | 4 +- .../cps/{ => guile-vm}/lower-primcalls.scm | 2 +- .../cps/{ => guile-vm}/reify-primitives.scm | 2 +- module/language/cps/hoot.scm | 80 +++++++++++++++++++ module/language/cps/{ => hoot}/tailify.scm | 2 +- .../language/cps/{ => hoot}/unify-returns.scm | 2 +- module/language/cps/optimize.scm | 45 ++--------- module/system/base/target.scm | 11 +++ 10 files changed, 151 insertions(+), 51 deletions(-) create mode 100644 module/language/cps/guile-vm.scm rename module/language/cps/{ => guile-vm}/loop-instrumentation.scm (94%) rename module/language/cps/{ => guile-vm}/lower-primcalls.scm (99%) rename module/language/cps/{ => guile-vm}/reify-primitives.scm (99%) create mode 100644 module/language/cps/hoot.scm rename module/language/cps/{ => hoot}/tailify.scm (99%) rename module/language/cps/{ => hoot}/unify-returns.scm (99%) diff --git a/am/bootstrap.am b/am/bootstrap.am index 046a37af0..f73724c3f 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 \ @@ -115,15 +112,22 @@ SOURCES = \ language/cps/specialize-numbers.scm \ language/cps/split-rec.scm \ language/cps/switch.scm \ - language/cps/tailify.scm \ language/cps/type-checks.scm \ language/cps/type-fold.scm \ language/cps/types.scm \ language/cps/utils.scm \ - language/cps/unify-returns.scm \ 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 \ + \ + language/cps/hoot.scm \ + language/cps/hoot/tailify.scm \ + language/cps/hoot/unify-returns.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 . + +;;; 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 5a07113be..e0cf19e46 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 d970b5b48..ea5ee92a6 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/hoot.scm b/module/language/cps/hoot.scm new file mode 100644 index 000000000..5a4afc7b9 --- /dev/null +++ b/module/language/cps/hoot.scm @@ -0,0 +1,80 @@ +;;; 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 . + +;;; Commentary: +;;; +;;; Backend-specific lowering and optimization when targetting the Hoot +;;; Wasm/GC run-time. +;;; +;;; Code: + +(define-module (language cps hoot) + #:use-module (ice-9 match) + #:use-module (language cps dce) + #:use-module (language cps simplify) + #:use-module (language cps verify) + #:use-module (language cps hoot tailify) + #:use-module (language cps hoot unify-returns) + #:export (make-lowerer + available-optimizations)) + +(define *debug?* #f) + +(define (maybe-verify program) + (if *debug?* + (verify program) + program)) + +(define-syntax-rule (define-optimizer optimize (pass kw) ...) + (define* (optimize program #:optional (opts '())) + (let* ((program (maybe-verify program)) + (program (if (assq-ref opts kw) + (maybe-verify (pass program)) + program)) + ...) + program))) + +(define (available-optimizations) + '((#:eliminate-dead-code? 2) + (#:simplify? 1))) + +(define-optimizer optimize-hoot-backend-cps + (eliminate-dead-code #:eliminate-dead-code?) + (simplify #:simplify?)) + +(define (select-optimizations 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 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-lowerer optimization-level opts) + (let ((opts (select-optimizations optimization-level opts + (available-optimizations)))) + (lambda (exp env) + (optimize-hoot-backend-cps + (unify-returns + (tailify + exp)) + opts)))) diff --git a/module/language/cps/tailify.scm b/module/language/cps/hoot/tailify.scm similarity index 99% rename from module/language/cps/tailify.scm rename to module/language/cps/hoot/tailify.scm index 31cf4581d..9d38df6f6 100644 --- a/module/language/cps/tailify.scm +++ b/module/language/cps/hoot/tailify.scm @@ -72,7 +72,7 @@ ;;; ;;; Code: -(define-module (language cps tailify) +(define-module (language cps hoot tailify) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (ice-9 match) diff --git a/module/language/cps/unify-returns.scm b/module/language/cps/hoot/unify-returns.scm similarity index 99% rename from module/language/cps/unify-returns.scm rename to module/language/cps/hoot/unify-returns.scm index 57529650f..62121dea2 100644 --- a/module/language/cps/unify-returns.scm +++ b/module/language/cps/hoot/unify-returns.scm @@ -50,7 +50,7 @@ ;;; ;;; Code: -(define-module (language cps unify-returns) +(define-module (language cps hoot unify-returns) #:use-module (ice-9 match) #:use-module (language cps) #:use-module (language cps intmap) diff --git a/module/language/cps/optimize.scm b/module/language/cps/optimize.scm index 0e544c24e..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) @@ -45,8 +42,6 @@ #:use-module (language cps split-rec) #:use-module (language cps switch) #:use-module (language cps type-fold) - #:use-module (language cps tailify) - #:use-module (language cps unify-returns) #:use-module (language cps verify) #:use-module (system base optimize) #:use-module (system base target) @@ -122,26 +117,13 @@ (rotate-loops #:rotate-loops?) (simplify #:simplify?)) -(define-optimizer optimize-hoot-backend-cps - (eliminate-dead-code #:eliminate-dead-code?) - (simplify #:simplify?)) - (define (cps-optimizations) (available-optimizations 'cps)) -;; For the moment, this is just here. -(define (hoot-backend-cps-optimizations) - '((#:simplify? 1) - (#:eliminate-dead-code? 1))) - -(define (target-runtime) - "Determine what kind of virtual machine we are targetting. Usually this -is @code{guile-vm} when generating bytecode for Guile's virtual machine, -but it can be @code{hoot} when targetting WebAssembly." - (if (and (member (target-cpu) '("wasm32" "wasm64")) - (equal? (target-os) "hoot")) - 'hoot - 'guile-vm)) +(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 @@ -166,26 +148,9 @@ but it can be @code{hoot} when targetting WebAssembly." (acons kw (kw-arg-ref opts kw (enabled-for-level? level)) (lp all-opts)))))) -(define (make-backend-cps-lowerer optimization-level opts) - (match (target-runtime) - ('guile-vm - (lambda (exp env) - (add-loop-instrumentation - (reify-primitives - (lower-primcalls exp))))) - ('hoot - (let ((opts (select-optimizations optimization-level opts - (hoot-backend-cps-optimizations)))) - (lambda (exp env) - (optimize-hoot-backend-cps - (unify-returns - (tailify exp)) - opts)))))) - (define (make-cps-lowerer optimization-level opts) (define generic-opts - (select-optimizations 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 562bf7b51..c605b5b5d 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 @@ -159,6 +161,15 @@ "Return the vendor name of the target platform." (triplet-vendor (target-type))) +(define (target-runtime) + "Determine what kind of virtual machine we are targetting. Usually this +is @code{guile-vm} when generating bytecode for Guile's virtual machine, +but it can be @code{hoot} when targetting WebAssembly." + (if (and (member (target-cpu) '("wasm32" "wasm64")) + (equal? (target-os) "hoot")) + 'hoot + 'guile-vm)) + (define (target-os) "Return the operating system name of the target platform." (triplet-os (target-type)))