GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-20 10:19:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

pretty printing for expressions and types

Browse Source
This commit is contained in:
krangelov
2021-08-26 15:46:16 +02:00
parent 07bda06fb2
commit 275addfcbe
11 changed files with 572 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
src/runtime/haskell/tests/basic.hs
View File

@@ -4,10 +4,11 @@ import PGF2
main = do
x <- testLoadFailure "non-existing.pgf"
x <- testLoadFailure "tests/basic.gf"
y <- testLoadFailure "tests/basic.gf"
gr <- readPGF "tests/basic.pgf"
runTestTTAndExit $
TestList [TestCase (assertBool "loading failure handled" x)
TestList [TestCase (assertBool "missing file" x)
,TestCase (assertBool "frong file format" y)
,TestCase (assertEqual "abstract names" "basic" (abstractName gr))
,TestCase (assertEqual "abstract categories" ["Float","Int","N","P","S","String"] (categories gr))
,TestCase (assertEqual "abstract functions" ["c","ind","s","z"] (functions gr))
@@ -18,13 +19,46 @@ main = do
,TestCase (assertBool "type of s" (eqJust (readType "N->N") (functionType gr "s")))
,TestCase (assertBool "type of c" (eqJust (readType "N->S") (functionType gr "c")))
,TestCase (assertEqual "category context 1" [] (categoryContext gr "N"))
,TestCase (assertEqual "category context 1" [] (categoryContext gr "S"))
,TestCase (assertEqual "category context 1" [(Explicit,"_",DTyp [] "N" [])] (categoryContext gr "P"))
,TestCase (assertEqual "category context 1" [] (categoryContext gr "X")) -- no such category
,TestCase (assertEqual "category context 2" [] (categoryContext gr "S"))
,TestCase (assertEqual "category context 3" [(Explicit,"_",DTyp [] "N" [])] (categoryContext gr "P"))
,TestCase (assertEqual "category context 4" [] (categoryContext gr "X")) -- no such category
,TestCase (assertEqual "function is constructor 1" True (functionIsConstructor gr "s"))
,TestCase (assertEqual "function is constructor 2" True (functionIsConstructor gr "z"))
,TestCase (assertEqual "function is constructor 3" True (functionIsConstructor gr "c"))
,TestCase (assertEqual "function is constructor 4" False (functionIsConstructor gr "ind"))
,TestCase (assertEqual "show expression 1" "f x y" (showExpr [] (EApp (EApp (EFun "f") (EFun "x")) (EFun "y"))))
,TestCase (assertEqual "show expression 2" "f (g x)" (showExpr [] (EApp (EFun "f") (EApp (EFun "g") (EFun "x")))))
,TestCase (assertEqual "show expression 3" "f {g x}" (showExpr [] (EApp (EFun "f") (EImplArg (EApp (EFun "g") (EFun "x"))))))
,TestCase (assertEqual "show expression 4" "x" (showExpr ["x"] (EVar 0)))
,TestCase (assertEqual "show expression 5" "#1" (showExpr ["x"] (EVar 1)))
,TestCase (assertEqual "show expression 6" "z" (showExpr ["z","y","x"] (EVar 0)))
,TestCase (assertEqual "show expression 7" "y" (showExpr ["z","y","x"] (EVar 1)))
,TestCase (assertEqual "show expression 8" "\\w->w" (showExpr ["z","y","x"] (EAbs Explicit "w" (EVar 0))))
,TestCase (assertEqual "show expression 9" "\\v,w->z" (showExpr ["z","y","x"] (EAbs Explicit "v" (EAbs Explicit "w" (EVar 2)))))
,TestCase (assertEqual "show expression 10" "\\v,{w}->z" (showExpr ["z","y","x"] (EAbs Explicit "v" (EAbs Implicit "w" (EVar 2)))))
,TestCase (assertEqual "show expression 11" "\\v,{w},z->z" (showExpr ["y","x"] (EAbs Explicit "v" (EAbs Implicit "w" (EAbs Explicit "z" (EVar 0))))))
,TestCase (assertEqual "show expression 12" "\\v,{w,z}->v" (showExpr ["y","x"] (EAbs Explicit "v" (EAbs Implicit "w" (EAbs Implicit "z" (EVar 2))))))
,TestCase (assertEqual "show expression 13" "\\v,{w,z},t->v" (showExpr ["y","x"] (EAbs Explicit "v" (EAbs Implicit "w" (EAbs Implicit "z" (EAbs Explicit "t" (EVar 3)))))))
,TestCase (assertEqual "show expression 14" "\\u,v,{w,z},t->v" (showExpr ["y","x"] (EAbs Explicit "u" (EAbs Explicit "v" (EAbs Implicit "w" (EAbs Implicit "z" (EAbs Explicit "t" (EVar 3))))))))
,TestCase (assertEqual "show expression 15" "f (\\x->x)" (showExpr [] (EApp (EFun "f") (EAbs Explicit "x" (EVar 0)))))
,TestCase (assertEqual "show expression 16" "?" (showExpr [] (EMeta 0)))
,TestCase (assertEqual "show expression 17" "?42" (showExpr [] (EMeta 42)))
,TestCase (assertEqual "show expression 18" "<z : N>" (showExpr [] (ETyped (EFun "z") (DTyp [] "N" []))))
,TestCase (assertEqual "show expression 19" "42" (showExpr [] (ELit (LInt 42))))
,TestCase (assertEqual "show expression 20" "3.14" (showExpr [] (ELit (LFlt 3.14))))
,TestCase (assertEqual "show expression 21" "\"abc\"" (showExpr [] (ELit (LStr "abc"))))
,TestCase (assertEqual "show expression 22" "\"ab\\0c\"" (showExpr [] (ELit (LStr "ab\0c"))))
,TestCase (assertEqual "show expression 23" "\"ab\\nc\"" (showExpr [] (ELit (LStr "ab\nc"))))
,TestCase (assertEqual "show type 1" "N" (showType [] (DTyp [] "N" [])))
,TestCase (assertEqual "show type 2" "N -> N" (showType [] (DTyp [(Explicit,"_",DTyp [] "N" [])] "N" [])))
,TestCase (assertEqual "show type 3" "(N -> N) -> N" (showType [] (DTyp [(Explicit,"_",DTyp [(Explicit,"_",DTyp [] "N" [])] "N" [])] "N" [])))
,TestCase (assertEqual "show type 4" "(x : N) -> P x" (showType [] (DTyp [(Explicit,"x",DTyp [] "N" [])] "P" [EVar 0])))
,TestCase (assertEqual "show type 5" "(f : N -> N) -> P (f z)" (showType [] (DTyp [(Explicit,"f",DTyp [(Explicit,"_",DTyp [] "N" [])] "N" [])] "P" [EApp (EVar 0) (EFun "z")])))
,TestCase (assertEqual "show type 6" "(f : N -> N) -> P (f n)" (showType ["n"] (DTyp [(Explicit,"f",DTyp [(Explicit,"_",DTyp [] "N" [])] "N" [])] "P" [EApp (EVar 0) (EVar 1)])))
,TestCase (assertEqual "show type 7" "({f} : N -> N) -> P (f n)" (showType ["n"] (DTyp [(Implicit,"f",DTyp [(Explicit,"_",DTyp [] "N" [])] "N" [])] "P" [EApp (EVar 0) (EVar 1)])))
,TestCase (assertEqual "fresh variables 1" "\\v,v1->v1" (showExpr [] (EAbs Explicit "v" (EAbs Explicit "v" (EVar 0)))))
,TestCase (assertEqual "fresh variables 2" "\\v,v1->v" (showExpr [] (EAbs Explicit "v" (EAbs Explicit "v" (EVar 1)))))
,TestCase (assertEqual "fresh variables 3" "\\v,v1,v2->v1" (showExpr [] (EAbs Explicit "v" (EAbs Explicit "v" (EAbs Explicit "v" (EVar 1))))))
]
testLoadFailure fpath = do