added createCategory, dropCategory

This commit is contained in:
krangelov
2021-09-09 17:33:25 +02:00
parent a44787fc4e
commit f7aad0c0e0
12 changed files with 141 additions and 25 deletions

View File

@@ -6,13 +6,15 @@ main = do
gr1 <- readPGF "tests/basic.pgf"
let Just ty = readType "(N -> N) -> P (s z)"
gr2 <- modifyPGF gr1 (createFunction "foo" ty pi)
gr3 <- branchPGF gr1 "bar_branch" (createFunction "bar" ty pi)
gr2 <- modifyPGF gr1 (createFunction "foo" ty pi >>
createCategory "Q" [(Explicit,"x",ty)] pi)
gr3 <- branchPGF gr1 "bar_branch" (createFunction "bar" ty pi >>
createCategory "R" [(Explicit,"x",ty)] pi)
Just gr4 <- checkoutPGF gr1 "master"
Just gr5 <- checkoutPGF gr1 "bar_branch"
gr6 <- modifyPGF gr1 (dropFunction "ind")
gr6 <- modifyPGF gr1 (dropFunction "ind" >> dropCategory "S")
runTestTTAndExit $
TestList $
@@ -21,7 +23,13 @@ main = do
,TestCase (assertEqual "branched functions" ["bar","c","ind","s","z"] (functions gr3))
,TestCase (assertEqual "checked-out extended functions" ["c","foo","ind","s","z"] (functions gr4))
,TestCase (assertEqual "checked-out branched functions" ["bar","c","ind","s","z"] (functions gr5))
,TestCase (assertEqual "original categories" ["Float","Int","N","P","S","String"] (categories gr1))
,TestCase (assertEqual "extended categories" ["Float","Int","N","P","Q","S","String"] (categories gr2))
,TestCase (assertEqual "branched categories" ["Float","Int","N","P","R","S","String"] (categories gr3))
,TestCase (assertEqual "Q context" [(Explicit,"x",ty)] (categoryContext gr2 "Q"))
,TestCase (assertEqual "R context" [(Explicit,"x",ty)] (categoryContext gr3 "R"))
,TestCase (assertEqual "reduced functions" ["c","s","z"] (functions gr6))
,TestCase (assertEqual "reduced categories" ["Float","Int","N","P","String"] (categories gr6))
,TestCase (assertEqual "old function type" Nothing (functionType gr1 "foo"))
,TestCase (assertEqual "new function type" (Just ty) (functionType gr2 "foo"))
,TestCase (assertEqual "old function prob" (-log 0) (functionProb gr1 "foo"))