GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-24 02:12:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

(gftest) Multiple concrete categories for context generation

Browse Source
This commit is contained in:
Inari Listenmaa
2018-05-22 11:49:42 +01:00
parent b635cb3d52
commit 10df5a7269
1 changed files with 7 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
src/tools/gftest/Grammar.hs
View File

@@ -990,10 +990,7 @@ testFun debug gr trans startcat funname =
if debug then tp { ctyp = (fst $ ctyp tp, coe)} else tp if debug then tp { ctyp = (fst $ ctyp tp, coe)} else tp
] ]
-- Usually start category is a single {s:Str}, i.e. only one concrete category. starts = ccats gr startcat
-- If you try this out for start categories with more parameters and fields,
-- you probably get wrong or missing results.
(start:_) = ccats gr startcat
hl f c1 c2 = f (c1 dummyHole) == f (c2 dummyHole) hl f c1 c2 = f (c1 dummyHole) == f (c2 dummyHole)
-- applyHole = hl id -- TODO why doesn't this work for equality of contexts? -- applyHole = hl id -- TODO why doesn't this work for equality of contexts?
@@ -1007,16 +1004,18 @@ testFun debug gr trans startcat funname =
[ (goalcat,(testcase,ctxs)) [ (goalcat,(testcase,ctxs))
| testcase <- treesUsingFun gr funs | testcase <- treesUsingFun gr funs
, let goalcat = ccatOf testcase -- never a coercion (coercions can't be goals) , let goalcat = ccatOf testcase -- never a coercion (coercions can't be goals)
, let ctxs = contextsFor gr start goalcat ] :: M.Map ConcrCat (Tree,[Tree->Tree]) , let ctxs = [ ctx | st <- starts
, ctx <- contextsFor gr st goalcat ]
] :: M.Map ConcrCat (Tree,[Tree->Tree])
goalcats = M.keys cat_testcase_ctxs goalcats = M.keys cat_testcase_ctxs
coercion_goalcats_commonCtxs = coercion_goalcats_commonCtxs =
[ (coe,coveredGoalcats,ctxs) [ (coe,coveredGoalcats,ctxs)
| coe@(CC Nothing _) <- S.toList $ nonEmptyCats gr -- only coercions | coe@(CC Nothing _) <- S.toList $ nonEmptyCats gr -- only coercions
, let coveredGoalcats = filter (coerces gr coe) goalcats , let coveredGoalcats = filter (coerces gr coe) goalcats
, let ctxs = [ ctx -- Contexts that have , let ctxs = [ ctx | st <- starts -- Contexts that have
| ctx <- contextsFor gr start coe -- a) hole of coercion, and are , ctx <- contextsFor gr st coe -- a) hole of coercion, and are
, any (applyHole ctx) allCtxs ] -- b) relevant for the function we test , any (applyHole ctx) allCtxs ] -- b) relevant for the function we test
, length coveredGoalcats >= 2 -- no use if the coercion covers 0 or 1 categories , length coveredGoalcats >= 2 -- no use if the coercion covers 0 or 1 categories
, not $ null ctxs ] , not $ null ctxs ]