[BUGFIXES: generic cata anduced non-functional ios, list cata was not applied when gen cata failed
martin.hofmann@uni-bamberg.de**20100105140221] hunk ./src/Igor2/RuleDevelopment/Cata.hs 14
-import Data.List ((\\))
+import Data.List ((\\), groupBy)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 28
-    gcr <- llogNO gmsg >> genCataArgIs cr >>= mapM (genericCata cr)
-           >>= return . oneOnly . concat
-    if not . null $ gcr then return gcr
-      else llogNO smsg >> mapM (listCata cr) (lstCataArgIs cr)
-           >>= return . oneOnly . concat
+    (genCataArgIs cr >>= gmsg >>= oneOrNone (genericCata cr))
+    `catchError` \e -> llogNO (text e) >>
+    (smsg (lstCataArgIs cr) >>= oneOrNone (listCata cr))
+    `catchError` \_ -> llogNO (text e) >> return []
hunk ./src/Igor2/RuleDevelopment/Cata.hs 34
-    oneOnly ls = case ls of [] -> []; (x:_) -> [x]
-    gmsg = linebreak <> text "Try generic catamorphism"
-    smsg = linebreak <> text "Try special catamorphism on lists"  
+    gmsg i = llogNO ( linebreak <> 
+                      text "Try generic catamorphism for argument indices" <+>
+                      pretty i) >> return i                                       
+    smsg i = llogNO ( linebreak <> text "Try special catamorphism on lists for argument indices" <+>
+                      pretty i) >> return i  
+
+oneOrNone :: (a -> IM b) -> [a] -> IM b
+oneOrNone _ []     = fail "No more applicable!"
+oneOrNone f (x:xs) = f x `catchError` \e -> llogNO (text e) >> oneOrNone f xs
hunk ./src/Igor2/RuleDevelopment/Cata.hs 56
+-- fails if nothing can be found
hunk ./src/Igor2/RuleDevelopment/Cata.hs 62
-     `catchError` \e -> noCata i e >> return [] 
+     `catchError` \e -> noCata i e
hunk ./src/Igor2/RuleDevelopment/Cata.hs 68
-    noCata i e = llogNO (text "Catamorphism not applicable:" <+> 
-                 text "Universal Property not satisfied for argument" <+>
-                 int i <+> text "!" <+> text (show e))
+    noCata i e = fail $ "Catamorphism not applicable for argument " ++ 
+                        (show i) ++ "! Universal Property not satisfied: " ++
+                        (show e)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 88
-     mfns <- mapM (abduceIOs i) parts
+     ios  <- mapM (abduceIOs i) parts
+     mfns <- mapM checkIOs ios >> mapM (addIO . rules) ios
hunk ./src/Igor2/RuleDevelopment/Cata.hs 112
-
+checkIOs :: [Rule] -> IM ()
+checkIOs = mbfail . (all allEqual). (groupBy ((((all $ uncurry equal) . ) . zip) `on` lhs))
+    where
+    mbfail b = if b then return () else fail "Contradiction in abduced IOs: Not a function!"
+    allEqual l = all (uncurry (equal `on` rhs)) $ zip l (tail l)
+    
hunk ./src/Igor2/RuleDevelopment/Cata.hs 122
-abduceIOs :: Int -> [CovrRule] -> IM Name
-abduceIOs i crs = mapM (abduceIO i) crs >>= addIO . rules
+abduceIOs :: Int -> [CovrRule] -> IM [Rule]
+abduceIOs i crs = mapM (abduceIO i) crs 