diff options
| author | Inari Listenmaa <inari.listenmaa@gmail.com> | 2018-05-24 23:40:11 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2018-05-24 23:40:11 +0100 |
| commit | 1e71e18e212e8f1eb628041067bf244d4410ddec (patch) | |
| tree | 3036d9e9f9667cb23b06b8f1952b7c907d3a9aca /src/tools/gftest/Grammar.hs | |
| parent | a2f9d9d8d5a32e2bf1b8126e371b826151903cde (diff) | |
| parent | a0849d8a5a54ef7321c291c0a6e55065f8cf0d5e (diff) | |
(gftest) Add --show-context + combine -o with -f,-c,-b
Added a few new features:
-o OldGrammar.pgf: if combined with -f , -c or -b , only test the specified trees+functions.
--show-context FId: shows contexts for the particular concrete category
--show-cats interacts with --debug by showing also concrete categories
Diffstat (limited to 'src/tools/gftest/Grammar.hs')
| -rw-r--r-- | src/tools/gftest/Grammar.hs | 15 |
1 files changed, 11 insertions, 4 deletions
diff --git a/src/tools/gftest/Grammar.hs b/src/tools/gftest/Grammar.hs index 4e6d0c6e9..0724987b2 100644 --- a/src/tools/gftest/Grammar.hs +++ b/src/tools/gftest/Grammar.hs @@ -9,7 +9,7 @@ module Grammar -- Categories, coercions , ccats, ccatOf, arity , coerces, uncoerce - , uncoerceAbsCat + , uncoerceAbsCat, mkCC -- Testing and comparison , testTree, testFun @@ -17,7 +17,7 @@ module Grammar , treesUsingFun -- Contexts - , contextsFor + , contextsFor, dummyHole -- FEAT , featIth, featCard @@ -327,6 +327,13 @@ toGrammar pgf langName = cseq2Either (I.SymCat x y) = Right (x,y) cseq2Either x = Left (show x) + +mkCC gr fid = CC ccat fid + where ccat = case [ cat | (cat,bg,end,_) <- concrCats gr + , fid `elem` [bg..end] ] of + [] -> Nothing -- means it's coercion + xs -> Just $ the xs + -- parsing and reading trees mkTree :: Grammar -> PGF2.Expr -> Tree mkTree gr = disambTree . ambTree @@ -983,9 +990,9 @@ testFun debug gr trans startcat funname = , let testcases_ctxs = catMaybes [ M.lookup cat cat_testcase_ctxs | cat <- cats ] , not $ null testcases_ctxs - , let fstLen = \(a,_) (b,_) -> length (flatten a) `compare` length (flatten b) + , let fstLen (a,_) (b,_) = length (flatten a) `compare` length (flatten b) , let (App tp subtrees,_) = -- pick smallest test case to be the representative - head $ sortBy fstLen testcases_ctxs + minimumBy fstLen testcases_ctxs , let newTop = -- debug: put coerced contexts under a separate test case if debug then tp { ctyp = (fst $ ctyp tp, coe)} else tp ] |