mirror of
https://github.com/anoma/juvix.git
synced 2024-12-15 10:03:22 +03:00
90a7a5e7e0
Previously we were: * discarding the types table * discarding the name ids state after processing an expression in the REPL. For example evaluating: ``` let even : _; odd : _; odd zero := false; odd (suc n) := not (even n); even zero := true; even (suc n) := not (odd n) in even 10 ``` would loop in the REPL. We noticed that the `n` in `suc n` was being given type `Type` instead of `Nat`. This was because the name id given to n was incorrect, the REPL started using name ids from 0 again. We fixed this issue by storing information, including the types table and name ids state in the Artifacts data structure that is returned when we run the pipeline for the first time. This information is then used when we call functions to compile / type check REPL expressions. --------- Co-authored-by: Paul Cadman <git@paulcadman.dev>
90 lines
2.8 KiB
Haskell
90 lines
2.8 KiB
Haskell
module Reachability.Positive where
|
|
|
|
import Base
|
|
import Data.HashSet qualified as HashSet
|
|
import Juvix.Compiler.Internal.Language qualified as Internal
|
|
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context qualified as Internal
|
|
import Juvix.Compiler.Pipeline
|
|
|
|
data PosTest = PosTest
|
|
{ _name :: String,
|
|
_relDir :: Path Rel Dir,
|
|
_stdlibMode :: StdlibMode,
|
|
_file :: Path Rel File,
|
|
_reachable :: HashSet String
|
|
}
|
|
|
|
makeLenses ''PosTest
|
|
|
|
root :: Path Abs Dir
|
|
root = relToProject $(mkRelDir "tests/positive")
|
|
|
|
testDescr :: PosTest -> TestDescr
|
|
testDescr PosTest {..} =
|
|
let tRoot = root <//> _relDir
|
|
file' = tRoot <//> _file
|
|
in TestDescr
|
|
{ _testName = _name,
|
|
_testRoot = tRoot,
|
|
_testAssertion = Steps $ \step -> do
|
|
let noStdlib = _stdlibMode == StdlibExclude
|
|
entryPoint =
|
|
(defaultEntryPoint tRoot file')
|
|
{ _entryPointRoot = tRoot,
|
|
_entryPointNoStdlib = noStdlib
|
|
}
|
|
|
|
step "Pipeline up to reachability"
|
|
p :: Internal.InternalTypedResult <- snd <$> runIO' entryPoint upToInternalReachability
|
|
|
|
step "Check reachability results"
|
|
let names = concatMap getNames (p ^. Internal.resultModules)
|
|
mapM_ check names
|
|
}
|
|
where
|
|
check n = assertBool ("unreachable not filtered: " ++ unpack n) (HashSet.member (unpack n) _reachable)
|
|
|
|
getNames :: Internal.Module -> [Text]
|
|
getNames m = concatMap getDeclName (m ^. (Internal.moduleBody . Internal.moduleStatements))
|
|
where
|
|
getDeclName :: Internal.Statement -> [Text]
|
|
getDeclName = \case
|
|
Internal.StatementInductive i -> [i ^. (Internal.inductiveName . Internal.nameText)]
|
|
Internal.StatementFunction (Internal.MutualBlock f) -> map (^. Internal.funDefName . Internal.nameText) (toList f)
|
|
Internal.StatementAxiom ax -> [ax ^. (Internal.axiomName . Internal.nameText)]
|
|
Internal.StatementInclude i -> getNames (i ^. Internal.includeModule)
|
|
|
|
allTests :: TestTree
|
|
allTests =
|
|
testGroup
|
|
"Reachability positive tests"
|
|
(map (mkTest . testDescr) tests)
|
|
|
|
tests :: [PosTest]
|
|
tests =
|
|
[ PosTest
|
|
"Reachability with modules"
|
|
$(mkRelDir "Reachability")
|
|
StdlibInclude
|
|
$(mkRelFile "M.juvix")
|
|
( HashSet.fromList
|
|
["f", "g", "h", "Bool", "Maybe"]
|
|
),
|
|
PosTest
|
|
"Reachability with modules and standard library"
|
|
$(mkRelDir "Reachability")
|
|
StdlibInclude
|
|
$(mkRelFile "N.juvix")
|
|
( HashSet.fromList
|
|
["test", "Unit", "Bool", "Nat"]
|
|
),
|
|
PosTest
|
|
"Reachability with public imports"
|
|
$(mkRelDir "Reachability")
|
|
StdlibInclude
|
|
$(mkRelFile "O.juvix")
|
|
( HashSet.fromList
|
|
["f", "g", "h", "k", "Bool", "Maybe", "Nat"]
|
|
)
|
|
]
|