Need to find a tidy way to test these automatically

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

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

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))

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,

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

@@ -15,18 +15,25 @@
 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
 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 @@
 
     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
+
+      fdescribe "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 @@
 
 -- | 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 @@
           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

wasm-calc12/test/static/lambda.calc

@@ -1,9 +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)
+}
+
+test flip = 
+  { useFlip() }

wasm-calc12/test/static/lambda2.calc

@@ -0,0 +1,24 @@
+type YesOrNo
+  = No
+  | Yes
+
+type Maybe<a>
+  = 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() }

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() }

wasm-calc12/test/static/lambda4.calc

@@ -0,0 +1,25 @@
+type YesOrNo
+  = No
+  | Yes
+
+type Maybe<a>
+  = 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() }

wasm-calc12/test/static/lambda5.calc

@@ -0,0 +1,25 @@
+type YesOrNo
+  = No
+  | Yes
+
+type Maybe<a>
+  = Just(a)
+  | Nothing
+
+function mapMaybe<a,b>(
+  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() }