[experimented with introducing if_then_else in fold-as-filter expressions
martin.hofmann@uni-bamberg.de**20090722082637] hunk ./src/RuleDevelopment/UniProp.hs 8
+import Data.Function (on)
hunk ./src/RuleDevelopment/UniProp.hs 16
+import Syntax.IFTemplateHaskell
hunk ./src/RuleDevelopment/UniProp.hs 33
-    crsub     <- coverAll subfnm
-    
-    f         <- liftM (getAll subfnm) getEvidence
-    llogDE (text "With function" <^> pretty f <$>
-            text "and start value" <^> pretty v)
hunk ./src/RuleDevelopment/UniProp.hs 35
-    let alist  = mkListT alpha
+    let alstty = mkListT alpha
hunk ./src/RuleDevelopment/UniProp.hs 38
-    let fldty  = mkArrowT [fty,beta,alist,beta]
-    let fExp   = TConE subfnm fty
+    let fExp   = mkTConE subfnm [alpha, beta, beta]
hunk ./src/RuleDevelopment/UniProp.hs 40
-    let fldExp = foldTAppE (TConE 'foldr fldty) [fExp, v, fldarg]
-             
+    let fldExp = foldTAppE (mkTConE 'foldr [fty,beta,alstty,beta]) [fExp, v, fldarg]
hunk ./src/RuleDevelopment/UniProp.hs 42
-    let calls = [((name cr),subfnm,GT)
-                ]
+    -- make the fold expression rule
hunk ./src/RuleDevelopment/UniProp.hs 45
-    return [(S.fromList [cr',crsub],calls)]
+    mkCallsAndDeps subfnm fios cr'
+
hunk ./src/RuleDevelopment/UniProp.hs 48
+mkCallsAndDeps :: Name -> [Rule] -> CovrRule ->  IM [(CovrRules,[Call])]
+mkCallsAndDeps subnm ios foldcr = do 
+    subcr     <- coverAll subnm
+    let calls = [((name foldcr),subnm, EQ)]
+    return [(S.fromList [foldcr,subcr],calls)]
+---- for detecting fold as filter and inserting if_then_else
+--    case partition idOn2ndArg ios of
+--        (f@(_:_),t@(_:_)) -> do 
+--        -- 
+--            let fios = (++) (map (makeIO False) f)(map (makeIO True) t)
+--            filternm  <- addIO.rules $ fios
+--            filtercr  <- coverAll filternm
+--            let subcr' =  modifycrul subcr (mkCond filternm)
+--            return [(S.fromList [foldcr,subcr',filtercr],(subnm,filternm, LT):calls)]
+--        otherwise         -> return [(S.fromList [foldcr,subcr],calls)]
+--    where
+--    makeIO b r = let n = if b then 'True else 'False 
+--                 in rule (take 1 (lhs r))(mkTConE n [ConT ''Bool])
+--    idOn2ndArg r = ((lhs r) !! 1) == (rhs r)
+--    mkCond n r = let [x,xs] = lhs r
+--                     if_ = mkTAppE (mkTConE n [typeOf x, ConT ''Bool]) x
+--                     then_ =mkTInfixE (mkTConE '(:) [typeOf x ,typeOf xs]) x xs
+--                     else_ = xs
+--                     rhs' = mkTCondE if_ then_ else_
+--                 in rule (lhs r) rhs'
hunk ./src/Syntax/Expressions.hs 202
---    subterms (TCondE e1 e2 e3 _)                = [e1, e2, e3]    
+    root (TCondE e1 e2 e3 t)                = \[e1, e2, e3] -> TCondE e1 e2 e3 t
hunk ./src/Syntax/Expressions.hs 204
-    root    e                               = 
-        error $ "Terms.root: Not implemented for TExp " ++ (show e)  
+--    root    e                               = 
+--        error $ "Terms.root: Not implemented for TExp " ++ (show e)  
hunk ./src/Syntax/Expressions.hs 215
---    subterms (TCondE e1 e2 e3 _)                = [e1, e2, e3]    
+    subterms (TCondE e1 e2 e3 _)                = [e1, e2, e3]    
hunk ./src/Syntax/Expressions.hs 220
-    subterms    e                               = 
-        error $ "Terms.subterms: Not implemented for TExp " ++ (show e)
+--    subterms    e                               = 
+--        error $ "Terms.subterms: Not implemented for TExp " ++ (show e)
hunk ./src/Syntax/Expressions.hs 643
+fromTExp (TCondE i t e _)    = CondE (fromTExp i)(fromTExp t)(fromTExp e)
hunk ./src/Syntax/Expressions.hs 702
+-- very quick and dirty !!!!    
+---- e is the expression of an element, l the expression of a list !!!
+--mkListE [e,l] = mkTInfixE (mkTConE '(:) [typeOf e ,typeOf l]) e l
+-- l is a list of elements with te same type !!!
+mkListE l = TListE l (mkListT . typeOf . head $ l)
+
+mkTConE n argtys = TConE n (mkArrowT argtys)
+
+mkTCondE i t e = TCondE i t e (typeOf e)
+