[implemented siplification based on a hypo with its call graph
martin.hofmann@uni-bamberg.de**20091013161704] hunk ./src/Data/Hypotheses.hs 8
-    openRules, closedRules, allRules, allBindings,
+    openRules, closedRules, allRules, allBindings, simplifiedBindings,
hunk ./src/Data/Hypotheses.hs 21
+import Control.Arrow (first, second)
hunk ./src/Data/Hypotheses.hs 23
-import Data.List (foldl')
+import Data.List (foldl', partition, (\\))
hunk ./src/Data/Hypotheses.hs 36
-import Data.CallDependencies (CallDep, Call, tryAddCall, noCalls, cycles)
+import Data.CallDependencies -- (CallDep, Call, tryAddCall, noCalls, cycles)
hunk ./src/Data/Hypotheses.hs 96
+
+bindings :: Hypo -> [(Name,Rules)]
+bindings h = M.toList $ foldl' ins (clsd h) (S.toList $ open h)
+    where
+    ins m e = M.alter (insertM (crul e)) (name e) m
+        
+simplifiedBindings :: Hypo -> [(Name,Rules)]
+simplifiedBindings h = sbnds [] (callings h) (bindings h)
+    where
+    
+    sbnds blckl cd bnds = 
+        case (danglingFuns $ cd) \\ blckl of
+        -- get those functions which are th outer most in the call graph
+        -- either constant functions, or those with a single call
+            []      -> bnds
+            l@(_:_) -> let (is,nis) = partition (isInjectable bnds) l 
+                       in  sbnds (blckl++nis) (foldl (flip annexFun) cd is)(foldl inject bnds is)
+                       -- add the non-injectables to the blacklist, update the 
+                       -- CallDep and inject the injectables in all other bindings  
+    isInjectable bnds n = 
+        (maybe False id (liftM ((==1).S.size) $ lookup n bnds))
+        -- true if there are bindings with this name (if not, it should be the 
+        -- name of a bgk function) and the binding has only a single rule 
+        -- attached.
+        &&
+        (not $ any hasHO $ filter (flip doesCallTo n) $ concatMap (S.toList . snd) $ bnds)
+        -- True if any function which calls the function with name at hand is not a HO
+        
+    inject bnds l = let (r,rs) = partition ((l==).fst) $ bnds
+                        cll = buildCall . (second $ head . S.toList) . head $ r
+                    in uncurry replaceInAll cll rs
+   
+
+
+        
hunk ./src/Data/Hypotheses.hs 155
-    | isOpen rf  = h{open = S.insert rf os}
+    | isOpen rf   = h{open = S.insert rf os}
hunk ./src/Data/Rules.hs 10
-    mkCall,
+    mkCall, buildCall, doesCallTo, replaceInAll,
hunk ./src/Data/Rules.hs 245
+buildCall (n,cr) = (mkCall n (typeOf.rhs $ cr) (lhs cr), rhs cr)
+                      
+doesCallTo :: Rule -> Name ->  Bool
+doesCallTo r n = dc n (rhs r)
+    where
+    dc n (TVarE nc _)      = n == nc
+    dc n (TLitE _ _)       = False
+    dc n (TWildE _ _)      = False
+    dc n (TConE nc _)      = n == nc
+    dc n (TAppE a1 a2 _)   = dc n a1 || dc n a2
+    dc n (TInfixE l o r _) = any (dc n) [l,o,r]
+    dc n (TTupE l _)       = any (dc n) l
+    dc n (TListE l _)      = any (dc n) l
+    dc n (TCondE i t e _)  = any (dc n) [i,t,e]
+
+
hunk ./src/Data/Rules.hs 265
-    cc c ns (TVarE _ _)       = c
+    cc c ns (TVarE n _)       = if isCall n ns then c + 1 else c
hunk ./src/Data/Rules.hs 268
-    cc c ns (TConE n _)       = if isCall n ns then c + 1 else c
+    cc c ns (TConE n _)       = c
hunk ./src/Data/Rules.hs 297
-hypos2decs :: Bool -> [Name] -> [[(Name,Rules)]] -> [[Dec]]
-hypos2decs smplfy blckl hs =  map (rearrange.rules2decs.preprocess) hs
+hypos2decs :: [[(Name,Rules)]] -> [[Dec]]
+hypos2decs hs =  map (rearrange.rules2decs) hs
hunk ./src/Data/Rules.hs 300
-    preprocess = if smplfy then simplify blckl else id
hunk ./src/Data/Rules.hs 337
-replaceCall _ t@(TVarE _ _)       = t
-replaceCall _ t@(TLitE _ _)       = t
-replaceCall _ t@(TWildE _ _)      = t
-replaceCall _ t@(TConE n _)       = t
-replaceCall r t = maybe repSubterms id $ matchEval [t] r
+replaceCall r rs = replaceCall' r rs
hunk ./src/Data/Rules.hs 339
-    repSubterms = (root t $ map (replaceCall r) $ subterms t)
+    replaceCall' _ t@(TVarE _ _)       = t
+    replaceCall' _ t@(TLitE _ _)       = t
+    replaceCall' _ t@(TWildE _ _)      = t
+    replaceCall' _ t@(TConE n _)       = t
+    replaceCall' r t = maybe (repSubterms t) id $ matchEval [t] r
+    repSubterms t = (root t $ map (replaceCall' r) $ subterms t)
hunk ./src/Data/Rules.hs 386
-
--- DEAD CODE
---subsumesAll :: Rules -> Rules -> Bool
---subsumesAll r1 r2 =  all (anySubsumes r1) (S.toAscList r2) 
---    
--- DEAD CODE
---anySubsumes :: Rules -> Rule -> Bool
---anySubsumes rs r = 
---        any (isMoreSpecific r) (S.toAscList rs)
hunk ./src/SynthesisEngine.hs 54
-    (r,l) <- (runIM (synthesiseTargets (scr_tgts conf) >>= \r -> 
+    (hs,l) <- (runIM (synthesiseTargets (scr_tgts conf) >>= \r -> 
hunk ./src/SynthesisEngine.hs 58
-    return . ((,) l) . niceify . outputraw $ r
+    return . ((,) l) . niceify . outputraw $ simplify (scr_simplify conf) $ hs
hunk ./src/SynthesisEngine.hs 60
+    simplify b = map $ concatMap $ if b then simplifiedBindings else allBindings
hunk ./src/SynthesisEngine.hs 66
-    niceify = hypos2decs (scr_simplify conf)(scr_tgts conf)
+    niceify = hypos2decs
hunk ./src/SynthesisEngine.hs 68
-synthesiseTargets :: [Name] -> IM [[(Name,Rules)]]
+synthesiseTargets :: [Name] -> IM [[Hypo]]
hunk ./src/SynthesisEngine.hs 71
-    synthesiseTarget :: Name -> IM [[(Name,Rules)]]
+    synthesiseTarget :: Name -> IM [Hypo]
hunk ./src/SynthesisEngine.hs 78
-    oneFromEach (x:xs)= [e ++ es | e <- x, es <- (oneFromEach xs)]
+    oneFromEach (x:xs)= [e:es | e <- x, es <- (oneFromEach xs)]
hunk ./src/SynthesisEngine.hs 80
-enterLoop :: IM [[(Name,Rules)]]
+enterLoop :: IM [Hypo]
hunk ./src/SynthesisEngine.hs 87
-    hypoCount >>= \c -> llogNO $ text "#Hypos:" <+> pretty c
-    get       >>= \ig -> llogDE $ indent 2 $ pretty ig
+    hypoCount >>= llogNO . (text "#Hypos:" <+>) . pretty
+    get       >>= llogDE  . (indent 2) . pretty
hunk ./src/SynthesisEngine.hs 105
-stopWith  :: Hypos -> IM [[(Name,Rules)]]
+stopWith  :: Hypos -> IM [Hypo]
hunk ./src/SynthesisEngine.hs 110
-       return $ map allBindings  hs
+       return hs -- $ map simplifiedBindings hs