From ad1d5ecb0d7a6d64526c02da20bda9c6fa22db29 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Mon, 4 Dec 2023 23:44:59 +0000 Subject: [PATCH] Start actually allocating oh no --- wasm-calc4/src/Calc/Wasm/FromExpr.hs | 25 ++++++++++++++++++++++--- wasm-calc4/src/Calc/Wasm/Helpers.hs | 10 ++++++++++ wasm-calc4/src/Calc/Wasm/ToWasm.hs | 9 ++++++++- wasm-calc4/src/Calc/Wasm/Types.hs | 2 ++ wasm-calc4/test/Test/Wasm/WasmSpec.hs | 21 +++++++++++++++------ 5 files changed, 57 insertions(+), 10 deletions(-) create mode 100644 wasm-calc4/src/Calc/Wasm/Helpers.hs diff --git a/wasm-calc4/src/Calc/Wasm/FromExpr.hs b/wasm-calc4/src/Calc/Wasm/FromExpr.hs index 2ffe6ddf..e0993d3b 100644 --- a/wasm-calc4/src/Calc/Wasm/FromExpr.hs +++ b/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 diff --git a/wasm-calc4/src/Calc/Wasm/Helpers.hs b/wasm-calc4/src/Calc/Wasm/Helpers.hs new file mode 100644 index 00000000..10965b94 --- /dev/null +++ b/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 + diff --git a/wasm-calc4/src/Calc/Wasm/ToWasm.hs b/wasm-calc4/src/Calc/Wasm/ToWasm.hs index 63a42694..381cd3e4 100644 --- a/wasm-calc4/src/Calc/Wasm/ToWasm.hs +++ b/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 diff --git a/wasm-calc4/src/Calc/Wasm/Types.hs b/wasm-calc4/src/Calc/Wasm/Types.hs index 57c3ac7c..bb8a48d3 100644 --- a/wasm-calc4/src/Calc/Wasm/Types.hs +++ b/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) diff --git a/wasm-calc4/test/Test/Wasm/WasmSpec.hs b/wasm-calc4/test/Test/Wasm/WasmSpec.hs index a8f8afa7..08802214 100644 --- a/wasm-calc4/test/Test/Wasm/WasmSpec.hs +++ b/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 }",