mirror of
https://github.com/anoma/juvix.git
synced 2024-12-14 08:27:03 +03:00
d6c1a74cec
This pr applies a number of fixes to the new typechecker. The fixes implemented are: 1. When guessing the arity of the body, we properly use the type information of the variables in the patterns. 2. When generating wildcards, we name them properly so that they align with the name in the type signature. 3. When compiling named applications, we inline all clauses of the form `fun : _ := body`. This is a workaround to https://github.com/anoma/juvix/issues/2247 and https://github.com/anoma/juvix/issues/2517 4. I've had to ignore test027 (Church numerals). While the typechecker passes and one can see that the types are correct, there is a lambda where its clauses have different number of patterns. Our goal is to support that in the near future (https://github.com/anoma/juvix/issues/1706). This is the conflicting lambda: ``` mutual num : Nat → Num := λ : Nat → Num {| (zero : Nat) := czero | ((suc n : Nat)) {A} := csuc (num n) {A}} ``` 5. I've added non-trivial a compilation test involving monad transformers.
59 lines
1.8 KiB
Haskell
59 lines
1.8 KiB
Haskell
module Compilation.PositiveNew where
|
|
|
|
import Base
|
|
import Compilation.Base
|
|
import Compilation.Positive qualified as Old
|
|
import Data.HashSet qualified as HashSet
|
|
|
|
root :: Path Abs Dir
|
|
root = relToProject $(mkRelDir "tests/positive")
|
|
|
|
posTest :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> Old.PosTest
|
|
posTest = posTest' EvalAndCompile
|
|
|
|
posTest' :: CompileAssertionMode -> String -> Path Rel Dir -> Path Rel File -> Path Rel File -> Old.PosTest
|
|
posTest' _assertionMode _name rdir rfile routfile =
|
|
let _dir = root <//> rdir
|
|
_file = _dir <//> rfile
|
|
_expectedFile = root <//> routfile
|
|
in Old.PosTest {..}
|
|
|
|
testDescr :: Int -> Old.PosTest -> TestDescr
|
|
testDescr optLevel Old.PosTest {..} =
|
|
TestDescr
|
|
{ _testName = _name,
|
|
_testRoot = _dir,
|
|
_testAssertion =
|
|
Steps $
|
|
let f = set entryPointNewTypeCheckingAlgorithm True
|
|
in compileAssertionEntry f _dir optLevel _assertionMode _file _expectedFile
|
|
}
|
|
|
|
allTestsNoOptimize :: TestTree
|
|
allTestsNoOptimize =
|
|
testGroup
|
|
"New typechecker compilation positive tests (no optimization)"
|
|
(map (mkTest . testDescr 0) (filter (not . isIgnored) (extraTests <> Old.tests)))
|
|
|
|
isIgnored :: Old.PosTest -> Bool
|
|
isIgnored t = HashSet.member (t ^. Old.name) ignored
|
|
|
|
extraTests :: [Old.PosTest]
|
|
extraTests =
|
|
[ Old.posTest
|
|
"Test073: Monad transformers (ReaderT + StateT + Identity)"
|
|
$(mkRelDir "test072")
|
|
$(mkRelFile "ReaderT.juvix")
|
|
$(mkRelFile "out/test072.out")
|
|
]
|
|
|
|
ignored :: HashSet String
|
|
ignored =
|
|
HashSet.fromList
|
|
[ "Test070: Nested default values and named arguments",
|
|
"Test071: Named application (Ord instance with default cmp)",
|
|
"Test046: Polymorphic type arguments",
|
|
-- TODO allow lambda branches of different number of patterns
|
|
"Test027: Church numerals"
|
|
]
|