Report many type errors instead of stopping after the first one

In GF.Compile.CheckGrammar, use a new topological sorting function that
groups independent judgements, allowing them all to be checked before
continuing or reporting errors.

1 files changed, 16 insertions, 2 deletions

diff --git a/src/compiler/GF/Data/Operations.hs b/src/compiler/GF/Data/Operations.hs
index 7b2afc9fe..781f0a133 100644
--- a/src/compiler/GF/Data/Operations.hs
+++ b/src/compiler/GF/Data/Operations.hs
@@ -43,7 +43,7 @@ module GF.Data.Operations (-- * misc functions
 		   combinations,
 
 		   -- * topological sorting with test of cyclicity
-		   topoTest, 
+		   topoTest, topoTest2,
 
 		   -- * the generic fix point iterator
 		   iterFix,
@@ -60,7 +60,7 @@ module GF.Data.Operations (-- * misc functions
 		  ) where
 
 import Data.Char (isSpace, toUpper, isSpace, isDigit)
-import Data.List (nub, sortBy, sort, deleteBy, nubBy)
+import Data.List (nub, sortBy, sort, deleteBy, nubBy, partition, (\\))
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Control.Monad (liftM,liftM2, MonadPlus, mzero, mplus)
@@ -267,6 +267,20 @@ combinations t = case t of
 topoTest :: Ord a => [(a,[a])] -> Either [a] [[a]]
 topoTest = topologicalSort . mkRel'
 
+-- | topological sorting with test of cyclicity, new version /TH 2012-06-26
+topoTest2 :: Ord a => [(a,[a])] -> Either [[a]] [[a]]
+topoTest2 g = maybe (Right cycles) Left (tsort g)
+  where
+    cycles = findCycles (mkRel' g)
+
+    tsort nes =
+      case partition (null.snd) nes of
+        ([],[]) -> Just []
+        ([],_) -> Nothing
+        (ns,rest) -> (leaves:) `fmap` tsort [(n,es \\ leaves) | (n,es)<-rest]
+	  where leaves = map fst ns
+
+
 -- | the generic fix point iterator
 iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a]
 iterFix more start = iter start start