[code cleaning
martin.hofmann@uni-bamberg.de**20090610101424] hunk ./src/RuleDevelopment/Matching.hs 33
-    liftM concat $ mapM (computeMatchings cr) allowdCs
-    
+    liftM concat $ mapM (tryCall cr) allowdCs
hunk ./src/RuleDevelopment/Matching.hs 35
--- compute
-computeMatchings :: CovrRule -> (Name, Maybe Ordering) -> IM [(CovrRules,[Call])]
-computeMatchings _ (n, Nothing) = 
+-- Try to compute a call in 'CovrRule' to funtion 'Name' with call relation 
+-- 'Ordering'
+tryCall :: CovrRule -> (Name, Maybe Ordering) -> IM [(CovrRules,[Call])]
+tryCall _ (n, Nothing) = 
hunk ./src/RuleDevelopment/Matching.hs 40
-    return [] -- no call allowed
-computeMatchings cr (n, Just o) = do
-     cllrs  <- breakupM $ cr
-     tgtrs  <- liftM (getAll n) getEvidence
-     dcp    <- constantCall cr (n,o)
+    return [] -- no call allowed    
+tryCall cr (n, Just o) = do
+     dcp    <- directCalls cr (n,o)
hunk ./src/RuleDevelopment/Matching.hs 46
-        else do llogIN (text "Need to try matchings (target,caller)" <$> pretty (tgtrs,cllrs))
-                ios <-  makeIOMatrix tgtrs o cllrs  
-                llogIN (text "Matchings" <$> (pretty ios))
-                if any null ios then llogIN (text "Insufficient matching! At least one argument didn't match at all!\n") >> return []
-                  else mapM (makeCall cr n) $ (oneFromEachCol ios)
+        else do indirectCalls cr (n,o)
+    
+
+-- compute
+indirectCalls :: CovrRule -> (Name, Ordering) -> IM [(CovrRules,[Call])]
+indirectCalls cr (n,o) = do
+     cllrs  <- breakupM $ cr
+     tgtrs  <- liftM (getAll n) getEvidence
+     
+     llogIN (text "Need to try matchings (C vs T)" <$> 
+             text "Caller:" <^> pretty cllrs <$> 
+             text "Target:" <^> pretty tgtrs)
+             
+     ios <-  makeIOMatrix tgtrs o cllrs      
+     
+     maybe cancel proceed ios
+     where
+     cancel    =  llogIN(--text "<Stopped by laziness!>" <$>
+                         text "Insufficient matchings!" <+>
+                         text "At least one argument had no I/Os at all!") >> 
+                 return []
+     proceed m = do llogIN (text "Matchings" <$> (pretty m))
+                    mapM (mkIndirectCall cr n) $ (oneFromEachCol m)
hunk ./src/RuleDevelopment/Matching.hs 70
-constantCall :: CovrRule -> (Name,Ordering) -> IM [(Ordering,LHS)]
-constantCall cr (n,maxcall) = do
+directCalls :: CovrRule -> (Name,Ordering) -> IM [(Ordering,LHS)]
+directCalls cr (n,maxcall) = do
hunk ./src/RuleDevelopment/Matching.hs 113
-makeCall :: CovrRule -> Name -> [(Ordering, [Rule])] -> IM (CovrRules,[Call])
-makeCall cr tgtn ios = do
+mkIndirectCall :: CovrRule -> Name -> [(Ordering, [Rule])] -> IM (CovrRules,[Call])
+mkIndirectCall cr tgtn ios = do
hunk ./src/RuleDevelopment/Matching.hs 116
-    subfns  <- mapM (addIO.rules) subargsio
-    let subftys = map (typeOf.rhs.head) subargsio
-    let subcalls = map (\(n,ty) -> mkCall n ty (lhs.crul $ cr)) (zip subfns subftys)
-    let cr' = modifycrul cr $ mkCallAt (Body Root) tgtn subcalls 
-    subinis <- mapM (\n -> liftM (fuse.(getAll n)) getEvidence) subfns
-    let tgtcall = ((name cr),tgtn, maximum (map fst ios))
-    let subcalls = map (\n -> (tgtn,n,EQ)) subfns
+    subfns        <- mapM (addIO.rules) subargsio
+    let subftys   = map (typeOf.rhs.head) subargsio
+    let subcalls  = map (\(n,ty) -> mkCall n ty (lhs.crul $ cr)) (zip subfns subftys)
+    let cr'       = modifycrul cr $ mkCallAt (Body Root) tgtn subcalls 
+    subinis       <- mapM (\n -> liftM (fuse.(getAll n)) getEvidence) subfns
+    let call      = ((name cr),tgtn, maximum (map fst ios)) -- call to target
+    let calls  = map (\n -> (tgtn,n,EQ)) subfns             -- auxiliary calls
hunk ./src/RuleDevelopment/Matching.hs 124
-    return (covrRules (cr':subinis),tgtcall:subcalls)
+    return (covrRules (cr':subinis),call:calls)
hunk ./src/RuleDevelopment/Matching.hs 129
-    let cr' = modifycrul cr $ mkCallAt (Body Root) tgtn pat
-    let tgtcall = ((name cr),tgtn, o)
+    let cr'  = modifycrul cr $ mkCallAt (Body Root) tgtn pat
+    let call = ((name cr),tgtn, o)
hunk ./src/RuleDevelopment/Matching.hs 132
-    return (covrRules [cr'],[tgtcall])   
+    return (covrRules [cr'],[call])   
hunk ./src/RuleDevelopment/Matching.hs 144
-
hunk ./src/RuleDevelopment/Matching.hs 145
-makeIOMatrix :: [CovrRule] -> Ordering -> [CovrRule] -> IM [[(Ordering, [Rule])]]
+makeIOMatrix :: [CovrRule] -> Ordering -> [CovrRule] -> IM (Maybe [[(Ordering, [Rule])]])
hunk ./src/RuleDevelopment/Matching.hs 147
-    sequence [ liftM catMaybes $ sequence $ [abduceIO t o c | t <- tgtrs ] | c <- cllrs] 
+    liftM sequence $ sequence [ anyResult [abduceIO t o c | t <- tgtrs ] | c <- cllrs] 
+
+anyResult :: [IM (Maybe a)] -> IM (Maybe [a])
+anyResult = (liftM ((\l -> if (null l) then Nothing else (Just l)).catMaybes)).sequence
hunk ./src/RuleDevelopment/Matching.hs 159
-abduceIO :: CovrRule -> Ordering ->  CovrRule -> IM (Maybe (Ordering, [Rule]))
+abduceIO ::CovrRule -> Ordering -> CovrRule -> IM (Maybe (Ordering, [Rule]))
hunk ./src/RuleDevelopment/Matching.hs 161
-    callrel <- liftM (\f -> on f (lhs.crul) tgt cll) getPatComparison
+    comp <- getPatComparison
+    let callrel = on comp (lhs.crul) tgt cll
hunk ./src/RuleDevelopment/Matching.hs 164
-              llogIN (text "Discarded Match" <+> pretty tgt <+> text (show callrel) <+>
-                      pretty cll <+> text "not allowed" <+> text (show callrel)) >> 
-              return Nothing
+       llogIN (text "Discarded Match" <+> pretty tgt <+> text (show callrel) <+>
+               pretty cll <+> text "not allowed" <+> text (show callrel)) >> 
+       return Nothing
hunk ./src/RuleDevelopment/Matching.hs 168
-      else do s <- lift $ (liftM Just $ on (matchesWithSubs) (rhs.crul) cll tgt) `catchError`
+       else do s <- lift $ (liftM Just $ on (matchesWithSubs) (rhs.crul) cll tgt) `catchError`
hunk ./src/RuleDevelopment/Matching.hs 171
-              llogIN (text "Try Match      " <+> pretty tgt <+> text (show callrel) <+>
-                      pretty cll <+> text "allowed" <+> text (show maxcallrel) <+> text "Match?" <+> (bool $ isJust s)) 
-              case s of
-               Nothing  -> return Nothing
-               (Just s) -> do let cllvars = (concatMap getVars (lhs.crul $ cll))
-                              let unaffectedvars = cllvars \\ (map fst s)
-                              let s' = s ++ [ v <~ (TWildE n t) | v@(TVarE n t) <- unaffectedvars]
-                              -- replace all vars not in the substitution by wildcards 
-                              let lhss' = lhs.crul $ cll
-                              rhss' <- lift $ mapM (apply s') (lhs.crul $ tgt)  
-                              -- new rhss are the substituted lhss of tgt
-                              return.Just $  (callrel, map (rule lhss') rhss')
+               llogIN (text "Try Match      " <+> pretty tgt <+> 
+                       text (show callrel) <+> pretty cll <+> 
+                       text "allowed" <+> text (show maxcallrel) <+> 
+                       text "Match?" <+> (bool $ isJust s)) 
+               case s of
+                Nothing  -> return Nothing
+                (Just s) -> do let cllvars = (concatMap getVars (lhs.crul $ cll))
+                               let unaffectedvars = cllvars \\ (map fst s)
+                               let s' = s ++ [ v <~ (TWildE n t) | v@(TVarE n t) <- unaffectedvars]
+                               -- replace all vars not in the substitution by wildcards 
+                               let lhss' = lhs.crul $ cll
+                               rhss' <- lift $ mapM (apply s') (lhs.crul $ tgt)  
+                               -- new rhss are the substituted lhss of tgt
+                               return.Just $  (callrel, map (rule lhss') rhss')