check circularities in ln

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

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

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