Start actually allocating oh no

wasm-calc4/src/Calc/Wasm/FromExpr.hs

@@ -5,6 +5,9 @@
 
 module Calc.Wasm.FromExpr (fromModule) where
 
+import qualified Data.List.NonEmpty as NE
+import Data.Monoid
+import Calc.Wasm.Helpers
 import Calc.Types.Expr
 import Calc.Types.Function
 import Calc.Types.Identifier
@@ -60,7 +63,7 @@ fromExpr ::
     MonadReader FromExprEnv m,
     Show ann
   ) =>
-  Expr ann ->
+  Expr (Type ann) ->
   m WasmExpr
 fromExpr (EPrim _ prim) = pure $ WPrim prim
 fromExpr (EInfix _ op a b) = WInfix op <$> fromExpr a <*> fromExpr b
@@ -69,10 +72,26 @@ fromExpr (EIf _ predE thenE elseE) =
 fromExpr (EVar _ ident) = WVar <$> lookupIdent ident
 fromExpr (EApply _ funcName args) =
   WApply <$> lookupFunction funcName <*> (traverse fromExpr args) -- need to look up the function name in some sort of state
+fromExpr (ETuple ty a as) = do
+  let allItems = zip [0..] (a : NE.toList as)
+      tupleLength = memorySizeForType ty
+      allocate = WAllocate (fromIntegral tupleLength)
+  WSet allocate <$> traverse (\(i,item) ->
+    (,) i <$> fromExpr item) allItems
 fromExpr other = error $ "fromExpr error: " <> show other
 
+memorySizeForType :: Type ann -> Natural
+memorySizeForType (TPrim _ TInt) =
+  memorySize I32
+memorySizeForType (TPrim _ TBool) =
+  memorySize I32
+memorySizeForType (TTuple _ a as) =
+  memorySizeForType a + getSum (foldMap (Sum . memorySizeForType) as)
+memorySizeForType (TFunction {}) =
+  memorySize Pointer
+
 fromFunction :: (Show ann) =>
-  M.Map FunctionName Natural -> Function ann -> Either FromWasmError WasmFunction
+  M.Map FunctionName Natural -> Function (Type ann) -> Either FromWasmError WasmFunction
 fromFunction funcMap (Function {fnBody, fnArgs, fnFunctionName}) = do
   args <- traverse (scalarFromType . snd) fnArgs
   let argMap = M.fromList $ (\(i, (ArgumentName ident, _)) -> (Identifier ident, i)) <$> zip [0 ..] fnArgs
@@ -86,7 +105,7 @@ fromFunction funcMap (Function {fnBody, fnArgs, fnFunctionName}) = do
         wfReturnType = I32 -- a pure guess, we should use the typed module here and grab the type from `ann`
       }
 
-fromModule :: (Show ann) => Module ann -> Either FromWasmError WasmModule
+fromModule :: (Show ann) => Module (Type ann) -> Either FromWasmError WasmModule
 fromModule (Module {mdExpr, mdFunctions}) = do
   let funcMap = M.fromList $ (\(i, Function {fnFunctionName}) -> (fnFunctionName, i + 1)) <$> zip [0 ..] mdFunctions
 

wasm-calc4/src/Calc/Wasm/Helpers.hs

@@ -0,0 +1,10 @@
+module Calc.Wasm.Helpers (memorySize) where
+
+import Calc.Wasm.Types
+import GHC.Natural
+
+-- our memory is bits of i32s
+memorySize :: WasmType -> Natural
+memorySize I32 = 1
+memorySize Pointer = 1
+

wasm-calc4/src/Calc/Wasm/ToWasm.hs

@@ -17,7 +17,7 @@ mapWithIndex f = fmap f . zip [0..]
 
 fromType :: WasmType -> Wasm.ValueType
 fromType I32 = Wasm.I32
-fromType Pointer = Wasm.I64
+fromType Pointer = Wasm.I32
 
 fromFunction :: Int -> WasmFunction -> Wasm.Function
 fromFunction wfIndex (WasmFunction {wfExpr, wfArgs}) =
@@ -56,6 +56,13 @@ fromExpr (WIf predExpr thenExpr elseExpr) =
 fromExpr (WVar i) = [Wasm.GetLocal i]
 fromExpr (WApply fnIndex args) =
   foldMap fromExpr args <> [Wasm.Call $ fnIndex + 1]
+-- we need to store the return value so we can refer to it in multiple places
+fromExpr (WAllocate i) =
+  [Wasm.I32Const (fromIntegral i), Wasm.Call 0]
+fromExpr (WSet container items ) =
+  let fromItem (offset, value) =
+        fromExpr container <> fromExpr value <> [Wasm.I32Store $ Wasm.MemArg offset 0]
+  in foldMap fromItem items
 
 -- | we load the bump allocator module and build on top of it
 moduleToWasm :: WasmModule -> Wasm.Module

wasm-calc4/src/Calc/Wasm/Types.hs

@@ -39,4 +39,6 @@ data WasmExpr
   | WIf WasmExpr WasmExpr WasmExpr
   | WVar Natural
   | WApply Natural [WasmExpr]
+  | WAllocate Natural
+  | WSet WasmExpr [(Natural,WasmExpr)] -- `(1,2)` is WSet (WAllocate 2) [(0, 1),(1, 2)]
   deriving stock (Eq, Ord, Show)

wasm-calc4/test/Test/Wasm/WasmSpec.hs

@@ -10,17 +10,20 @@ import Data.Foldable (traverse_)
 import Data.Text (Text)
 import qualified Language.Wasm.Interpreter as Wasm
 import Test.Hspec
+import Calc.Typecheck.Elaborate
 
 testCompileExpr :: (Text, Wasm.Value) -> Spec
 testCompileExpr (input, result) = it (show input) $ do
   case parseModuleAndFormatError input of
     Left e -> error (show e)
-    Right mod' ->
-      case fromModule mod' of
-        Left e -> error (show e)
-        Right wasmMod -> do
-          resp <- runWasm (moduleToWasm wasmMod)
-          resp `shouldBe` Just [result]
+    Right expr -> case elaborateModule expr of
+          Left typeErr -> error (show typeErr)
+          Right mod' ->
+              case fromModule mod' of
+                Left e -> error (show e)
+                Right wasmMod -> do
+                  resp <- runWasm (moduleToWasm wasmMod)
+                  resp `shouldBe` Just [result]
 
 joinLines :: [Text] -> Text
 joinLines = foldr (\a b -> a <> " " <> b) ""
@@ -48,6 +51,12 @@ spec = do
             ("function increment(a: Integer) { a + 1 } increment(41)", Wasm.VI32 42),
             ("function sum(a: Integer, b: Integer) { a + b } sum(20,22)", Wasm.VI32 42),
             ("function inc(a: Integer) { a + 1 } inc(inc(inc(inc(0))))", Wasm.VI32 4),
+            ( joinLines
+                [ "function ignoreTuple(pair: (Integer, Boolean)) { True }",
+                  "ignoreTuple((1,True))"
+                ],
+              Wasm.VI32 1
+            ),
             ( joinLines
                 [ "function swapIntAndBool(pair: (Integer, Boolean)) { case pair of (a, b) -> (b, a) }",
                   "function fst(pair: (Boolean, Integer)) { case pair of (a,_) -> a }",