diff options
Diffstat (limited to 'src/GF')
| -rw-r--r-- | src/GF/Compile/CheckGrammar.hs | 27 | ||||
| -rw-r--r-- | src/GF/Compile/Optimize.hs | 22 | ||||
| -rw-r--r-- | src/GF/Infra/ReadFiles.hs | 2 |
3 files changed, 27 insertions, 24 deletions
diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 5360840c7..d01d2b097 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -20,7 +20,8 @@ -- - tables are type-annotated ----------------------------------------------------------------------------- -module GF.Compile.CheckGrammar (showCheckModule, justCheckLTerm) where +module GF.Compile.CheckGrammar ( + showCheckModule, justCheckLTerm, allOperDependencies, topoSortOpers) where import GF.Grammar.Grammar import GF.Infra.Ident @@ -63,6 +64,7 @@ checkModule ms (name,mod) = checkIn ("checking module" +++ prt name) $ case mod MTResource -> mapMTree (checkResInfo gr) js MTConcrete a -> do + checkErr $ topoSortOpers $ allOperDependencies name js ModMod abs <- checkErr $ lookupModule gr a js1 <- checkCompleteGrammar abs mo mapMTree (checkCncInfo gr name (a,abs)) js1 @@ -853,3 +855,26 @@ linTypeOfType cnc m typ = do ,return defLinType ] +-- | dependency check, detecting circularities and returning topo-sorted list + +allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])] +allOperDependencies m b = + [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b] + where + opersIn t = case t of + Q n c | n == m -> [c] + _ -> collectOp opersIn t + opty (Yes ty) = opersIn ty + opty _ = [] + pts i = case i of + ResOper pty pt -> [pty,pt] + CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type)) + _ -> [] ---- ResParam + +topoSortOpers :: [(Ident,[Ident])] -> Err [Ident] +topoSortOpers st = do + let eops = topoTest st + either + return + (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops)))) + eops diff --git a/src/GF/Compile/Optimize.hs b/src/GF/Compile/Optimize.hs index e68aa4f7d..374c79d01 100644 --- a/src/GF/Compile/Optimize.hs +++ b/src/GF/Compile/Optimize.hs @@ -63,7 +63,6 @@ evalModule oopts ms mo@(name,mod) = case mod of MGrammar (mod' : _) <- foldM evalOp gr ids return $ mod' MTConcrete a -> do - topoSortOpers $ allOperDependencies name js js' <- mapMTree (evalCncInfo oopts gr name a) js ---- <- gr0 6/12/2005 return $ (name, ModMod (Module mt st fs me ops js')) @@ -211,27 +210,6 @@ recordExpand typ trm = case unComputed typ of -- | auxiliaries for compiling the resource -allOperDependencies :: Ident -> BinTree Ident Info -> [(Ident,[Ident])] -allOperDependencies m b = - [(f, nub (concatMap opty (pts i))) | (f,i) <- tree2list b] - where - opersIn t = case t of - Q n c | n == m -> [c] - _ -> collectOp opersIn t - opty (Yes ty) = opersIn ty - opty _ = [] - pts i = case i of - ResOper pty pt -> [pty,pt] - CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type)) - _ -> [] ---- ResParam - -topoSortOpers :: [(Ident,[Ident])] -> Err [Ident] -topoSortOpers st = do - let eops = topoTest st - either - return - (\ops -> Bad ("circular definitions:" +++ unwords (map prt (head ops)))) - eops mkLinDefault :: SourceGrammar -> Type -> Err Term mkLinDefault gr typ = do diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index fcd7093a5..e1e2e06d8 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/src/GF/Infra/ReadFiles.hs @@ -167,7 +167,7 @@ needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where Just ms <- [lookup m allDeps], elem f ms]) || oElem retainOpers opts) -> if elem t [MTyResource,MTyIncResource] - then (f,(path,CSRes)) else + then (f,(path,CSRes)) else if t == MTyIncomplete then (f,(path,CSComp)) else x |