diff --git a/golden/arith/out.wat b/golden/arith/out.wat index 5c5a59c..357b54b 100644 --- a/golden/arith/out.wat +++ b/golden/arith/out.wat @@ -5,11 +5,18 @@ (func $gh-write (param (ref eq)))) (import "gyehoek" - "to-bool" - (func $gh-to-bool (param (ref eq)) (result i32))) + "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 diff --git a/golden/if-false/out.wat b/golden/if-false/out.wat index 3db0974..d450f31 100644 --- a/golden/if-false/out.wat +++ b/golden/if-false/out.wat @@ -5,11 +5,18 @@ (func $gh-write (param (ref eq)))) (import "gyehoek" - "to-bool" - (func $gh-to-bool (param (ref eq)) (result i32))) + "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 @@ -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) diff --git a/golden/if-number/exec b/golden/if-number/exec new file mode 100644 index 0000000..974f55a --- /dev/null +++ b/golden/if-number/exec @@ -0,0 +1,2 @@ +ret > ExitSuccess +out > 777 diff --git a/golden/if-number/out.wat b/golden/if-number/out.wat new file mode 100644 index 0000000..05bf4b6 --- /dev/null +++ b/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))))) \ No newline at end of file diff --git a/golden/if-number/source.scm b/golden/if-number/source.scm new file mode 100644 index 0000000..2864d75 --- /dev/null +++ b/golden/if-number/source.scm @@ -0,0 +1 @@ +(if 123 777 555) diff --git a/golden/if-true/out.wat b/golden/if-true/out.wat index edcc9e0..d8e7d2e 100644 --- a/golden/if-true/out.wat +++ b/golden/if-true/out.wat @@ -5,11 +5,18 @@ (func $gh-write (param (ref eq)))) (import "gyehoek" - "to-bool" - (func $gh-to-bool (param (ref eq)) (result i32))) + "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 @@ -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) diff --git a/golden/lambda/exec b/golden/lambda/exec new file mode 100644 index 0000000..b196242 --- /dev/null +++ b/golden/lambda/exec @@ -0,0 +1,2 @@ +ret > ExitSuccess +out > # diff --git a/golden/lambda/out.wat b/golden/lambda/out.wat new file mode 100644 index 0000000..5e389f0 --- /dev/null +++ b/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))))) \ No newline at end of file diff --git a/runtime/Cargo.lock b/runtime/Cargo.lock index 8d1d84e..99d077a 100644 --- a/runtime/Cargo.lock +++ b/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]] diff --git a/runtime/Cargo.toml b/runtime/Cargo.toml index ddef257..eddba02 100644 --- a/runtime/Cargo.toml +++ b/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" diff --git a/runtime/src/gyehoek.rs b/runtime/src/gyehoek.rs index 8f4cb8e..f339069 100644 --- a/runtime/src/gyehoek.rs +++ b/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) { - match scm::interpret (&caller, x).unwrap () { - Scm::Immediate (x) => write_immediate (caller, x) + match scm::interpret (&caller, x).unwrap ().unwrap () { + 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! ("#"), } } pub fn truthy_p (caller : Caller<'_, u32>, x : Rooted,) -> 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 { diff --git a/runtime/src/internal.rs b/runtime/src/internal.rs index abc6133..f08e4e4 100644 --- a/runtime/src/internal.rs +++ b/runtime/src/internal.rs @@ -1,4 +1,5 @@ use wasmtime::*; +use crate::types; pub fn immediate_p (store : impl AsContext, x : Rooted) -> 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 { } } -pub fn interpret (store : impl AsContext, x : Rooted) -> Option { - if let Some (imm) = x.as_i31 (store).unwrap () { - Some (Scm::Immediate (interpret_immediate (imm.get_u32 ())?)) +pub fn interpret_heap_object ( + store : impl AsContext, + x : Rooted +) -> Result> { + if x.matches_ty (&store, &types::closure (&store)?)? { + Ok (Some (HeapObject::Procedure)) } else { todo! () } } +pub fn interpret ( + store : impl AsContext, + x : Rooted +) -> Result> { + 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 { .unwrap (); EqRef::from_i31 (store, i31) } + Scm::HeapObject (ho) => { + todo! () + } } } diff --git a/runtime/src/main.rs b/runtime/src/main.rs index e4ebeaa..fcd662f 100644 --- a/runtime/src/main.rs +++ b/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) -> 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 (()) } diff --git a/runtime/src/types.rs b/runtime/src/types.rs new file mode 100644 index 0000000..f4eac63 --- /dev/null +++ b/runtime/src/types.rs @@ -0,0 +1,62 @@ +use wasmtime::*; +use memoize::memoize; + +pub fn heap_object_struct (store : impl AsContext) -> Result { + 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 { + todo! () +} + +#[memoize] +pub fn hash_field () -> FieldType { + FieldType::new ( + Mutability::Var, + StorageType::ValType (ValType::I32) + ) +} + +pub fn closure (store : impl AsContext) -> Result { + 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![], + ) + ) + ) + )) + ), + ] + )? + ) + ) +} + diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index 7eb5e0b..683c95f 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/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 --- t' <- lower' g t --- f' <- lower' g f --- pure $ lowerVal g c --- <> Wasm.if' (Wasm.result [i32]) t' f' +lower' g (ExpContinue k [x]) = pure . mconcat $ + [ pushArg 0 (lowerVal g x) + , [expr| + (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 #{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 --- idx <- defun [i32] [] (replicate 5 scm) \_ -> do --- let g' = g & #vars <>~ V.fromList xs --- & #kvars <>~ [ktail] --- m' <- lower' g' m --- pure . mconcat $ --- [ xs & ifoldMap \n _ -> --- popArg g.runtime n <> ins "local.set" [sxp (1+n)] --- , m' --- ] --- declareFuncref idx --- let g' = g & #vars <>~ [r] --- let n = length g.vars --- e' <- lower' g' e --- pure . mconcat $ --- [ ins "ref.func" [sxp idx] --- , ins "local.set" [sxp (n+1)] --- , e' --- ] - --- lower' g e = error . show $ e +lowerLambda :: GenMod :> es => Env -> Lambda -> Eff es Idx +lowerLambda g (MkLambda xs ktail m) = do + let g' = g & #vars .~ V.fromList xs + & #kvars <>~ [ktail] + m' <- lower' g' m + let body = mconcat + [ xs & ifoldMap \n _ -> + let n' = succ n + in popArg n <> [expr|(local.set #{n'})|] + , m' + ] + idx <- Wasm.defineFunction [wat| + (func (param i32) + (local (ref eq) (ref eq) (ref eq) (ref eq) (ref eq)) + ##{body}) + |] + Wasm.emit [wats|(elem declare funcref (ref.func #{idx}))|] + pure idx 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))) |] diff --git a/src/Gyehoek/Wasm.hs b/src/Gyehoek/Wasm.hs index 118aa02..b8e91c1 100644 --- a/src/Gyehoek/Wasm.hs +++ b/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) diff --git a/t.wat b/t.wat new file mode 100644 index 0000000..13092cc --- /dev/null +++ b/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))))) diff --git a/test/Main.hs b/test/Main.hs index 9ead0b1..d514954 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -16,7 +16,6 @@ import System.Environment.Blank (getEnvDefault) disabled :: List String disabled = [ "square" - , "lambda" ] main :: IO ()