[code cleaning and special treatment of multiple trgets when calculating dependencies
martin.hofmann@uni-bamberg.de**20090611034314] hunk ./src/RuleDevelopment/Matching.hs 13
-import Data.GlobalConfig 
+import Data.GlobalConfig
hunk ./src/RuleDevelopment/Matching.hs 24
-    
-    let subcalls    = allowedMaxCall (name cr) cd
-    let bckgcalls   = map (flip (,) (Just GT)) bknames
-    let selfcall    = (name cr, Just LT)
-    let allowdCs    =  M.toList $ foldl (flip $ uncurry M.insert) subcalls (bckgcalls ++[selfcall])
-    
+    tgtnames <- targets
+
+    let scope     = allowedMaxCall (name cr) cd
+    -- scope of current hypo, sub function calls, and previous background calls
+    let bkgcalls  = map (flip (,) (Just GT)) bknames
+    -- call sto background knowledge
+    let tgtcalls  = map (flip (,) (Just LT)) tgtnames 
+    -- self call and calls to prallel synthesized targets
+    let allcalls  =  M.toList $ foldl (flip $ uncurry M.insert) scope (bkgcalls ++ tgtcalls)
+    -- bkgcalls overwrites previous calls in scope,
+
hunk ./src/RuleDevelopment/Matching.hs 37
-    llogIN ( text "Trying calls to:" <^> pretty allowdCs )
-    liftM concat $ mapM (tryCall cr) allowdCs
+    llogIN ( text "Trying calls to:" <^> pretty allcalls )
+    liftM concat $ mapM (tryCall cr) allcalls
hunk ./src/RuleDevelopment/Matching.hs 40
--- Try to compute a call in 'CovrRule' to funtion 'Name' with call relation 
+-- Try to compute a call in 'CovrRule' to funtion 'Name' with call relation
hunk ./src/RuleDevelopment/Matching.hs 43
-tryCall _ (n, Nothing) = 
-    llogIN (indent 2 $ text "- Not allowed to call" <+> (text.show $ n)) >> 
-    return [] -- no call allowed    
+tryCall _ (n, Nothing) =
+    llogIN (indent 2 $ text "- Not allowed to call" <+> (text.show $ n)) >>
+    return [] -- no call allowed
hunk ./src/RuleDevelopment/Matching.hs 48
-     if (not.null $ dcp) 
+     if (not.null $ dcp)
hunk ./src/RuleDevelopment/Matching.hs 52
-    
hunk ./src/RuleDevelopment/Matching.hs 53
--- compute
+
+{-| Compute all indirect calls from the provided 'CovrRule' to the function 
+    'Name', i.e. where the arguments for the call have to be synthesised using
+    subfunctions.
+-}
hunk ./src/RuleDevelopment/Matching.hs 62
-     
-     llogIN (text "Need to try matchings (C vs T)" <$> 
-             text "Caller:" <^> pretty cllrs <$> 
+
+     llogIN (text "Need to try matchings (C vs T)" <$>
+             text "Caller:" <^> pretty cllrs <$>
hunk ./src/RuleDevelopment/Matching.hs 66
-             
-     ios <-  makeIOMatrix tgtrs o cllrs      
-     
+
+     ios    <-  makeIOMatrix tgtrs o cllrs
+
hunk ./src/RuleDevelopment/Matching.hs 73
-                         text "At least one argument had no I/Os at all!") >> 
+                         text "At least one argument had no I/Os at all!") >>
hunk ./src/RuleDevelopment/Matching.hs 78
+{-| Compute all direct calls from the provided 'CovrRule' to the function 'Name'
+    i.e. a call to function 'Name' where the arguments for the call cab directly
+    be constructoed from the lhs pattern of the caller.
+-}
hunk ./src/RuleDevelopment/Matching.hs 84
-     
-     smllstio   <- liftM (minimumBy (compare `on` (size.lhs.crul))) $ breakupM  cr
-     -- get the smallest (by size on lhs) covered example
-     
-     comparator <- getPatComparison
-     let admissible   = (filter (\t ->  maxcall >= (on comparator (lhs.crul) t smllstio)))
-     tgtrs     <- liftM (admissible.(getAll n)) getEvidence
-     
-     tgtlhs   <- lift $ liftM catMaybes $ mapM (on normalize crul smllstio) $ tgtrs
+
+     scio <- liftM (minimumBy (compare `on` (size.lhs.crul))) $ breakupM  cr
+     -- get the smallest (by size on lhs) covered IO example
+
+     comp     <- getPatComparison
+     tgtrs  <- liftM ((admissible comp scio).(getAll n)) getEvidence
+     -- get for the smallest covered example all admissible target IOs w.r.t
+     -- the given maximal call relation
+     tgtlhs   <- mkNormalPats scio tgtrs
hunk ./src/RuleDevelopment/Matching.hs 94
-     subs       <- lift $ (on matchesLhs crul smllstio cr) `catchError`
+     subs     <- lift $ (on matchesLhs crul scio cr) `catchError`
hunk ./src/RuleDevelopment/Matching.hs 98
-     
+
hunk ./src/RuleDevelopment/Matching.hs 100
-     let possiblePats = map (buildPat subs) $ tgtlhs
-     testedPats <-  mapM (testPat cllrs (lhs.crul $ cr)) possiblePats
-     return $ map (\p -> (comparator (lhs.crul $ smllstio) p,p)) $ catMaybes testedPats
+     pats  <-  mapM (testPat n cllrs (lhs.crul $ cr)) $ possiblePats subs tgtlhs
+     return $ map ((,) =<< comp (lhs.crul $ scio)) $ catMaybes pats
hunk ./src/RuleDevelopment/Matching.hs 103
-     normalize cll tgt =
-     	(matchesRhs cll tgt >>=  flip applyL (lhs  tgt) >>= return.Just) `catchError`
-          \_ -> return Nothing
-        
-     buildPat subs =  map (buildPatArg subs)
-     buildPatArg subs tgtlhs = fromJust $ mplus 
-                         (liftM fst $ find ((tgtlhs==).snd) subs) 
+     admissible cmp io = filter $ (maxcall >=) . flip (on cmp (lhs.crul)) io
+     possiblePats subs = map (buildPat subs) 
+     mkNormalPats io   = lift . fmap catMaybes . mapM (on normalPat crul io)
+     
+testPat :: Name -> [CovrRule] -> LHS -> LHS -> IM (Maybe LHS)     
+testPat n cllrs lp rps = do
+    let rs = map (rule lp) rps --
+    isok <- liftM or $ mapM ((check rs).crul) cllrs
+    if isok then return (Just rps) else return Nothing
+    where
+    check rs cr = do
+        let rside = mapM (matchEval.lhs $ cr) rs
+        rside' <- maybe (return Nothing) (evalIO n) rside
+        return $ maybe False ( == (rhs cr)) rside'
+
+
+buildPat subs =  map buildPatArg
+    where
+    buildPatArg tgtlhs =
+        fromJust $ mplus (liftM fst $ find ((tgtlhs==).snd) subs)
hunk ./src/RuleDevelopment/Matching.hs 126
-                         -- or (if not) we keep the top ctor symbol and apply 
+                         -- or (if not) we keep the top ctor symbol and apply
hunk ./src/RuleDevelopment/Matching.hs 128
-     testPat cllrs lp rps = do
-        let rs = map (rule lp) rps -- 
-        isok <- liftM or $ mapM ((check rs).crul) cllrs  
-        if isok then return (Just rps) else return Nothing
-     check rs cr = do
-        let rside = mapM (matchEval.lhs $ cr) rs
-        rside' <- maybe (return Nothing) (evalIO n) rside
-        return $ maybe False ( == (rhs cr)) rside'
+
+{-| @normalPat r1 r2@ returns the lhs of 'r2' after applying the the subsitution
+     resulting from matching the rhs of 'r1' against the rhs of 'r2'. This is
+     kind of a normalized lhs pattern of 'r2' w.r.t. 'r1'
+-}
+normalPat :: Rule -> Rule -> LM (Maybe [TExp])
+normalPat cll tgt =
+    (matchesRhs cll tgt >>=  flip applyL (lhs tgt) >>= return.Just)
+      `catchError` \_ -> return Nothing
hunk ./src/RuleDevelopment/Matching.hs 144
-    let cr'       = modifycrul cr $ mkCallAt (Body Root) tgtn subcalls 
+    let cr'       = modifycrul cr $ mkCallAt (Body Root) tgtn subcalls
hunk ./src/RuleDevelopment/Matching.hs 148
-    llogIN (text "Call added:" <^> (text.show $ cr'))
+    llogIN (text "Call added:" <^> (pretty cr'))
hunk ./src/RuleDevelopment/Matching.hs 151
- 
+
hunk ./src/RuleDevelopment/Matching.hs 156
-    llogIN (text "Call added:" <^> (text.show $ cr'))
-    return (covrRules [cr'],[call])   
-    
+    llogIN (text "Call added:" <^>  (pretty cr'))
+    return (covrRules [cr'],[call])
+
hunk ./src/RuleDevelopment/Matching.hs 160
-     to call (c =  [c1 .. cn]), the cross-product ( t * c) is generated as a 
-     list of collumns 
-     
+     to call (c =  [c1 .. cn]), the cross-product ( t * c) is generated as a
+     list of collumns
+
hunk ./src/RuleDevelopment/Matching.hs 167
-     
-     where each 'ticj' is a list of rules resulting from @abduceIO ti o cj@. 
+
+     where each 'ticj' is a list of rules resulting from @abduceIO ti o cj@.
hunk ./src/RuleDevelopment/Matching.hs 171
-makeIOMatrix tgtrs o cllrs = 
-    liftM sequence $ sequence [ anyResult [abduceIO t o c | t <- tgtrs ] | c <- cllrs] 
+makeIOMatrix tgtrs o cllrs =
+    liftM sequence $ sequence [ anyResult [abduceIO t o c | t <- tgtrs ] | c <- cllrs]
hunk ./src/RuleDevelopment/Matching.hs 179
-   
--- | @abduceIO tgt o cll@ abduces one IO pair for each argument of 'tgt' if 
+
+-- | @abduceIO tgt o cll@ abduces one IO pair for each argument of 'tgt' if
hunk ./src/RuleDevelopment/Matching.hs 182
---   in size of the lhss of 'tgt' and 'cll' is greater than the max difference 
---   'o'.       
+--   in size of the lhss of 'tgt' and 'cll' is greater than the max difference
+--   'o'.
hunk ./src/RuleDevelopment/Matching.hs 188
-    if maxcallrel < callrel then 
+    if maxcallrel < callrel then
hunk ./src/RuleDevelopment/Matching.hs 190
-               pretty cll <+> text "not allowed" <+> text (show callrel)) >> 
+               pretty cll <+> text "not allowed" <+> text (show callrel)) >>
hunk ./src/RuleDevelopment/Matching.hs 196
-               llogIN (text "Try Match      " <+> pretty tgt <+> 
-                       text (show callrel) <+> pretty cll <+> 
-                       text "allowed" <+> text (show maxcallrel) <+> 
-                       text "Match?" <+> (bool $ isJust s)) 
+               llogIN (text "Try Match      " <+> pretty tgt <+>
+                       text (show callrel) <+> pretty cll <+>
+                       text "allowed" <+> text (show maxcallrel) <+>
+                       text "Match?" <+> (bool $ isJust s))
hunk ./src/RuleDevelopment/Matching.hs 205
-                               -- replace all vars not in the substitution by wildcards 
+                               -- replace all vars not in the substitution by wildcards
hunk ./src/RuleDevelopment/Matching.hs 207
-                               rhss' <- lift $ mapM (apply s') (lhs.crul $ tgt)  
+                               rhss' <- lift $ mapM (apply s') (lhs.crul $ tgt)
hunk ./src/RuleDevelopment/Matching.hs 212
+