wingo pushed a commit to branch wip-tailify
in repository guile.
commit 3c83a77da5367b8030c4d9e5e069ea7d3857fe2c
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue Jul 4 14:31:30 2023 +0200
Add lower-primcalls pass for hoot
* module/language/cps/hoot/lower-primcalls.scm: New file.
* module/language/cps/hoot.scm (make-lowerer): Wire in new pass.
* am/bootstrap.am (SOURCES): Add new file.
---
am/bootstrap.am | 1 +
module/language/cps/hoot.scm | 3 +-
module/language/cps/hoot/lower-primcalls.scm | 49 ++++++++++++++++++++++++++++
3 files changed, 52 insertions(+), 1 deletion(-)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index f73724c3f..301909caa 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -125,6 +125,7 @@ SOURCES = \
language/cps/guile-vm/reify-primitives.scm \
\
language/cps/hoot.scm \
+ language/cps/hoot/lower-primcalls.scm \
language/cps/hoot/tailify.scm \
language/cps/hoot/unify-returns.scm \
\
diff --git a/module/language/cps/hoot.scm b/module/language/cps/hoot.scm
index 5a4afc7b9..1e6b30706 100644
--- a/module/language/cps/hoot.scm
+++ b/module/language/cps/hoot.scm
@@ -27,6 +27,7 @@
#:use-module (language cps dce)
#:use-module (language cps simplify)
#:use-module (language cps verify)
+ #:use-module (language cps hoot lower-primcalls)
#:use-module (language cps hoot tailify)
#:use-module (language cps hoot unify-returns)
#:export (make-lowerer
@@ -76,5 +77,5 @@
(optimize-hoot-backend-cps
(unify-returns
(tailify
- exp))
+ (lower-primcalls exp)))
opts))))
diff --git a/module/language/cps/hoot/lower-primcalls.scm
b/module/language/cps/hoot/lower-primcalls.scm
new file mode 100644
index 000000000..c56cb9623
--- /dev/null
+++ b/module/language/cps/hoot/lower-primcalls.scm
@@ -0,0 +1,49 @@
+;;; Pass to lower-primcalls CPS for hoot
+;;; 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:
+;;;
+;;; When targetting WebAssembly, we don't have untagged struct fields,
+;;; so we can fold some vtable predicates.
+;;;
+;;; Code:
+
+(define-module (language cps hoot lower-primcalls)
+ #:use-module (ice-9 match)
+ #:use-module (language cps)
+ #:use-module (language cps intmap)
+ #:export (lower-primcalls))
+
+(define (lower-primcalls cps)
+ (intmap-fold
+ (lambda (label cont out)
+ (match cont
+ (($ $kargs names vars
+ ($ $branch kf kt src 'vtable-has-unboxed-fields? nfields (vtable)))
+ (intmap-replace out label
+ (build-cont
+ ($kargs names vars
+ ($continue kf src ($values ()))))))
+ (($ $kargs names vars
+ ($ $branch kf kt src 'vtable-field-boxed? idx (vtable)))
+ (intmap-replace out label
+ (build-cont
+ ($kargs names vars
+ ($continue kt src ($values ()))))))
+ (_ out)))
+ cps
+ cps))
