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

@@ -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		\
 						\

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))))

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))