[BUGFIX in result simplification
martin.hofmann@uni-bamberg.de**20090618025953] hunk ./src/Data/Rules.hs 24
-import Data.List (foldl', transpose, (\\), nub, sortBy, partition, isPrefixOf)
+import Data.List (foldl', transpose, (\\), nub, sortBy, partition, isPrefixOf, deleteBy)
hunk ./src/Data/Rules.hs 73
-rule :: [TExp] -> TExp -> Rule
+rule :: LHS -> TExp -> Rule
hunk ./src/Data/Rules.hs 118
+-- dissolve a subterm out from the rhs and use it as new rhs
hunk ./src/Data/Rules.hs 135
--- TODO niocer and clearer
+-- TODO nicer and clearer
hunk ./src/Data/Rules.hs 141
+callLevel :: Rule -> [Name] -> Int
+callLevel = (flip countCalls) . rhs
hunk ./src/Data/Rules.hs 190
+    
+matchEvals :: LHS -> [Rule] -> Maybe TExp
+matchEvals = ((listToMaybe . catMaybes) .) . map . matchEval
hunk ./src/Data/Rules.hs 233
+
+countCalls :: [Name] -> TExp -> Int
+countCalls ns e = cc (0::Int) ns e
+    where
+    cc :: Int -> [Name] -> TExp -> Int
+    cc c ns (TVarE _ _)       = c
+    cc c ns (TLitE _ _)       = c
+    cc c ns (TWildE _ _)      = c
+    cc c ns (TConE n _)       = if isCall n ns then c + 1 else c
+    cc c ns (TAppE a1 a2 _)   = (c+) $ on (+) (cc 0 ns) a1 a2
+    cc c ns (TInfixE l o r _) = (c+).sum $ map (cc 0 ns) [l,o,r]
+    cc c ns (TTupE l _)       = (c+).sum $ map (cc 0 ns) l
+    cc c ns (TListE l _)      = (c+).sum $ map (cc 0 ns) l
+    cc c ns (TCondE i t e _)  = (c+).sum $ map (cc 0 ns) [i,t,e]
+
+isCall :: Name -> [Name] -> Bool
+isCall n ns 
+    | n `elem` ns                 = True
+    | "fun" `isPrefixOf` (show n) = True
+    | otherwise                   = False
hunk ./src/Data/Rules.hs 277
+simplify :: [Name] -> [(Name,Rules)] -> [(Name,Rules)]
hunk ./src/Data/Rules.hs 281
-        (r,(x:xs)) -> let cr = head.S.toList.snd $ x
-                          (cc,ct) = (mkCall (fst x) (typeOf.rhs $ cr) (lhs cr), rhs cr)
-                      in  trace ("\nXXX " ++ (show.fst $ x) ++ "\n" ++ (show $ l)) $ simplify blckl $ replaceInAll cc ct (r ++ xs)
+        (rec,nrec) -> let r = (getOneWhich hasNoCalls nrec)
+                               `mplus`
+                              (getOneWhich hasOneCall nrec)
+                      in maybe (rec ++ nrec) (simplify_ rec nrec) r
+                              
+--                          (cc,ct) = (mkCall (fst x) (typeOf.rhs $ cr) (lhs cr), rhs cr)
+--                      in simplify blckl $ replaceInAll cc ct (r ++ xs)
+--                      in  trace ("\nXXX " ++ (show.fst $ x) ++ "\n" ++ (show $ l)) $ simplify blckl $ replaceInAll cc ct (r ++ xs)
hunk ./src/Data/Rules.hs 290
+    simplify_ rec nrec r = simplify blckl $ uncurry replaceInAll (buildCall r) (rec ++ (deleteBy ((==) `on` fst) r nrec))
+    hasNoCalls = ((==0).(countCalls blckl).rhs.head.S.toList.snd)
+    hasOneCall = ((==1).(countCalls blckl).rhs.head.S.toList.snd)
+    hasTwoCall = ((==2).(countCalls blckl).rhs.head.S.toList.snd)
+    buildCall (n,r) = let cr = head . S.toList $ r
+                      in (mkCall n (typeOf.rhs $ cr) (lhs cr), rhs cr)
hunk ./src/Data/Rules.hs 297
---    replCCall :: [(Name,Rules)] ->  [(Name,Rules)] -> [(Name,Rules)]
---    replCCall l []     = l
---    replCCall l (x:xs) = 
---        let cr = head.S.toList.snd $ x
---            (cc,ct) = (mkCall (fst x) (typeOf.rhs $ cr) (lhs cr), rhs cr)
---        in simplify tgts $ on (++) (replaceInAll cc ct) l xs
-----    cr = head.S.toList.snd $ x
-----    (cc,ct) = (mkCall (fst x) (typeOf.rhs $ cr) (lhs cr), rhs cr)
+
+getOneWhich :: (a -> Bool) -> [a] -> Maybe a    
+getOneWhich _ []    = Nothing
+getOneWhich f (x:xs)
+    | f x        = Just x
+    | otherwise  = getOneWhich f xs