[Guile-commits] 02/02: Add lower-primcalls pass for hoot

[Andy Wingo]

wingo pushed a commit to branch wip-tailify
in repository guile.

commit 3c83a77da5367b8030c4d9e5e069ea7d3857fe2c
Author: Andy Wingo <wingo@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))