From b651aa0ac7279e1ab8d38cfa3d59de354e8c76a8 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Mon, 23 Dec 2024 00:11:47 +0000 Subject: [PATCH 1/3] Need to find a tidy way to test these automatically --- wasm-calc12/src/Calc/Typecheck/Generalise.hs | 2 +- wasm-calc12/test/static/lambda.calc | 39 +++++++++++++++++++- 2 files changed, 39 insertions(+), 2 deletions(-) diff --git a/wasm-calc12/src/Calc/Typecheck/Generalise.hs b/wasm-calc12/src/Calc/Typecheck/Generalise.hs index 43712377..1a7260dc 100644 --- a/wasm-calc12/src/Calc/Typecheck/Generalise.hs +++ b/wasm-calc12/src/Calc/Typecheck/Generalise.hs @@ -48,6 +48,6 @@ generaliseInternal fresh (TVar ann var) = case M.lookup var fresh of Just nat -> TUnificationVar ann nat - Nothing -> error "oh no generalise error" + Nothing -> error $ "Could not find var " <> show var <> " to generalise it" generaliseInternal fresh other = mapType (generaliseInternal fresh) other diff --git a/wasm-calc12/test/static/lambda.calc b/wasm-calc12/test/static/lambda.calc index 3121af8f..fa3787c1 100644 --- a/wasm-calc12/test/static/lambda.calc +++ b/wasm-calc12/test/static/lambda.calc @@ -6,4 +6,41 @@ function main() -> Int64 { let g = \() -> Boolean { False}; let a = f(100, 2, 3); if g() then a else 200 -} \ No newline at end of file +} + +type Maybe + = Just(a) + | Nothing + +type Booly + = No + | Yeah + +function isTrue(booly: Booly) -> Boolean { + case booly { Yeah -> True, No -> False } +} + +function mapMaybe( + maybe: Maybe(a), fn: Fn(a) -> b +) -> Maybe(b) { + case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing } +} + +function orDefault(maybe: Maybe(a), default: a) -> a { + case maybe { Just(a) -> a, Nothing -> default } +} + +test nice = + { + isTrue( + orDefault( + mapMaybe( + Just(No), + \(bool:Booly) -> Booly { + case bool { Yeah -> No, No -> Yeah } + } + ), + No + ) + ) + } \ No newline at end of file From 92b8b28af15c7f1a480eca0bce01499c5adae93c Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Mon, 23 Dec 2024 22:01:20 +0000 Subject: [PATCH 2/3] Closer --- wasm-calc12/src/Calc/Wasm/FromExpr/Expr.hs | 8 +- wasm-calc12/src/Calc/Wasm/FromExpr/Helpers.hs | 5 +- wasm-calc12/test/Test/Wasm/WasmSpec.hs | 77 ++++++++++--------- wasm-calc12/test/static/lambda.calc | 49 ++---------- wasm-calc12/test/static/lambda2.calc | 24 ++++++ wasm-calc12/test/static/lambda3.calc | 13 ++++ wasm-calc12/test/static/lambda4.calc | 25 ++++++ wasm-calc12/test/static/lambda5.calc | 25 ++++++ 8 files changed, 141 insertions(+), 85 deletions(-) create mode 100644 wasm-calc12/test/static/lambda2.calc create mode 100644 wasm-calc12/test/static/lambda3.calc create mode 100644 wasm-calc12/test/static/lambda4.calc create mode 100644 wasm-calc12/test/static/lambda5.calc diff --git a/wasm-calc12/src/Calc/Wasm/FromExpr/Expr.hs b/wasm-calc12/src/Calc/Wasm/FromExpr/Expr.hs index 23b7fdde..65f9c542 100644 --- a/wasm-calc12/src/Calc/Wasm/FromExpr/Expr.hs +++ b/wasm-calc12/src/Calc/Wasm/FromExpr/Expr.hs @@ -226,7 +226,7 @@ fromLambda args returnTy body = do allArgs = wasmArgs <> [("_env", Pointer)] moreArgs = allArgs <> capturedArgs - wasmBody <- withArgs moreArgs (fromExpr body) + (wasmBody, lambdaLocals) <- withArgs moreArgs (fromExpr body) let envOffset = fromIntegral $ length wasmArgs @@ -259,7 +259,7 @@ fromLambda args returnTy body = do wfPublic = False, wfArgs = snd <$> allArgs, wfReturnType = wasmReturnType, - wfLocals = snd <$> capturedArgs, -- captured args will be destructed as vars + wfLocals = (snd <$> lambdaLocals) <> (snd <$> capturedArgs), -- captured args will be destructed as vars wfAbilities = mempty } @@ -385,12 +385,12 @@ fromApply fnExpr args = do EVar _ (Identifier ident) -> do -- maybe it's a function (fIndex, fGenerics, fArgTypes) <- lookupFunction (FunctionName ident) - let types = + let argTypes = monomorphiseTypes fGenerics fArgTypes (void . fst . getOuterAnnotation <$> args) - dropArgs <- traverse (dropFunctionForType . snd) types + dropArgs <- traverse (dropFunctionForType . snd) argTypes wasmArgs <- traverse fromExpr args let allArgs = wasmArgs <> dropArgs pure (TopLevelFunction (WApply fIndex allArgs)) diff --git a/wasm-calc12/src/Calc/Wasm/FromExpr/Helpers.hs b/wasm-calc12/src/Calc/Wasm/FromExpr/Helpers.hs index d7be74e2..9c678b9c 100644 --- a/wasm-calc12/src/Calc/Wasm/FromExpr/Helpers.hs +++ b/wasm-calc12/src/Calc/Wasm/FromExpr/Helpers.hs @@ -79,14 +79,15 @@ addLocal maybeIdent ty = do -- save old args -- do things with provided args -- put old args back -withArgs :: (MonadState FromExprState m) => [(Identifier, WasmType)] -> m a -> m a +withArgs :: (MonadState FromExprState m) => [(Identifier, WasmType)] -> m a -> m (a, [(Maybe Identifier, WasmType)]) withArgs args action = do oldArgs <- gets fesArgs oldVars <- gets fesVars modify (\fes -> fes {fesArgs = args, fesVars = mempty}) result <- action + newVars <- gets fesVars modify (\fes -> fes {fesArgs = oldArgs, fesVars = oldVars}) - pure result + pure (result, newVars) lookupGlobal :: ( MonadError FromWasmError m, diff --git a/wasm-calc12/test/Test/Wasm/WasmSpec.hs b/wasm-calc12/test/Test/Wasm/WasmSpec.hs index 37498b9c..4682a1d1 100644 --- a/wasm-calc12/test/Test/Wasm/WasmSpec.hs +++ b/wasm-calc12/test/Test/Wasm/WasmSpec.hs @@ -15,11 +15,13 @@ import qualified Calc.Wasm.FromExpr.Module as FromExpr import Calc.Wasm.Run import qualified Calc.Wasm.ToWasm as ToWasm import Control.Monad.IO.Class +import Data.Bifunctor (second) import qualified Data.ByteString.Lazy as LB import Data.FileEmbed import Data.Foldable (traverse_) import Data.Hashable (hash) import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Language.Wasm.Interpreter as Wasm import qualified Language.Wasm.Structure as Wasm import System.IO.Temp @@ -27,6 +29,11 @@ import Test.Helpers import Test.Hspec import Test.RunNode +-- these are saved in a file that is included in compilation +testInputs :: [(FilePath, T.Text)] +testInputs = + fmap (second T.decodeUtf8) $(makeRelativeToProject "test/static/" >>= embedDir) + spec :: Spec spec = do describe "WasmSpec" $ do @@ -487,43 +494,41 @@ spec = do describe "Run tests" $ do let testVals = - [ ( "test result = True", - [("result", True)] - ), - ( joinLines - [ "import my.import as myImport(x: Int64) -> Void", - "test dontExplodePlease = True" - ], - [ ( "dontExplodePlease", - True - ) - ] - ), - ( joinLines - [ "import my.import as myImport(x: Int64) -> Void", - "export function usesImport() -> Void { myImport(100) }", - "test dontExplodePlease = True" - ], - [ ( "dontExplodePlease", - True - ) - ] - ), - ( joinLines - [ "import my.import as myImport(x: Int64) -> Void", - "export function usesImport() -> Void { myImport(100) }", - "function returnTrue() -> Boolean { True }", - "test dontExplodePlease = { returnTrue() }" - ], - [ ( "dontExplodePlease", - True - ) - ] + [ ( "basic", + ( "test result = True" + ) + ), + ( "imports", + ( joinLines + [ "import my.import as myImport(x: Int64) -> Void", + "test dontExplodePlease = True" + ] + ) + ), + ( "use import", + ( joinLines + [ "import my.import as myImport(x: Int64) -> Void", + "export function usesImport() -> Void { myImport(100) }", + "test dontExplodePlease = True" + ] + ) + ), + ( "use function", + ( joinLines + [ "import my.import as myImport(x: Int64) -> Void", + "export function usesImport() -> Void { myImport(100) }", + "function returnTrue() -> Boolean { True }", + "test dontExplodePlease = { returnTrue() }" + ] + ) ) ] describe "From tests" $ do - traverse_ runTestsWithInterpreter testVals + traverse_ (uncurry runTestsWithInterpreter) testVals + + describe "Tests in files" $ do + traverse_ (uncurry runTestsWithInterpreter) testInputs -- these are saved in a file that is included in compilation testJSSource :: LB.ByteString @@ -594,8 +599,8 @@ testDeallocation (input, _) = it (show input) $ do -- | in fear of getting incredibly meta, run the tests from this module -- using the built-in `wasm` interpreter -runTestsWithInterpreter :: (T.Text, [(T.Text, Bool)]) -> Spec -runTestsWithInterpreter (input, result) = it (show input) $ do +runTestsWithInterpreter :: FilePath -> T.Text -> Spec +runTestsWithInterpreter title input = it (show title) $ do case parseModuleAndFormatError input of Left e -> error (show e) Right parsedModuleItems -> @@ -605,7 +610,7 @@ runTestsWithInterpreter (input, result) = it (show input) $ do Left typeErr -> error (show typeErr) Right typedMod -> do resp <- testModule typedMod - resp `shouldBe` result + traverse_ (\(_, result) -> result `shouldBe` True) resp -- | output actual WASM files for testing -- test them with node diff --git a/wasm-calc12/test/static/lambda.calc b/wasm-calc12/test/static/lambda.calc index fa3787c1..bdc44c3d 100644 --- a/wasm-calc12/test/static/lambda.calc +++ b/wasm-calc12/test/static/lambda.calc @@ -1,46 +1,9 @@ -function main() -> Int64 { - let f = \(a:Int64, b:Int64, c:Int64) -> Int64 { - let total = a + 100; - total + 1 + b + c +function useFlip() -> Boolean { + let fn = \(b:Boolean) -> Boolean { + if b then False else True }; - let g = \() -> Boolean { False}; - let a = f(100, 2, 3); - if g() then a else 200 + fn(False) } -type Maybe - = Just(a) - | Nothing - -type Booly - = No - | Yeah - -function isTrue(booly: Booly) -> Boolean { - case booly { Yeah -> True, No -> False } -} - -function mapMaybe( - maybe: Maybe(a), fn: Fn(a) -> b -) -> Maybe(b) { - case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing } -} - -function orDefault(maybe: Maybe(a), default: a) -> a { - case maybe { Just(a) -> a, Nothing -> default } -} - -test nice = - { - isTrue( - orDefault( - mapMaybe( - Just(No), - \(bool:Booly) -> Booly { - case bool { Yeah -> No, No -> Yeah } - } - ), - No - ) - ) - } \ No newline at end of file +test flip = + { useFlip() } \ No newline at end of file diff --git a/wasm-calc12/test/static/lambda2.calc b/wasm-calc12/test/static/lambda2.calc new file mode 100644 index 00000000..9dfc93e4 --- /dev/null +++ b/wasm-calc12/test/static/lambda2.calc @@ -0,0 +1,24 @@ +type YesOrNo + = No + | Yes + +type Maybe + = Just(a) + | Nothing + +function mapMaybe( + maybe: Maybe(Boolean), fn: Fn(Boolean) -> Boolean +) -> Maybe(Boolean) { + case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing } +} + +function useMapMaybe() -> Boolean { + let fn = \(b:Boolean) -> Boolean { + if b then False else True + }; + let result = mapMaybe(Just(False), fn); + case result { Just(True) -> True, _ -> False } +} + +test useMapMaybe = + { useMapMaybe() } \ No newline at end of file diff --git a/wasm-calc12/test/static/lambda3.calc b/wasm-calc12/test/static/lambda3.calc new file mode 100644 index 00000000..fad6e762 --- /dev/null +++ b/wasm-calc12/test/static/lambda3.calc @@ -0,0 +1,13 @@ +type YesOrNo + = No + | Yes + +function useDataTypeInLambda() -> Boolean { + let fn = \(b:YesOrNo) -> YesOrNo { + case b { Yes -> No, No -> Yes } + }; + True +} + +test useDataTypeInLambda = + { useDataTypeInLambda() } \ No newline at end of file diff --git a/wasm-calc12/test/static/lambda4.calc b/wasm-calc12/test/static/lambda4.calc new file mode 100644 index 00000000..ee314523 --- /dev/null +++ b/wasm-calc12/test/static/lambda4.calc @@ -0,0 +1,25 @@ +type YesOrNo + = No + | Yes + +type Maybe + = Just(a) + | Nothing + +function mapMaybe( + maybe: Maybe(YesOrNo), fn: Fn(YesOrNo) -> YesOrNo +) -> Maybe(YesOrNo) { + case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing } +} + +function useDataTypeInLambda() -> Boolean { + let fn = \(b:YesOrNo) -> YesOrNo { + case b { Yes -> No, No -> Yes } + }; + case mapMaybe(Just(No), fn) { + Just(Yes) -> True, _ -> False + } +} + +test useDataTypeInLambda = + { useDataTypeInLambda() } \ No newline at end of file diff --git a/wasm-calc12/test/static/lambda5.calc b/wasm-calc12/test/static/lambda5.calc new file mode 100644 index 00000000..10345360 --- /dev/null +++ b/wasm-calc12/test/static/lambda5.calc @@ -0,0 +1,25 @@ +type YesOrNo + = No + | Yes + +type Maybe + = Just(a) + | Nothing + +function mapMaybe( + maybe: Maybe(a), fn: Fn(a) -> b +) -> Maybe(b) { + case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing } +} + +function useDataTypeInLambda() -> Boolean { + let fn = \(b:YesOrNo) -> YesOrNo { + case b { Yes -> No, No -> Yes } + }; + case mapMaybe(Just(No), fn) { + Just(Yes) -> True, _ -> False + } +} + +test useDataTypeInLambda = + { useDataTypeInLambda() } From f624a3100b13f992e0ee39cbe179b45134e213b3 Mon Sep 17 00:00:00 2001 From: Daniel Harvey Date: Mon, 23 Dec 2024 22:28:35 +0000 Subject: [PATCH 3/3] Output ast --- wasm-calc12/src/Calc/Test.hs | 3 ++- wasm-calc12/test/Test/Wasm/WasmSpec.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/wasm-calc12/src/Calc/Test.hs b/wasm-calc12/src/Calc/Test.hs index 0be7186b..17e14bba 100644 --- a/wasm-calc12/src/Calc/Test.hs +++ b/wasm-calc12/src/Calc/Test.hs @@ -7,6 +7,7 @@ module Calc.Test (testModule) where import Calc.Dependencies import Calc.Types import Calc.Types.ModuleAnnotations +import Calc.Utils import Calc.Wasm.FromExpr.Module import Calc.Wasm.Run (runWasm) import Calc.Wasm.ToWasm.Helpers @@ -28,7 +29,7 @@ testModule typedMod@(Module {mdTests}) = -- internal error, explode without grace error (show err) Right wasmMod -> do - let wasm = moduleToWasm wasmMod + let wasm = moduleToWasm (ltrace "wasmmod" wasmMod) traverse ( \wt@WasmTest {wtName} -> do result <- runWasm (TL.fromStrict (testName wt)) wasm diff --git a/wasm-calc12/test/Test/Wasm/WasmSpec.hs b/wasm-calc12/test/Test/Wasm/WasmSpec.hs index 4682a1d1..440dfe7b 100644 --- a/wasm-calc12/test/Test/Wasm/WasmSpec.hs +++ b/wasm-calc12/test/Test/Wasm/WasmSpec.hs @@ -527,7 +527,7 @@ spec = do describe "From tests" $ do traverse_ (uncurry runTestsWithInterpreter) testVals - describe "Tests in files" $ do + fdescribe "Tests in files" $ do traverse_ (uncurry runTestsWithInterpreter) testInputs -- these are saved in a file that is included in compilation