Update to work on latest guile-hoot... sort of.

There's one uncommitted fix I'm using that is my local guile-hoot
repo.  Shouldn't be like that for long.

5 files changed, 139 insertions, 120 deletions

diff --git a/boot.js b/boot.js
index fbb2468..38c91f0 100644
--- a/boot.js
+++ b/boot.js
@@ -1,20 +1,5 @@
 async function load() {
-  const procMap = new WeakMap();
-
-  function wrapProc(obj) {
-    function makeWrapper() {
-      const proc = scheme.to_js(obj);
-      function wrapper (...args) {
-        return proc.call(...args);
-      }
-      procMap.set(obj, wrapper);
-      return wrapper;
-    }
-
-    return procMap.get(obj) || makeWrapper();
-  }
-
-  const mod = await SchemeModule.fetch_and_instantiate("game.wasm", {}, {
+  const mod = await Scheme.load_main("game.wasm", {}, {
     window: {
       get() {
         return window;
@@ -25,11 +10,11 @@ async function load() {
       innerHeight() {
         return window.innerHeight;
       },
-      requestAnimationFrame(proc) {
-        window.requestAnimationFrame(wrapProc(proc));
+      requestAnimationFrame(f) {
+        window.requestAnimationFrame(f);
       },
-      setTimeout(proc, delay) {
-        window.setTimeout(wrapProc(proc), delay);
+      setTimeout(f, delay) {
+        window.setTimeout(f, delay);
       }
     },
     document: {
@@ -67,11 +52,11 @@ async function load() {
       replaceWith(oldElem, newElem) {
         oldElem.replaceWith(newElem);
       },
-      addEventListener(elem, name, proc) {
-        elem.addEventListener(name, wrapProc(proc));
+      addEventListener(elem, name, f) {
+        elem.addEventListener(name, f);
       },
-      removeEventListener(elem, name, proc) {
-        elem.removeEventListener(name, wrapProc(proc));
+      removeEventListener(elem, name, f) {
+        elem.removeEventListener(name, f);
       },
       clone(elem) {
         return elem.cloneNode();
@@ -151,7 +136,5 @@ async function load() {
       }
     }
   });
-  const scheme = await mod.reflect();
-  scheme.init_module(mod);
 }
 window.addEventListener("load", load);
diff --git a/game.scm b/game.scm
index 7e7ddf1..5d6c567 100644
--- a/game.scm
+++ b/game.scm
@@ -7,139 +7,139 @@
      ;; Host imports
      (define-foreign current-window
        "window" "get"
-       -> (ref extern))
+       -> (ref null extern))
      (define-foreign window-inner-width
        "window" "innerWidth"
-       (ref extern) -> i32)
+       (ref null extern) -> i32)
      (define-foreign window-inner-height
        "window" "innerHeight"
-       (ref extern) -> i32)
+       (ref null extern) -> i32)
      (define-foreign request-animation-frame
        "window" "requestAnimationFrame"
-       (ref eq) -> none)
+       (ref null extern) -> none)
      (define-foreign timeout
        "window" "setTimeout"
-       (ref eq) f64 -> i32)
+       (ref null extern) f64 -> i32)
 
      (define-foreign current-document
        "document" "get"
-       -> (ref extern))
+       -> (ref null extern))
      (define-foreign document-body
        "document" "body"
-       -> (ref extern))
+       -> (ref null extern))
      (define-foreign get-element-by-id
        "document" "getElementById"
        (ref string) -> (ref null extern))
      (define-foreign make-text-node
        "document" "createTextNode"
-       (ref string) -> (ref extern))
+       (ref string) -> (ref null extern))
      (define-foreign make-element
        "document" "createElement"
-       (ref string) -> (ref extern))
+       (ref string) -> (ref null extern))
 
      (define-foreign element-value
        "element" "value"
-       (ref extern) -> (ref string))
+       (ref null extern) -> (ref string))
      (define-foreign set-element-value!
        "element" "setValue"
-       (ref extern) (ref string) -> none)
+       (ref null extern) (ref string) -> none)
      (define-foreign set-element-width!
        "element" "setWidth"
-       (ref extern) i32 -> none)
+       (ref null extern) i32 -> none)
      (define-foreign set-element-height!
        "element" "setHeight"
-       (ref extern) i32 -> none)
+       (ref null extern) i32 -> none)
      (define-foreign append-child!
        "element" "appendChild"
-       (ref extern) (ref extern) -> (ref extern))
+       (ref null extern) (ref null extern) -> (ref null extern))
      (define-foreign remove!
        "element" "remove"
-       (ref extern) -> none)
+       (ref null extern) -> none)
      (define-foreign replace-with!
        "element" "replaceWith"
-       (ref extern) (ref extern) -> none)
+       (ref null extern) (ref null extern) -> none)
      (define-foreign set-attribute!
        "element" "setAttribute"
-       (ref extern) (ref string) (ref string) -> none)
+       (ref null extern) (ref string) (ref string) -> none)
      (define-foreign remove-attribute!
        "element" "removeAttribute"
-       (ref extern) (ref string) -> none)
+       (ref null extern) (ref string) -> none)
      (define-foreign add-event-listener!
        "element" "addEventListener"
-       (ref extern) (ref string) (ref eq) -> none)
+       (ref null extern) (ref string) (ref null extern) -> none)
      (define-foreign remove-event-listener!
        "element" "removeEventListener"
-       (ref extern) (ref string) (ref eq) -> none)
+       (ref null extern) (ref string) (ref null extern) -> none)
      (define-foreign clone-element
        "element" "clone"
-       (ref extern) -> (ref extern))
+       (ref null extern) -> (ref null extern))
 
      (define-foreign prevent-default!
        "event" "preventDefault"
-       (ref extern) -> none)
+       (ref null extern) -> none)
      (define-foreign keyboard-event-code
        "event" "keyboardCode"
-       (ref extern) -> (ref string))
+       (ref null extern) -> (ref string))
 
      (define-foreign get-context
        "canvas" "getContext"
-       (ref extern) (ref string) -> (ref extern))
+       (ref null extern) (ref string) -> (ref null extern))
      (define-foreign set-fill-color!
        "canvas" "setFillColor"
-       (ref extern) (ref string) -> none)
+       (ref null extern) (ref string) -> none)
      (define-foreign set-font!
        "canvas" "setFont"
-       (ref extern) (ref string) -> none)
+       (ref null extern) (ref string) -> none)
      (define-foreign set-text-align!
        "canvas" "setTextAlign"
-       (ref extern) (ref string) -> none)
+       (ref null extern) (ref string) -> none)
      (define-foreign clear-rect
        "canvas" "clearRect"
-       (ref extern) f64 f64 f64 f64 -> none)
+       (ref null extern) f64 f64 f64 f64 -> none)
      (define-foreign fill-rect
        "canvas" "fillRect"
-       (ref extern) f64 f64 f64 f64 -> none)
+       (ref null extern) f64 f64 f64 f64 -> none)
      (define-foreign fill-text
        "canvas" "fillText"
-       (ref extern) (ref string) f64 f64 -> none)
+       (ref null extern) (ref string) f64 f64 -> none)
      (define-foreign draw-image
        "canvas" "drawImage"
-       (ref extern) (ref extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
+       (ref null extern) (ref null extern) f64 f64 f64 f64 f64 f64 f64 f64 -> none)
      (define-foreign set-scale!
        "canvas" "setScale"
-       (ref extern) f64 f64 -> none)
+       (ref null extern) f64 f64 -> none)
      (define-foreign set-transform!
        "canvas" "setTransform"
-       (ref extern) f64 f64 f64 f64 f64 f64 -> none)
+       (ref null extern) f64 f64 f64 f64 f64 f64 -> none)
      (define-foreign set-image-smoothing-enabled!
        "canvas" "setImageSmoothingEnabled"
-       (ref extern) i32 -> none)
+       (ref null extern) i32 -> none)
 
      (define-foreign load-audio
        "audio" "new"
-       (ref string) -> (ref extern))
+       (ref string) -> (ref null extern))
      (define-foreign audio-play
        "audio" "play"
-       (ref extern) -> none)
+       (ref null extern) -> none)
      (define-foreign audio-pause
        "audio" "pause"
-       (ref extern) -> none)
+       (ref null extern) -> none)
      (define-foreign audio-volume
        "audio" "volume"
-       (ref extern) -> f64)
+       (ref null extern) -> f64)
      (define-foreign set-audio-volume!
        "audio" "setVolume"
-       (ref extern) f64 -> none)
+       (ref null extern) f64 -> none)
      (define-foreign set-audio-loop!
        "audio" "setLoop"
-       (ref extern) i32 -> none)
+       (ref null extern) i32 -> none)
      (define-foreign audio-seek
        "audio" "seek"
-       (ref extern) f64 -> none)
+       (ref null extern) f64 -> none)
 
      (define-foreign load-image
        "image" "new"
-       (ref string) -> (ref extern))
+       (ref string) -> (ref null extern))
 
      ;; Record types are only just beginning to be added to Hoot and
      ;; there isn't support for mutable structs, yet. So, tagged
