[BUGFIX: map, filter, foldr didn't work when applied to a specific argument index
martin.hofmann@uni-bamberg.de**20100104103928] hunk ./src/Igor2/RuleDevelopment/ListCata.hs 24
-import Prelude hiding (last)
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 28
-    catchError (checkUniPropAndMkIOs i evi cr >>= mkFoldCall i cr) 
+    catchError (((checkUniPropAndMkIOs i) . (tp $ "EVI" ++ (show i))) evi >>= mkFoldCall i cr . (tp $ "UNIPROP" ++ (show i))) 
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 33
-     
-noFoldCall :: IM [(CovrRules,[Call])]
-noFoldCall = do llogNO (text "ListCata not applicable!" <+>
-                        text "Universal Propertiy not satisfied!")
-                return []
+
+mkFoldCall :: Int -> CovrRule -> (Rule,[Rule]) -> IM [(CovrRules,[Call])]
+mkFoldCall i cr (vr,fios) =  
+    (liftM (:[])) . fromJust . msum $ 
+                        [ mbFilter i cr (vr,fios)
+                        , mbMap i cr (vr,fios)
+                        , Just $ mkFold i cr (vr,fios)
+                        ]
+                             
+noFoldCall :: Int -> IM [(CovrRules,[Call])]
+noFoldCall i = do llogNO (text "ListCata not applicable!" <+>
+                         text "Universal Property for argument" <+> int i <+> text "not satisfied!")
+                  return []
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 51
-    if (not $ all (listAndSameLength i) evi) || (any hasFreeVars ios) || (null ios) then noFoldCall
+    if (not $ all (listAndSameLength i) evi) || (any hasFreeVars ios) || (null ios) then noFoldCall i
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 75
-mkFoldCall :: Int -> CovrRule -> (Rule,[Rule]) -> IM [(CovrRules,[Call])]
-mkFoldCall i cr (vr,fios) = (liftM (:[])) . fromJust . msum $ 
-                        [ mbFilter i cr (vr,fios)
-                        , mbMap i cr (vr,fios)
-                        ,Just $ mkFold i cr (vr,fios)]
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 84
-    case partition (ithArgIsOut i) evi of
+    case partition lastArgIsOut evi of
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 86
-            let fio = (mkFIO False f) 
-                tio = (mkFIO True t) in
-            if  or [not $ hasMapProperty i (bc,evi), null $ on intersect (map lhs) fio tio]
-            -- check filter property, and check if ios are a function
-              then Nothing else Just $ do 
-                llogNO (text "ListCata applicable, 'filter' detected!")
-                afnm  <- addIO . rules $ (++) (mkFIO False f) (mkFIO True t)
+            let fio = nub (mkFIO False f) 
+                tio = nub (mkFIO True t) in
+            if  not (filterApplicable f fio tio) then Nothing 
+              else Just $ do 
+                llogNO (text "ListCata applicable for argument" <+> int i <+> text ", 'filter' detected!")
+                afnm  <- addIO . rules $ (fio ++ tio)
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 115
+    -- check wether a rule is just a projection on the second argument
+    lastArgIsOut r = (last $ lhs r) == (rhs r)
+    filterApplicable f fio tio = and [hasMapProperty (bc,f), null $ (on intersect (map lhs)) fio tio]
+    -- check filter property, i.e. mapProperty on those examples which are not 
+    -- a projection on the last argument, and check if ios are a function.
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 125
--- the second argument of all IOs of fold's argument function 
--- occurs unchanged in the output after a cons 
-    if or [not $ hasMapProperty i (bc,evi), any hasFreeVars ios,  null ios]
-      then Nothing  
-      else Just $ do 
-        llogNO (text "ListCata applicable, 'map' detected!")
+    if not (mapApplicable ios) then Nothing
+      else Just $ do
+        llogNO (text "ListCata applicable for argument" <+> int i <+> text ", 'map' detected!")
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 148
+    mapApplicable ios = and $ [hasMapProperty (bc,evi), all (not . hasFreeVars) ios, not . null $ ios]
+    -- map property satisfied?, none has free variables?, and ios are not empty
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 157
-       default value contains a variable.king simply the rhs of the base case 
+       default value contains a variable. Just taking the rhs of the base case 
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 166
-       We could try to fund a substitution to replace the variable 'a':
+       We could try to find a substitution to replace the variable 'a':
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 194
-        
-    llogNO (text "ListCata applicable, fallback to 'foldr'!")
-    afnm  <- addIO . rules . (map (rmArgsAt usedVarInd))$ ios
+    
+    llogNO (text "ListCata applicable for argument" <+> int i <+> text ", fallback to 'foldr'!")
+    afnm  <- addIO . rules . (map (rmArgsAt usedVarInd)) $ ios
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 208
-    let afExp = foldTAppE ((tConE afnm) afty) $ rmAll usedVarInd $ (butIthArg i) . crul $ cr
+    let afExp = foldTAppE ((tConE afnm) afty) $ (butIthArg i) . crul $ cr
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 223
+       
+{- | Check if the given covered IO examples of a partial rule fulfill the 
+     universal property of fold for the specified argument with index 'i':
+      - there is exactly one I/O defined on the empty list
+      - all IOs are closed
+-}
+checkUniPropAndMkIOs :: Int -> [CovrRule] -> IM (Rule,[Rule])
+checkUniPropAndMkIOs i evi = do
+    (r,rs) <- definedOnNil i evi
+    rs'    <- mapM (abduceIO i evi) rs 
+    return (crul r,rs')
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 235
-{-| If the given IO exmaples are defined on for the empty list, a tuple
+{-| If the given IO examples are defined for the empty list, a tuple
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 239
-definedOnNil i = maybeStripNil . partition (hasNilIn . (ithArg i) . crul)
-
-maybeStripNil :: (Monad m) => ([CovrRule], [CovrRule]) -> m (CovrRule,[CovrRule])
-maybeStripNil (l1, l2) =  headM l1 >>= return . flip (,) l2 
+definedOnNil i = exactly1Base . partition (isNilList . (ithArg i) . crul)
+    where
+    exactly1Base (l1, l2) =  onlyOne l1 >>= return . flip (,) l2
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 243
-hasNilIn :: TExp -> Bool
-hasNilIn (TListE [] _) = True
-hasNilIn (a@(TAppE _ _ _)) = (\(TConE n _) -> isNil n) $ head . unfoldTAppE $ a
-hasNilIn _             = False   
+    onlyOne [a] = return a
+    onlyOne _   = fail "Not only one"
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 260
--- check wether a rule is just a projection on the second argument
-ithArgIsOut i r = ((lhs r) !! i) == (rhs r)
-
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 261
-
-hasMapProperty :: Int -> (Rule,[Rule]) -> Bool
-hasMapProperty i (bc,evi) = 
-    and [ isNilList . (!!i) . lhs $ bc
-        , isNilList . rhs $ bc
-        , all (ithArgConsed i) evi]
+ 
+{-
+Map Property w.r.t the last argument:
+ - identity on the empty list
+ - for all non-empty lists, the last argument occurs unchanged in the output 
+   after a cons 
+-}
+hasMapProperty :: (Rule,[Rule]) -> Bool
+hasMapProperty (bc,evi) = 
+    and [ isNilList . rhs $ bc , all lastArgConsed evi]
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 274
-    ithArgConsed i r = 
+    lastArgConsed r = 
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 276
-           TListE (x:xs) t -> (lhs r) !! i == TListE xs t
+           TListE (x:xs) t -> (last $ lhs r) == TListE xs t
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 279
-                [TConE n _, _, xs] -> isCons n  && ((lhs r) !! i == xs)
+                [TConE n _, _, xs] -> isCons n  && ((last $ lhs r) == xs)
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 282
-       
-{-|
-
--}
-{- | Check if the given IO examples fulfill the universal property of fold:
-      - they are defined on the empty list
-      - all IOs are closed
-
--}
-checkUniPropAndMkIOs :: Int -> [CovrRule] -> CovrRule -> IM (Rule,[Rule])
-checkUniPropAndMkIOs i evi cr = do
-    (r,rs) <- definedOnNil i evi
-    rs'    <- mapM (abduceIO i evi) rs 
-    return (crul r,rs')
hunk ./src/Syntax/Expressions.hs 202
+isNilList (a@(TAppE _ _ _)) = isNilList .  head . unfoldTAppE $ a
+-- shouldnn't be possible, but doesn't harm either
hunk ./src/Syntax/Expressions.hs 205
+
hunk ./src/Syntax/Ppr.hs 119
-wildIntro :: FunBind -> FunBind                    
+wildIntro :: FunBind -> FunBind      