lambda and if-number }:3

golden/arith/out.wat

@@ -5,11 +5,18 @@
     (func $gh-write (param (ref eq))))
   (import
     "gyehoek"
-    "to-bool"
+    "truthy?"
-    (func $gh-to-bool (param (ref eq)) (result i32)))
+    (func $gh-truthy? (param (ref eq)) (result i32)))
   (type $heap-object (sub (struct (field $hash (mut i32)))))
   (type $cont-type (func (param i32)))
   (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
   (global $cont-stack-top (mut i32) (i32.const 0))
   (global
     $cont-stack

golden/if-false/out.wat

@@ -5,11 +5,18 @@
     (func $gh-write (param (ref eq))))
   (import
     "gyehoek"
-    "to-bool"
+    "truthy?"
-    (func $gh-to-bool (param (ref eq)) (result i32)))
+    (func $gh-truthy? (param (ref eq)) (result i32)))
   (type $heap-object (sub (struct (field $hash (mut i32)))))
   (type $cont-type (func (param i32)))
   (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
   (global $cont-stack-top (mut i32) (i32.const 0))
   (global
     $cont-stack
@@ -35,7 +42,7 @@
     (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
     (i32.const 1)
     ref.i31
-    (call $gh-to-bool)
+    (call $gh-truthy?)
     (if
       (then
         (global.get $arg-array)

golden/if-number/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > 777

golden/if-number/out.wat

@@ -0,0 +1,70 @@
+(module
+  (import
+    "gyehoek"
+    "write"
+    (func $gh-write (param (ref eq))))
+  (import
+    "gyehoek"
+    "truthy?"
+    (func $gh-truthy? (param (ref eq)) (result i32)))
+  (type $heap-object (sub (struct (field $hash (mut i32)))))
+  (type $cont-type (func (param i32)))
+  (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
+  (global $cont-stack-top (mut i32) (i32.const 0))
+  (global
+    $cont-stack
+    (ref $cont-stack-type)
+    (array.new_default $cont-stack-type (i32.const 128)))
+  (type $arg-array-type (array (mut (ref null eq))))
+  (global
+    $arg-array
+    (ref $arg-array-type)
+    (array.new_default $arg-array-type (i32.const 32)))
+  (global $result (mut (ref null eq)) (ref.null eq))
+  (func
+    $halt
+    (param i32)
+    (global.get $arg-array)
+    (i32.const 0)
+    (array.get $arg-array-type)
+    ref.as_non_null
+    (global.set $result))
+  (func
+    $scm-entry
+    (param i32)
+    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+    (i32.const 123)
+    (i32.const 1)
+    i32.shl
+    ref.i31
+    (call $gh-truthy?)
+    (if
+      (then
+        (global.get $arg-array)
+        (global.get 0)
+        (i32.const 777)
+        (i32.const 1)
+        i32.shl
+        ref.i31
+        (array.set $arg-array-type)
+        (return_call $halt (i32.const 1)))
+      (else
+        (global.get $arg-array)
+        (global.get 0)
+        (i32.const 555)
+        (i32.const 1)
+        i32.shl
+        ref.i31
+        (array.set $arg-array-type)
+        (return_call $halt (i32.const 1)))))
+  (func
+    (export "main")
+    (call $scm-entry (i32.const 0))
+    (call $gh-write (ref.as_non_null (global.get $result)))))

golden/if-number/source.scm

@@ -0,0 +1 @@
+(if 123 777 555)

golden/if-true/out.wat

@@ -5,11 +5,18 @@
     (func $gh-write (param (ref eq))))
   (import
     "gyehoek"
-    "to-bool"
+    "truthy?"
-    (func $gh-to-bool (param (ref eq)) (result i32)))
+    (func $gh-truthy? (param (ref eq)) (result i32)))
   (type $heap-object (sub (struct (field $hash (mut i32)))))
   (type $cont-type (func (param i32)))
   (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
   (global $cont-stack-top (mut i32) (i32.const 0))
   (global
     $cont-stack
@@ -35,7 +42,7 @@
     (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
     (i32.const 3)
     ref.i31
-    (call $gh-to-bool)
+    (call $gh-truthy?)
     (if
       (then
         (global.get $arg-array)

golden/lambda/exec

@@ -0,0 +1,2 @@
+ret > ExitSuccess
+out > #<procedure>

golden/lambda/out.wat

@@ -0,0 +1,78 @@
+(module
+  (import
+    "gyehoek"
+    "write"
+    (func $gh-write (param (ref eq))))
+  (import
+    "gyehoek"
+    "truthy?"
+    (func $gh-truthy? (param (ref eq)) (result i32)))
+  (type $heap-object (sub (struct (field $hash (mut i32)))))
+  (type $cont-type (func (param i32)))
+  (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
+  (global $cont-stack-top (mut i32) (i32.const 0))
+  (global
+    $cont-stack
+    (ref $cont-stack-type)
+    (array.new_default $cont-stack-type (i32.const 128)))
+  (type $arg-array-type (array (mut (ref null eq))))
+  (global
+    $arg-array
+    (ref $arg-array-type)
+    (array.new_default $arg-array-type (i32.const 32)))
+  (global $result (mut (ref null eq)) (ref.null eq))
+  (func
+    $halt
+    (param i32)
+    (global.get $arg-array)
+    (i32.const 0)
+    (array.get $arg-array-type)
+    ref.as_non_null
+    (global.set $result))
+  (func
+    (param i32)
+    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+    (global.get $arg-array)
+    (i32.const 0)
+    (array.get $arg-array-type)
+    ref.as_non_null
+    (local.set 1)
+    (global.get $arg-array)
+    (global.get 0)
+    (local.get 1)
+    (array.set $arg-array-type)
+    (i32.const 1)
+    (global.get $cont-stack)
+    (global.get $cont-stack-top)
+    (array.get $cont-stack-type)
+    ref.as_non_null
+    (global.get $cont-stack-top)
+    (i32.const 1)
+    i32.sub
+    (global.set $cont-stack-top)
+    (return_call_ref $cont-type))
+  (elem declare funcref (ref.func 3))
+  (func
+    $scm-entry
+    (param i32)
+    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+    (i32.const 0)
+    (ref.func 3)
+    (struct.new $closure)
+    (local.set 1)
+    (global.get $arg-array)
+    (global.get 0)
+    (local.get 1)
+    (array.set $arg-array-type)
+    (return_call $halt (i32.const 1)))
+  (func
+    (export "main")
+    (call $scm-entry (i32.const 0))
+    (call $gh-write (ref.as_non_null (global.get $result)))))

runtime/Cargo.lock

@@ -11,6 +11,17 @@ dependencies = [
  "gimli",
 ]
 
+[[package]]
+name = "ahash"
+version = "0.7.8"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "891477e0c6a8957309ee5c45a6368af3ae14bb510732d2684ffa19af310920f9"
+dependencies = [
+ "getrandom 0.2.17",
+ "once_cell",
+ "version_check",
+]
+
 [[package]]
 name = "allocator-api2"
 version = "0.2.21"
@@ -87,7 +98,7 @@ checksum = "9035ad2d096bed7955a320ee7e2230574d28fd3c3a0f186cbea1ff3c7eed5dbb"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -169,7 +180,7 @@ dependencies = [
  "heck",
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -657,9 +668,19 @@ version = "0.1.0"
 dependencies = [
  "clap",
  "clio",
+ "memoize",
  "wasmtime",
 ]
 
+[[package]]
+name = "hashbrown"
+version = "0.12.3"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888"
+dependencies = [
+ "ahash",
+]
+
 [[package]]
 name = "hashbrown"
 version = "0.16.1"
@@ -780,6 +801,12 @@ dependencies = [
  "wasm-bindgen",
 ]
 
+[[package]]
+name = "lazy_static"
+version = "1.5.0"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "bbd2bcb4c963f2ddae06a2efc7e9f3591312473c50c6685e1f298068316e66fe"
+
 [[package]]
 name = "leb128fmt"
 version = "0.1.0"
@@ -819,6 +846,15 @@ version = "0.4.33"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "0ceec5bc11778974d1bcb055b18002eba7f4b3518b6a0081b3af5f21666da9ad"
 
+[[package]]
+name = "lru"
+version = "0.7.8"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "e999beba7b6e8345721bd280141ed958096a2e4abdf74f67ff4ce49b4b54e47a"
+dependencies = [
+ "hashbrown 0.12.3",
+]
+
 [[package]]
 name = "mach2"
 version = "0.6.0"
@@ -840,6 +876,29 @@ dependencies = [
  "rustix",
 ]
 
+[[package]]
+name = "memoize"
+version = "0.6.0"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "71e73b7be6eeec913659aed78e8c72208f5e9c6a5fb7e0831a491946fd234104"
+dependencies = [
+ "lazy_static",
+ "lru",
+ "memoize-inner",
+]
+
+[[package]]
+name = "memoize-inner"
+version = "0.5.1"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "6dd8f89255d8ff313afabed9a3c83ef0993cc056679dfd001f5111a026f876f7"
+dependencies = [
+ "lazy_static",
+ "proc-macro2",
+ "quote",
+ "syn 1.0.109",
+]
+
 [[package]]
 name = "object"
 version = "0.39.1"
@@ -927,7 +986,7 @@ checksum = "5a7ac85c0bb3fb351f10d531230aaa5e366b46d7c4e5328e5f02801d6dac1165"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -1068,7 +1127,7 @@ checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -1137,6 +1196,17 @@ version = "0.11.1"
 source = "registry+https://github.com/rust-lang/crates.io-index"
 checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f"
 
+[[package]]
+name = "syn"
+version = "1.0.109"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "72b64191b275b66ffe2469e8af2c1cfe3bafa67b529ead792a6d0160888b4237"
+dependencies = [
+ "proc-macro2",
+ "quote",
+ "unicode-ident",
+]
+
 [[package]]
 name = "syn"
 version = "2.0.119"
@@ -1202,7 +1272,7 @@ checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -1213,7 +1283,7 @@ checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]
@@ -1349,7 +1419,7 @@ dependencies = [
  "bumpalo",
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
  "wasm-bindgen-shared",
 ]
 
@@ -1547,7 +1617,7 @@ dependencies = [
  "anyhow",
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
  "wasmtime-internal-component-util",
  "wasmtime-internal-wit-bindgen",
  "wit-parser",
@@ -1658,7 +1728,7 @@ checksum = "e747f4a074699ba1b4e4d841fb263f9b7df5bd1555181c4752bf5990d21ba676"
 dependencies = [
  "proc-macro2",
  "quote",
- "syn",
+ "syn 2.0.119",
 ]
 
 [[package]]

runtime/Cargo.toml

@@ -6,4 +6,5 @@ edition = "2024"
 [dependencies]
 clap = { version = "4.6.1", features = ["derive"] }
 clio = { version = "0.3.5", features = ["clap-parse"] }
+memoize = "0.6.0"
 wasmtime = "46.0.1"

runtime/src/gyehoek.rs

@@ -1,6 +1,6 @@
 use wasmtime::*;
 use crate::internal as scm;
-use crate::internal::{Scm,Immediate};
+use crate::internal::{Scm,Immediate,HeapObject};
 
 // pub fn small_fixnum_p (_)
 
@@ -16,13 +16,20 @@ fn write_immediate (_caller : Caller<'_, u32>, imm : Immediate) {
 }
 
 pub fn write (caller : Caller<'_, u32>, x : Rooted<EqRef>) {
-    match scm::interpret (&caller, x).unwrap () {
+    match scm::interpret (&caller, x).unwrap ().unwrap () {
-        Scm::Immediate (x) => write_immediate (caller, x)
+        Scm::Immediate (x) => write_immediate (caller, x),
+        Scm::HeapObject (x) => write_heap_object (caller, x),
+    }
+}
+
+fn write_heap_object (_caller : Caller<'_, u32>, x : HeapObject) {
+    match x {
+        HeapObject::Procedure => print! ("#<procedure>"),
     }
 }
 
 pub fn truthy_p (caller : Caller<'_, u32>, x : Rooted<EqRef>,) -> u32 {
-    let r = scm::interpret (&caller, x).unwrap ();
+    let r = scm::interpret (&caller, x).unwrap ().unwrap ();
     if let Scm::Immediate (Immediate::Bool (false)) = r {
         0
     } else {

runtime/src/internal.rs

@@ -1,4 +1,5 @@
 use wasmtime::*;
+use crate::types;
 
 pub fn immediate_p (store : impl AsContext, x : Rooted<EqRef>) -> bool {
     x.is_i31 (store).unwrap ()
@@ -9,8 +10,13 @@ pub enum Immediate {
     Bool (bool),
 }
 
+pub enum HeapObject {
+    Procedure
+}
+
 pub enum Scm {
     Immediate (Immediate),
+    HeapObject (HeapObject),
 }
 
 #[allow(nonstandard_style)]
@@ -33,14 +39,34 @@ pub fn interpret_immediate (x : scm_bits) -> Option<Immediate> {
     }
 }
 
-pub fn interpret (store : impl AsContext, x : Rooted<EqRef>) -> Option<Scm> {
+pub fn interpret_heap_object (
-    if let Some (imm) = x.as_i31 (store).unwrap () {
+    store : impl AsContext,
-        Some (Scm::Immediate (interpret_immediate (imm.get_u32 ())?))
+    x : Rooted<EqRef>
+) -> Result<Option<HeapObject>> {
+    if x.matches_ty (&store, &types::closure (&store)?)? {
+        Ok (Some (HeapObject::Procedure))
     } else {
         todo! ()
     }
 }
 
+pub fn interpret (
+    store : impl AsContext,
+    x : Rooted<EqRef>
+) -> Result<Option<Scm>> {
+    if let Some (imm) = x.as_i31 (&store)? {
+        Ok (
+            interpret_immediate (imm.get_u32 ())
+                .map (Scm::Immediate)
+        )
+    } else {
+        Ok (
+            interpret_heap_object (&store, x)?
+                .map (Scm::HeapObject)
+        )
+    }
+}
+
 pub fn encode_immediate (
     store : impl AsContext,
     imm : Immediate
@@ -60,6 +86,9 @@ pub fn encode (store : impl AsContextMut, x : Scm) -> Rooted<EqRef> {
                 .unwrap ();
             EqRef::from_i31 (store, i31)
         }
+        Scm::HeapObject (ho) => {
+            todo! ()
+        }
     }
 }
 

runtime/src/main.rs

@@ -1,5 +1,6 @@
 mod gyehoek;
 mod internal;
+mod types;
 
 use std::io;
 use std::io::Read;
@@ -33,7 +34,7 @@ fn get_config () -> Config {
 
 fn link_primitives (linker : &mut Linker<u32>) -> wasmtime::Result<()> {
     linker.func_wrap ("gyehoek", "write", gyehoek::write)?;
-    linker.func_wrap ("gyehoek", "to-bool", gyehoek::truthy_p)?;
+    linker.func_wrap ("gyehoek", "truthy?", gyehoek::truthy_p)?;
     Ok (())
 }
 

runtime/src/types.rs

@@ -0,0 +1,62 @@
+use wasmtime::*;
+use memoize::memoize;
+
+pub fn heap_object_struct (store : impl AsContext) -> Result<StructType> {
+    let ctx = store.as_context ();
+    let engine = ctx.engine ();
+    Ok (
+        StructType::with_finality_and_supertype (
+            engine,
+            Finality::NonFinal,
+            None,
+            vec![
+                hash_field ()
+            ]
+        )?
+    )
+}
+
+pub fn heap_object (_store : impl AsContext) -> Result<HeapType> {
+    todo! ()
+}
+
+#[memoize]
+pub fn hash_field () -> FieldType {
+    FieldType::new (
+        Mutability::Var,
+        StorageType::ValType (ValType::I32)
+    )
+}
+
+pub fn closure (store : impl AsContext) -> Result<HeapType> {
+    let ctx = store.as_context ();
+    let engine = ctx.engine ();
+    Ok (
+        HeapType::ConcreteStruct (
+            StructType::with_finality_and_supertype (
+                engine,
+                Finality::NonFinal,
+                Some (&heap_object_struct (&store)?),
+                vec![
+                    hash_field (),
+                    FieldType::new (
+                        Mutability::Const,
+                        StorageType::ValType (ValType::Ref (
+                            RefType::new (
+                                false,
+                                HeapType::ConcreteFunc (
+                                    FuncType::new (
+                                        engine,
+                                        vec![ValType::I32],
+                                        vec![],
+                                    )
+                                )
+                            )
+                        ))
+                    ),
+                ]
+            )?
+        )
+    )
+}
+

src/Gyehoek/CPS/Lower.hs

@@ -54,18 +54,6 @@ type instance IxValue Env = Name
 instance Ixed Env where
   ix i = #vars . ix (fromIntegral i)
 
--- data Runtime = MkRuntime
---   { argArrayType :: Idx
---   , argArray :: Idx
---   , contType :: Idx
---   , contStackType :: Idx
---   , contStackTop :: Idx
---   , contStack :: Idx
---   , result :: Idx
---   , halt :: Idx
---   }
---   deriving (Show, Generic)
-
 
 
 -- | @makeSmallFixnum@ emits an expression injecting the i32 on top
@@ -139,18 +127,43 @@ lower' g (ExpIf c t f) = do
   let c' = lowerVal g c
   pure [expr|
     ##{c'}
-    (call $gh-to-bool)
+    (call $gh-truthy?)
     (if (then ##{t'})
         (else ##{f'}))
   |]
 
-lower' g e = error . show $ e
+lower' g (ExpLet [(r,lam)] e) = do
+  idx <- lowerLambda g lam
+  let g' = g & #vars <>~ [r]
+  let n = succ $ length g.vars
+  e' <- lower' g' e
+  pure [expr|
+    (i32.const 0)
+    (ref.func #{idx})
+    (struct.new $closure)
+    (local.set #{n})
+    ##{e'}
+  |]
 
--- lower' g (ExpIf c t f) = do
+lower' g (ExpContinue k [x]) = pure . mconcat $
---   t' <- lower' g t
+  [ pushArg 0 (lowerVal g x)
---   f' <- lower' g f
+  , [expr|
---   pure $ lowerVal g c
+      (i32.const 1)
---     <> Wasm.if' (Wasm.result [i32]) t' f'
+      (global.get $cont-stack)
+      (global.get $cont-stack-top)
+      (array.get $cont-stack-type)
+      ref.as_non_null
+      (global.get $cont-stack-top)
+      (i32.const #{l})
+      i32.sub
+      (global.set $cont-stack-top)
+      (return_call_ref $cont-type)
+    |]
+  ]
+  where
+    l = succ $ V.elemIndex k g.kvars ^?! _Just
+
+lower' g e = error . show $ e
 
 -- lower' g (ExpContinue k [x]) = pure . mconcat $
 --   [ pushArg rt 0 (lowerVal g x)
@@ -171,27 +184,24 @@ lower' g e = error . show $ e
 --     rt = g.runtime
 --     l = V.elemIndex k g.kvars ^?! _Just
 
--- lower' g (ExpLet [(r,MkLambda xs ktail m)] e) = do
+lowerLambda :: GenMod :> es => Env -> Lambda -> Eff es Idx
---   idx <- defun [i32] [] (replicate 5 scm) \_ -> do
+lowerLambda g (MkLambda xs ktail m) = do
---     let g' = g & #vars <>~ V.fromList xs
+  let g' = g & #vars .~ V.fromList xs
---                & #kvars <>~ [ktail]
+             & #kvars <>~ [ktail]
---     m' <- lower' g' m
+  m' <- lower' g' m
---     pure . mconcat $
+  let body = mconcat
---       [ xs & ifoldMap \n _ ->
+        [ xs & ifoldMap \n _ ->
---           popArg g.runtime n <> ins "local.set" [sxp (1+n)]
+            let n' = succ n
---       , m'
+            in popArg n <> [expr|(local.set #{n'})|]
---       ]
+        , m'
---   declareFuncref idx
+        ]
---   let g' = g & #vars <>~ [r]
+  idx <- Wasm.defineFunction [wat|
---   let n = length g.vars
+    (func (param i32)
---   e' <- lower' g' e
+      (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
---   pure . mconcat $
+      ##{body})
---     [ ins "ref.func" [sxp idx]
+  |]
---     , ins "local.set" [sxp (n+1)]
+  Wasm.emit [wats|(elem declare funcref (ref.func #{idx}))|]
---     , e'
+  pure idx
---     ]
-
--- lower' g e = error . show $ e
 
 lowerBinOp
   :: (GenMod :> es)
@@ -220,60 +230,24 @@ lowerBinOp op g x y r e = do
 
 
 
--- scm = ref eq
-
-
-
--- emitRuntime :: GenMod :> es => Eff es Runtime
--- emitRuntime = mfix \runtime -> do
---   heapObjectIdx <- Wasm.deftypeNamed "$heap-object" $ Wasm.sub [] $ Wasm.struct
---     [ Wasm.mut i32 ]
---   -- cont stack
---   contType <- Wasm.deftype $ Wasm.func [i32] []
---   contStackType <- Wasm.deftype $ array $ mut $ refnull (fromIdx contType)
---   contStackTop <- Wasm.defglobal (mut i32) $ ins "i32.const" [sxp @Int 0]
---   contStack <- Wasm.defglobal (ref (Wasm.fromIdx contStackType)) $
---     ins "i32.const" [sxp @Int 128]
---     <> ins "array.new_default" [sxp contStackType]
---   -- arg array
---   argArrayType <- Wasm.deftype $ Wasm.array $ mut $ refnull eq
---   argArray <- Wasm.defglobal (ref (Wasm.fromIdx argArrayType)) $
---     ins "i32.const" [sxp @Int 32]
---     <> ins "array.new_default" [sxp argArrayType]
---   -- consIdx <- Wasm.defun _ _ _ _
---   result <- Wasm.defglobal (mut (refnull eq)) $ ins "ref.null" [sxp eq]
---   halt <- Wasm.defun [i32] [] (replicate 5 scm) \_ ->
---     pure . mconcat $
---       [ popArg runtime 0
---       , ins "global.set" [sxp result]
---       ]
---   pure $ MkRuntime
---     {argArray,argArrayType
---     ,contStack,contStackTop,contStackType,contType
---     ,result,halt}
---   -- pure $ error "todo"
-
 emitRuntime :: GenMod :> es => Eff es ()
 emitRuntime = mfix \runtime -> do
-  Wasm.emit [wats|
+  Wasm.defineFunctions [wats|
     (import "gyehoek" "write" (func $gh-write (param (ref eq))))
-    (import "gyehoek" "to-bool" (func $gh-to-bool (param (ref eq))
+    (import "gyehoek" "truthy?" (func $gh-truthy? (param (ref eq))
                                   (result i32)))
   |]
   -- cont stack
-  Wasm.defineType [wat|
+  Wasm.defineTypes [wats|
     (type $heap-object (sub (struct (field $hash (mut i32)))))
-  |]
-  Wasm.defineType [wat|
     (type $cont-type (func (param i32)))
-  |]
-  Wasm.defineType [wat|
     (type $cont-stack-type (array (mut (ref null $cont-type))))
+    (type $closure (sub $heap-object
+                        (struct (field $hash (mut i32))
+                                (field $code (ref $cont-type)))))
   |]
-  Wasm.defineGlobal [wat|
+  Wasm.defineGlobals [wats|
     (global $cont-stack-top (mut i32) (i32.const 0))
-  |]
-  Wasm.defineGlobal [wat|
     (global $cont-stack (ref $cont-stack-type)
             (array.new_default $cont-stack-type (i32.const 128)))
   |]

src/Gyehoek/Wasm.hs

@@ -32,6 +32,9 @@ module Gyehoek.Wasm
   , renderModule
   , wat
   , wats
+  , defineFunctions
+  , defineTypes
+  , defineGlobals
   )
   where
 
@@ -133,12 +136,21 @@ type instance DispatchOf GenMod = Dynamic
 defineFunction :: GenMod :> es => Sexp -> Eff es Idx
 defineFunction = send . DefineFunction
 
+defineFunctions :: GenMod :> es => List Sexp -> Eff es (List Idx)
+defineFunctions = traverse (send . DefineFunction)
+
 defineType :: GenMod :> es => Sexp -> Eff es Idx
 defineType = send . DefineType
 
+defineTypes :: GenMod :> es => List Sexp -> Eff es (List Idx)
+defineTypes = traverse (send . DefineType)
+
 defineGlobal :: GenMod :> es => Sexp -> Eff es Idx
 defineGlobal = send . DefineGlobal
 
+defineGlobals :: GenMod :> es => List Sexp -> Eff es (List Idx)
+defineGlobals = traverse (send . DefineGlobal)
+
 emit :: GenMod :> es => List Sexp -> Eff es ()
 emit = traverse_ (send . Emit)
 

t.wat

@@ -0,0 +1,70 @@
+(module
+  (import
+    "gyehoek"
+    "write"
+    (func $gh-write (param (ref eq))))
+  (import
+    "gyehoek"
+    "truthy?"
+    (func $gh-truthy? (param (ref eq)) (result i32)))
+  (type $heap-object (sub (struct (field $hash (mut i32)))))
+  (type $cont-type (func (param i32)))
+  (type $cont-stack-type (array (mut (ref null $cont-type))))
+  (type
+    $closure
+    (sub
+      $heap-object
+      (struct
+        (field $hash (mut i32))
+        (field $code (ref $cont-type)))))
+  (global $cont-stack-top (mut i32) (i32.const 0))
+  (global
+    $cont-stack
+    (ref $cont-stack-type)
+    (array.new_default $cont-stack-type (i32.const 128)))
+  (type $arg-array-type (array (mut (ref null eq))))
+  (global
+    $arg-array
+    (ref $arg-array-type)
+    (array.new_default $arg-array-type (i32.const 32)))
+  (global $result (mut (ref null eq)) (ref.null eq))
+  (func
+    $halt
+    (param i32)
+    (global.get $arg-array)
+    (i32.const 0)
+    (array.get $arg-array-type)
+    ref.as_non_null
+    (global.set $result))
+  (func
+    $scm-entry
+    (param i32)
+    (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq))
+    (i32.const 123)
+    (i32.const 1)
+    i32.shl
+    ref.i31
+    (call $gh-truthy?)
+    (if
+      (then
+        (global.get $arg-array)
+        (global.get 0)
+        (i32.const 777)
+        (i32.const 1)
+        i32.shl
+        ref.i31
+        (array.set $arg-array-type)
+        (return_call $halt (i32.const 1)))
+      (else
+        (global.get $arg-array)
+        (global.get 0)
+        (i32.const 555)
+        (i32.const 1)
+        i32.shl
+        ref.i31
+        (array.set $arg-array-type)
+        (return_call $halt (i32.const 1)))))
+  (func
+    (export "main")
+    (call $scm-entry (i32.const 0))
+    (call $gh-write (ref.as_non_null (global.get $result)))))

test/Main.hs

@@ -16,7 +16,6 @@ import System.Environment.Blank (getEnvDefault)
 disabled :: List String
 disabled =
   [ "square"
-  , "lambda"
   ]
 
 main :: IO ()