@@ -1771,14 +1771,14 @@
        (draw-enemies enemies time)
        (draw-player)
        (draw-enemy-bullets)
+       (draw-hud)
        (when *show-warning?*
          (set-fill-color! context "#d27d2c")
          (set-text-align! context "center")
          (set-font! context "bold 72px monogram")
          (fill-text context "WARNING"
                     (/ game-width 2.0)
-                    (/ game-height 2.0)))
-       (draw-hud))
+                    (/ game-height 2.0))))
 
      (define (draw-pause time)
        (draw-background image:starfield-bg 0.3)
@@ -1864,7 +1864,8 @@
                         ('game-over draw-game-over)
                         ('game-clear draw-game-clear))))
            (draw* time))
-         (request-animation-frame draw)))
+         (request-animation-frame draw-callback)))
+     (define draw-callback (procedure->external draw))
 
      (define (reset!)
        (music-stop)
@@ -1938,8 +1939,7 @@
            (match *game-state*
              ('splash
               (when (string-=? code "Enter")
-                (reset!)
-                (set! *game-state* 'play)))
+                (reset!)))
              ('play
               (cond
                ((string-=? code "Enter")
@@ -2038,14 +2038,18 @@
           (bullet-pool-update! enemy-bullets enemy-bullet-collide)
           (particle-pool-update! particles))
          (_ #t))
-       (timeout update dt))
-
-     (add-event-listener! (current-window) "resize" (lambda (_) (resize-canvas)))
-     (add-event-listener! (current-document) "keydown" on-key-down)
-     (add-event-listener! (current-document) "keyup" on-key-up)
+       (timeout update-callback dt))
+     (define update-callback (procedure->external update))
+
+     (add-event-listener! (current-window) "resize"
+                          (procedure->external (lambda (_) (resize-canvas))))
+     (add-event-listener! (current-document) "keydown"
+                          (procedure->external on-key-down))
+     (add-event-listener! (current-document) "keyup"
+                          (procedure->external on-key-up))
      (resize-canvas)
-     (request-animation-frame draw)
-     (timeout update dt)))
+     (request-animation-frame draw-callback)
+     (timeout update-callback dt)))
 
 (call-with-output-file "game.wasm"
   (lambda (port)
diff --git a/js-runtime/reflect.js b/js-runtime/reflect.js
index 7ba19b7..a930547 100644
--- a/js-runtime/reflect.js
+++ b/js-runtime/reflect.js
@@ -1,3 +1,4 @@
+// -*- js2-basic-offset: 4 -*-
 class Char {
     constructor(codepoint) {
         this.codepoint = codepoint;
@@ -170,25 +171,33 @@ class Scheme {
         return new Scheme(instance, abi);
     }
 
-    init_module(mod) {
+    #init_module(mod) {
         mod.set_debug_handler({
             debug_str(x) { console.log(`debug: ${x}`); },
             debug_str_i32(x, y) { console.log(`debug: ${x}: ${y}`); },
             debug_str_scm: (x, y) => {
-                console.log(`debug: ${x}: ${repr(this.to_js(y))}`);
+                console.log(`debug: ${x}: ${repr(this.#to_js(y))}`);
             },
         });
-        let proc = new Procedure(this, mod.get_export('$load').value)
+        mod.set_ffi_handler({
+            procedure_to_extern: (obj) => {
+                const proc = this.#to_js(obj);
+                return (...args) => {
+                    return proc.call(...args);
+                };
+            }
+        });
+        let proc = new Procedure(this, mod.get_export('$load').value);
         return proc.call();
     }
     static async load_main(path, abi, user_imports = {}) {
         let mod = await SchemeModule.fetch_and_instantiate(path, abi, user_imports);
         let reflect = await mod.reflect();
-        return reflect.init_module(mod);
+        return reflect.#init_module(mod);
     }
-    async load_extension(path) {
-        let mod = await SchemeModule.fetch_and_instantiate(path, this.#abi);
-        return this.init_module(mod);
+    async load_extension(path, user_imports = {}) {
+        let mod = await SchemeModule.fetch_and_instantiate(path, this.#abi, user_imports);
+        return this.#init_module(mod);
     }
 
     #to_scm(js) {
@@ -222,7 +231,7 @@ class Scheme {
         }
     }
 
-    to_js(scm) {
+    #to_js(scm) {
         let api = this.#instance.exports;
         let descr = api.describe(scm);
         let handlers = {
@@ -238,8 +247,8 @@ class Scheme {
             bignum: () => api.bignum_value(scm),
             complex: () => new Complex(api.complex_real(scm),
                                        api.complex_imag(scm)),
-            fraction: () => new Fraction(this.to_js(api.fraction_num(scm)),
-                                         this.to_js(api.fraction_denom(scm))),
+            fraction: () => new Fraction(this.#to_js(api.fraction_num(scm)),
+                                         this.#to_js(api.fraction_denom(scm))),
             pair: () => new Pair(this, scm),
             'mutable-pair': () => new MutablePair(this, scm),
             vector: () => new Vector(this, scm),
@@ -278,16 +287,16 @@ class Scheme {
         argv = api.call(func, argv);
         let results = [];
         for (let idx = 0; idx < api.vector_length(argv); idx++)
-            results.push(this.to_js(api.vector_ref(argv, idx)))
+            results.push(this.#to_js(api.vector_ref(argv, idx)))
         return results;
     }
 
-    car(x) { return this.to_js(this.#instance.exports.car(x.obj)); }
-    cdr(x) { return this.to_js(this.#instance.exports.cdr(x.obj)); }
+    car(x) { return this.#to_js(this.#instance.exports.car(x.obj)); }
+    cdr(x) { return this.#to_js(this.#instance.exports.cdr(x.obj)); }
 
     vector_length(x) { return this.#instance.exports.vector_length(x.obj); }
     vector_ref(x, i) {
-        return this.to_js(this.#instance.exports.vector_ref(x.obj, i));
+        return this.#to_js(this.#instance.exports.vector_ref(x.obj, i));
     }
 
     bytevector_length(x) {
@@ -359,6 +368,7 @@ class SchemeModule {
     #instance;
     #io_handler;
     #debug_handler;
+    #ffi_handler;
     static #rt = {
         bignum_from_string(str) { return BigInt(str); },
         bignum_from_i32(n) { return BigInt(n); },
@@ -492,10 +502,15 @@ class SchemeModule {
             debug_str_i32(x, y) { mod.#debug_handler.debug_str_i32(x, y); },
             debug_str_scm(x, y) { mod.#debug_handler.debug_str_scm(x, y); },
         }
+        let ffi = {
+            procedure_to_extern(proc) {
+                return mod.#ffi_handler.procedure_to_extern(proc);
+            }
+        };
         let imports = {
           rt: SchemeModule.#rt,
           abi: imported_abi,
-          debug, io, ...user_imports
+          debug, io, ffi, ...user_imports
         };
         let { module, instance } = await instantiate_streaming(path, imports);
         let mod = new SchemeModule(instance);
@@ -503,6 +518,7 @@ class SchemeModule {
     }
     set_io_handler(h) { this.#io_handler = h; }
     set_debug_handler(h) { this.#debug_handler = h; }
+    set_ffi_handler(h) { this.#ffi_handler = h; }
     all_exports() { return this.#instance.exports; }
     exported_abi() {
         let abi = {}
@@ -539,6 +555,6 @@ function repr(obj) {
         return flonum_to_string(obj);
     if (typeof obj === 'string')
         // FIXME: Improve to match Scheme.
-        return '"' + obj.replace(/(["\\])/g, '\\$1') + '"';
+        return '"' + obj.replace(/(["\\])/g, '\\$1').replace(/\n/g, '\\n') + '"';
     return obj + '';
 }
diff --git a/js-runtime/reflect.wasm b/js-runtime/reflect.wasm
index d3c857f..68441b9 100644
--- a/js-runtime/reflect.wasm
+++ b/js-runtime/reflect.wasm
diff --git a/manifest.scm b/manifest.scm
index 8fd1412..a91ac44 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -12,31 +12,47 @@
              (gnu packages pkg-config)
              (gnu packages texinfo))
 
+(define guile-next-next
+  (let ((commit "49aa0940bcd1f77819326e73aaee44f5f359d830")
+        (revision "1"))
+    (package
+     (inherit guile-next)
+     (version (git-version "3.0.9" revision commit))
+     (source
+      (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url "https://git.savannah.gnu.org/git/guile.git")
+             (commit commit)))
+       (file-name (git-file-name "guile" version))
+       (sha256
+        (base32 "164i4q0vcb3i790fx6fa9ajjlnx253cabgan2m92kigbpid988hi")))))))
+
 (define guile-hoot
-  (let ((commit "3ff1a556e3056db32e3cd7ccde95faf1f5100887")
+  (let ((commit "bfe760073151f6e4bd2161b32d6e6f28706df9eb")
         (revision "1"))
     (package
-     (name "guile-hoot")
-     (version (git-version "0.0.0" revision commit))
-     (source (origin
-              (method git-fetch)
-              (uri (git-reference
-                    (url "https://gitlab.com/spritely/guile-hoot.git")
-                    (commit commit)))
-              (file-name (git-file-name "guile-hoot" version))
-              (sha256
-               (base32 "087jjqziziahmny45ddjj4ww16935n8i0341yzqx8a81l22f8vc1"))))
-     (build-system gnu-build-system)
-     (arguments
-      '(#:make-flags '("GUILE_AUTO_COMPILE=0")
-        #:tests? #f))
-     (native-inputs
-      (list autoconf automake pkg-config texinfo))
-     (inputs
-      (list guile-next))
-     (synopsis "WASM compiler for Guile Scheme")
-     (description "Guile-hoot is an ahead-of-time WebAssembly compiler for GNU Guile.")
-     (home-page "https://spritely.institute/hoot/")
-     (license (list license:asl2.0 license:lgpl3+)))))
+      (name "guile-hoot")
+      (version (git-version "0.0.0" revision commit))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "https://gitlab.com/spritely/guile-hoot.git")
+                      (commit commit)))
+                (file-name (git-file-name "guile-hoot" version))
+                (sha256
+                 (base32 "05fik20y9v7dz0xamlpas3xp3fwx7qn5n2lrf2qgm6byk2crwxnv"))))
+      (build-system gnu-build-system)
+      (arguments
+       '(#:make-flags '("GUILE_AUTO_COMPILE=0")
+         #:tests? #f))
+      (native-inputs
+       (list autoconf automake pkg-config texinfo))
+      (inputs
+       (list guile-next-next))
+      (synopsis "WASM compiler for Guile Scheme")
+      (description "Guile-hoot is an ahead-of-time WebAssembly compiler for GNU Guile.")
+      (home-page "https://spritely.institute/hoot/")
+      (license (list license:asl2.0 license:lgpl3+)))))
 
-(packages->manifest (list guile-next guile-hoot gnu-make zip))
+(packages->manifest (list guile-next-next guile-hoot gnu-make zip))