[correct arguments for para-mediators, DRY implementation!
martin.hofmann@uni-bamberg.de**20100811090133] hunk ./src/Igor2/RuleDevelopment/Cata.hs 32
-  tyMorphIdcs cr >>= gmsg >>= oneOrNone (genericCata cr)
+  tyMorphIdcs cr >>= gmsg >>= oneOrNone (genericMorph cr)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 34
-  (\e1 -> llogNO (text e1) >> (smsg (lstCataArgIs cr) >>= oneOrNone (listCata cr)))
+  (\e1 -> llogNO (text e1) >> (smsg (lstCataArgIs cr) >>= 
+                                   oneOrNone (listCata cr)))
hunk ./src/Igor2/RuleDevelopment/Cata.hs 46
-             
+paraIntro :: CovrRule -> IM [(CovrRules,[Call])]
+paraIntro cr = do
+
+    waypointS $ text "Paramorphism Introduction"
+    llogNO $ text "Check if 'para' applies to: " <^> pretty cr    
+    
+    (tyMorphIdcs cr >>= return . ((lstCataArgIs cr)++) >>= 
+                 gmsg >>= oneOrNone (genericMorph cr))
+    `catchError` 
+    \e2 -> llogNO (text e2) >> return []
+    
+    where
+    gmsg i = llogNO ( linebreak <> 
+                      text "Try generic paraemorphism for argument indices" <+>
+                      pretty i) >> return i              
hunk ./src/Igor2/RuleDevelopment/Cata.hs 80
-genericCata :: CovrRule -> Int -> IM [(CovrRules,[Call])]
-genericCata cr i = do 
-    llogNO msg
-    evi   <- breakupM cr
-    (dataTypeName i (crul cr) >>= ctorsOf >>= partByCtors i evi >>= mkCata i cr) 
-     `catchError` \e -> noCata i e
+genericMorph :: CovrRule -> Int -> IM [(CovrRules,[Call])]
+genericMorph cr i = do 
+  para <- usePara
+  llogNO $ msg para
+  evi   <- breakupM cr
+  (dataTypeName i (crul cr) >>= ctorsOf >>= partByCtors i evi >>= mkMorphism  para i cr) 
+  `catchError` \e -> noMorph i e
hunk ./src/Igor2/RuleDevelopment/Cata.hs 88
-    -- data type Name of the th argument of the covering rule
+    -- data type Name of the  argument of the covering rule
hunk ./src/Igor2/RuleDevelopment/Cata.hs 90
-    msg = linebreak <> text "Check argument" <+> 
-          int i <+> text "for general 'cata'!"
-    noCata i e = fail $ "Catamorphism not applicable for argument " ++ 
-                        (show i) ++ "! Universal Property not satisfied: " ++
-                        (show e)
+    msg p = linebreak <> text "Check argument" <+> 
+            int i <+> text "for general morphism:" <+>
+            text (if p then "'para'" else "cata'")
+    noMorph p i e = fail $ (if p then "Para" else "Cata") ++ 
+                           "morphism not applicable for argument " ++ 
+                           (show i) ++ "! Universal Property not satisfied: " ++
+                           (show e)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 112
-mkCata :: Int -> CovrRule -> [[CovrRule]] -> IM [(CovrRules,[Call])]
-mkCata i cr parts = do
---     let crty = arrowTy
+mkCata, mkPara :: Int -> CovrRule -> [[CovrRule]] -> IM [(CovrRules,[Call])]
+mkCata = mkMorphism False 
+mkPara = mkMorphism True     
+
+mkMorphism :: Bool -> Int -> CovrRule -> [[CovrRule]] -> IM [(CovrRules,[Call])]
+mkMorphism para i cr parts = do
hunk ./src/Igor2/RuleDevelopment/Cata.hs 122
-     let fExp = foldTAppE  cataEx [botEx, (mkInfxs mfuns), ithArg i $ crul cr]
+     let fExp = foldTAppE  morphEx [botEx, (mkInfxs mfuns), ithArg i $ crul cr]
hunk ./src/Igor2/RuleDevelopment/Cata.hs 124
-     let clls = map  (\mfn -> (name cr',mfn, LT)) mfns 
-     llogNO $ text "Generic 'cata' applicable on argument" <+> int i
+     let clls = map  (\mfn -> (name cr',mfn, EQ)) mfns 
+     llogNO $ text "Generic" <+> text morphStr <+> 
+              text "applicable on argument" <+> int i
hunk ./src/Igor2/RuleDevelopment/Cata.hs 130
+     morphEx = if para then paraEx else cataEx
+     morphStr = if para then "'para'" else "'cata'"
hunk ./src/Igor2/RuleDevelopment/Cata.hs 143
-        in  tInfixE (tConE '(\/) [lty,rty,ety,last . unArrowT $ rty]) l r 
-     
+        in  tInfixE (tConE '(\/) [lty,rty,ety,last . unArrowT $ rty]) l r             
+            
+            
hunk ./src/Igor2/RuleDevelopment/Cata.hs 161
--- abduce a single example given the index of the cata-argument and the example
--- of the initial rule
+-- abduce a single example given the index of the morphism-argument and the 
+-- example of the initial rule.
hunk ./src/Igor2/RuleDevelopment/Cata.hs 164
-abduceIO i cr = case subterms carg of
-               [] -> return . iorule $ wild
-               -- the cata-arg is a constant constructor with no arguments
-               -- so it is not required for the function and replaced by a 
-               -- wildcard
-               as -> do cargs <- mapM mkCArg as
-                        return . iorule . nestedTupE $ cargs
-               -- the cata-arg is a constructor with at least one argument
+abduceIO i cr = 
+    case subterms carg of
+      [] -> return . iorule $ wild
+           -- the morphism-arg is a constant constructor with no arguments
+           -- so it is not required for the function and replaced by a 
+           -- wildcard
+      as -> usePara >>= \p -> mapM (mkMArg p) as >>= 
+           return . iorule . nestedTupE 
+          -- the morphism-arg is a constructor with at least one argument
hunk ./src/Igor2/RuleDevelopment/Cata.hs 178
-    mkCArg a 
+    mkMArg para a 
hunk ./src/Igor2/RuleDevelopment/Cata.hs 181
-                   maybe (fail "Insufficient support in Examples") (return . id)
+            -- 'simulate recursive call, by evaluating against IOs
+                   maybe (fail "Insufficient support in Examples") (mu para a)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 184
-
+    mu para a ar 
+       | para      = return $ tTupE  [ar,a]
+       -- here happens the paramorphism! Pair of input 'a' and 
+       -- result of recursive call 'ar'
+       | otherwise = return ar
+       -- when cata then we just return the result of the 
+       --recurisve call
hunk ./src/Igor2/RuleDevelopment/Cata.hs 195
--- fails if nothing can be found
-genericPara :: CovrRule -> Int -> IM [(CovrRules,[Call])]
-genericPara cr i = do 
-    llogNO msg
-    evi   <- breakupM cr
-    (dataTypeName i (crul cr) >>= ctorsOf >>= partByCtors i evi >>= mkPara i cr) 
-     `catchError` \e -> noPara i e
-    where
-    -- data type Name of the th argument of the covering rule
-    dataTypeName = ((dataName . typeOf) .) . ithArg
-    msg = linebreak <> text "Check argument" <+> 
-          int i <+> text "for general 'para'!"
-    noPara i e = fail $ "Paramorphism not applicable for argument " ++ 
-                        (show i) ++ "! Universal Property not satisfied: " ++
-                        (show e)
hunk ./src/Igor2/RuleDevelopment/Cata.hs 196
-paraIntro :: CovrRule -> IM [(CovrRules,[Call])]
-paraIntro cr = do
-
-    waypointS $ text "Paramorphism Introduction"
-    llogNO $ text "Check if 'para' applies to: " <^> pretty cr    
-    
-    (tyMorphIdcs cr >>= return . ((lstCataArgIs cr)++) >>= gmsg >>= oneOrNone (genericPara cr))
-    `catchError` 
-    \e2 -> llogNO (text e2) >> return []
-    
-    where
-    gmsg i = llogNO ( linebreak <> 
-                      text "Try generic paraemorphism for argument indices" <+>
-                      pretty i) >> return i             
+            
hunk ./src/Igor2/RuleDevelopment/Cata.hs 198
-abduceParaIOs :: Int -> [CovrRule] -> IM [Rule]
-abduceParaIOs i crs = mapM (abduceParaIO i) crs 
hunk ./src/Igor2/RuleDevelopment/Cata.hs 199
-abduceParaIO :: Int -> CovrRule -> IM Rule 
-abduceParaIO i cr = case subterms carg of
-               [] -> return . iorule $ wild
-               -- the cata-arg is a constant constructor with no arguments
-               -- so it is not required for the function and replaced by a 
-               -- wildcard
-               as -> do cargs <- liftM concat $ mapM mkCArg as
-                        return . iorule . nestedTupE $ (carg:cargs)
-               -- the cata-arg is a constructor with at least one argument
-    where
-    args = butIthArg i $ crul cr
-    carg = ithArg i $ crul cr 
-    wild = tVarE "_x" (typeOf carg)
-    iorule ca = rule (args ++ [ca])(rhs . crul $ cr)
-    mkCArg a 
-        | (typeOf a)==(typeOf carg) = 
-            evalIO (name cr) (insertAt i a args) >>= 
-                   maybe (fail "Insufficient support in Examples") (return . (:[]))
-        | otherwise                 = return []
-                                      
-mkPara :: Int -> CovrRule -> [[CovrRule]] -> IM [(CovrRules,[Call])]
-mkPara i cr parts = do
---     let crty = arrowTy
-     ios  <- mapM (abduceParaIOs i) parts
-     mfns <- mapM checkIOs ios >> mapM (addIO . rules) ios
-     mfcr <- mapM coverAll mfns
-     let mfuns = map (mkMediators (butIthArg i $ crul cr)) mfcr     
-     let fExp = foldTAppE  paraEx [botEx, (mkInfxs mfuns), ithArg i $ crul cr]
-     let cr' = modifycrul cr (\r -> rule (lhs r) fExp)
-     let clls = map  (\mfn -> (name cr',mfn, EQ)) mfns 
-     llogNO $ text "Generic 'para' applicable on argument" <+> int i
-     llogDE $ text "With partitions" <+> pretty parts
-     return [(covrRules (cr':mfcr),clls)]
-     where
-     mkMediators as r = 
-        let fty = (map typeOf) . lhs . crul $ r
-            fex = tConE (name r) fty
-        in foldTAppE fex as
-     mkInfxs [l,r] = 
-        let lty = typeOf l; rty = typeOf r
-            ety = foldAppT (conT ''Either) $ map (head . unArrowT) [lty,rty]
-        in  tInfixE (tConE '(\/) [lty,rty,ety,last . unArrowT $ lty]) l r 
-     mkInfxs (l:rs)= 
-        let r = mkInfxs rs; lty = typeOf l; rty = typeOf r
-            ety = foldAppT (conT ''Either)$ map (head . unArrowT) [lty,rty]
-        in  tInfixE (tConE '(\/) [lty,rty,ety,last . unArrowT $ rty]) l r 
hunk ./src/Igor2/RuleDevelopment/Cata.hs 201
+