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

check circularity in param

Browse Source
This commit is contained in:
aarne
2007-10-12 08:37:57 +00:00
parent 6d765e75ad
commit 674dea6d57
1 changed files with 3 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Compile/CheckGrammar.hs
View File

@@ -1025,17 +1025,19 @@ allOperDependencies m b =
where where
opersIn t = case t of opersIn t = case t of
Q n c | n == m -> [c] Q n c | n == m -> [c]
QC n c | n == m -> [c]
_ -> collectOp opersIn t _ -> collectOp opersIn t
opty (Yes ty) = opersIn ty opty (Yes ty) = opersIn ty
opty _ = [] opty _ = []
pts i = case i of pts i = case i of
ResOper pty pt -> [pty,pt] ResOper pty pt -> [pty,pt]
ResParam (Yes (ps,_)) -> [Yes t | (_,cont) <- ps, (_,t) <- cont]
CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type)) CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type))
_ -> [] ---- ResParam _ -> [] ---- ResParam
topoSortOpers :: [(Ident,[Ident])] -> Err [Ident] topoSortOpers :: [(Ident,[Ident])] -> Err [Ident]
topoSortOpers st = do topoSortOpers st = do
let eops = topoTest st let eops = topoTest (trace (show st) st)
either either
return return
(\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops)))) (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops))))