[simplify the data type TExp
Helmut Grohne <grohne@cs.uni-bonn.de>**20150210090903
 Ignore-this: 7622e77b861f6b69405236fbe6283f81
 
 Remove constructors TListE, TTupE and TInfixE. All of these can be represented
 by combinations of TAppE and TConE. In order to keep this change as invisible
 as possible, the pretty printer gained a fair number of special cases.
 
 Surprisingly this changes the behaviour of igor2 on the test suite. Yet it
 seems to be a net benefit if only in reduction of useless cases.
] hunk ./src/Igor2/Data/Rules.hs 255
-    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
hunk ./src/Igor2/Data/Rules.hs 267
---    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
hunk ./src/Igor2/RuleDevelopment/Cata.hs 110
-    hasCtor n (TListE l  _)      = if null l then isNil n else isCons n
hunk ./src/Igor2/RuleDevelopment/Cata.hs 112
-    hasCtor n (TInfixE _ c _ _ ) = hasCtor n c
-    hasCtor n  c                 = False  
-    noPartition = fail $ "No Partition possible for argument " ++ (show i) ++ "! "
+    hasCtor n  c                 = False
+    noPartition = fail $ "No Partition possible for argument " ++ show i ++ "! "
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 256
-mbListElems (TListE l t) = return l
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 280
-        case rhs $ r of
-           TListE (x:xs) t -> (last $ lhs r) == TListE xs t
+        case rhs r of
hunk ./src/Igor2/RuleDevelopment/ListCata.hs 302
-headTail (TListE (x:xs) ty)          = return  (x, TListE xs ty)
-headTail (TInfixE l (TConE n _) r _) = 
-    if isCons n then return (l,r) else fail "headTail: No list!"
-headTail (l@(TAppE _ _ _))           = 
+headTail (l@(TAppE _ _ _))           =
hunk ./src/Syntax/Builder.hs 216
-        tes <- zipWithM toTExp tuptys l 
-        return $ TTupE tes tupty
+        tes <- zipWithM toTExp tuptys l
+        return $ tTupE tes
hunk ./src/Syntax/Expressions.hs 47
-    | TInfixE TExp TExp TExp Type -- no sections, the second tExp is the ctor!!!
-    | TTupE [TExp] Type
-    | TListE [TExp] Type
hunk ./src/Syntax/Expressions.hs 72
-    typeOf (TInfixE _ _ _ t) = t
-    typeOf (TTupE _  t)      = t
-    typeOf (TListE _  t)     = t
hunk ./src/Syntax/Expressions.hs 81
-    sizeS (TInfixE l c r _) = sizeS l . sizeS c . sizeS r 
-    sizeS (TTupE l _)       = sizeS l
-    sizeS (TListE l _)      = sizeS l
hunk ./src/Syntax/Expressions.hs 89
-    sameSymAtRoot (TLitE l1 _) (TLitE l2 _)             = l1 == l2 
-    sameSymAtRoot (TInfixE _ e1 _ _) (TInfixE _ e2 _ _) = e1 == e2
-    -- tuples
-    sameSymAtRoot (TTupE v1s _)(TTupE v2s _)            = on (==) length  v1s v2s
-    sameSymAtRoot t@(TAppE _ _ _ )(TTupE vs _)          = 
-        chkTConE (flip isTuple (length vs)) . head . unfoldTAppE $ t
-    sameSymAtRoot (TTupE vs _) t@(TAppE _ _ _)          = 
-        chkTConE (flip isTuple (length vs)) . head . unfoldTAppE $ t
+    sameSymAtRoot (TLitE l1 _) (TLitE l2 _)             = l1 == l2
hunk ./src/Syntax/Expressions.hs 92
-    -- empty Lists
-    sameSymAtRoot (TListE [] _) (TListE [] _)           = True
-    sameSymAtRoot (TConE n _) (TListE [] _)             = isNil n
-    sameSymAtRoot (TListE [] _)(TConE n _)              = isNil n
-    -- non-empty lists
-    sameSymAtRoot (TListE (_:_) _)(TListE (_:_) _)      = True
-    sameSymAtRoot (TListE (_:_) _) t@(TAppE _ _ _)      = 
-        chkTConE isCons . head . unfoldTAppE $ t
-    sameSymAtRoot t@(TAppE _ _ _)(TListE (_:_) _)       = 
-        chkTConE isCons . head . unfoldTAppE $ t
-    sameSymAtRoot (TListE (_:_) _)(TInfixE _ c _ _)     = chkTConE isCons c
-    sameSymAtRoot (TInfixE _ c _ _)(TListE (_:_) _)     = chkTConE isCons c
hunk ./src/Syntax/Expressions.hs 98
-    root (TTupE _ _)                        = tTupE
-    root e@(TAppE _ _ _)                    = foldTAppE (head.unfoldTAppE $ e)
-    root e@(TListE [] _)                    = const e
-    root (TListE _ lt)                  = 
-        \[l,ls] -> case ls of 
-                    (TListE ls' t) -> TListE (l:ls') t
-                    expr             -> TInfixE l (TConE '(:) $ arrowT [typeOf l, lt, lt]) expr lt
---    root (TCondE e1 e2 e3 t)                = \[e1, e2, e3] -> TCondE e1 e2 e3 t
-    root (TInfixE l c r t)                  = \[l, r] -> tInfixE l c r 
-              
+    root e@(TAppE _ _ _)                    = foldTAppE . head $ unfoldTAppE e
+
hunk ./src/Syntax/Expressions.hs 104
-    subterms (TTupE vals _)                     = vals
hunk ./src/Syntax/Expressions.hs 105
-    subterms (TListE [] _)                      = []
-    subterms (TListE (l:ls) t)                  = [l, TListE ls t] 
hunk ./src/Syntax/Expressions.hs 106
-    subterms (TInfixE l _c r _)   = [l, r]        -- _c is not a subterm, but the root
-    
+
hunk ./src/Syntax/Expressions.hs 157
-isNilList (TListE [] _) = True
hunk ./src/Syntax/Expressions.hs 175
-tInfixE l c r = let
-    ty = arrowT . (drop 2) . unArrowT . typeOf $ c 
-    in TInfixE l c r ty
-    
-tTupE as = TTupE as (tupT (map typeOf as))    
+tInfixE l c r = tAppE (tAppE c l) r
+
+tTupE :: [TExp] -> TExp
+tTupE as = foldTAppE (TConE (tupleDataName (length as)) tupleCtorType) as
+  where asTypes       = map typeOf as
+        tupleCtorType = arrowT (asTypes ++ [tupT asTypes])
hunk ./src/Syntax/Expressions.hs 182
-tListE = TListE
+tListE []     t = TConE '[] t
+tListE (x:xs) t = tAppE (tAppE (TConE '(:) $ arrowT [typeOf x, t, t]) x) (tListE xs t)
hunk ./src/Syntax/Expressions.hs 197
+
hunk ./src/Syntax/Ppr.hs 34
-pprTExp (TInfixE p1 c p2 t) = hsep [ pprTExp p1, pprTExp c, pprTExp p2]
-pprTExp (TTupE es t)        = tupled (map pprTExp es)
-pprTExp (TListE l t)        = list (map pprTExp l)
hunk ./src/Syntax/Ppr.hs 156
-toClause (UnGuardEq ls rs) = TH.Clause (map toPat ls) (TH.NormalB . toExp $ rs) []                               
-           
+toClause (UnGuardEq ls rs) = TH.Clause (map toPat ls) (TH.NormalB . toExp $ rs) []
+
+checkConE :: (Name -> Bool) -> TExp -> Bool
+checkConE f (TConE n _) = f n
+checkConE f _           = False
+
hunk ./src/Syntax/Ppr.hs 165
-toExp (TConE n _)         = TH.ConE n
-toExp (TListE l _)        = TH.ListE (map toExp l)
-toExp (TTupE [e] _)       = toExp e -- not really necessary, but removes parenthesis from 1-ary tuples introduced during cata
-toExp (TTupE l _)         = TH.TupE (map toExp l)
-toExp (TAppE a1 a2 _)     = TH.AppE (toExp a1) (toExp a2)                
-toExp (TInfixE el c er _) = 
-    TH.InfixE (Just . toExp $ el)(toExp c)(Just . toExp $ er)
-    
+toExp (TConE n _) | isNil n = TH.ListE []
+                  | isTuple n 0 = TH.TupE []
+                  | otherwise = TH.ConE n
+toExp e@(TAppE _ _ _)     =
+    let (f:args) = unfoldTAppE e
+    in case (checkConE isCons f, checkConE isAnyTuple f, map toExp args) of
+        (True, _, [x, TH.ListE xs]) -> TH.ListE (x:xs)
+        (True, _, [x, xs])          -> TH.InfixE (Just x) (toExp f) (Just xs)
+        (_,    True, [component])   -> component -- not really necessary, but removes parenthesis from 1-ary tuples introduced during cata
+        (_,    True, components)    -> TH.TupE components
+        (_,    _, argsx)            -> foldl TH.AppE (toExp f) argsx
hunk ./src/Syntax/Ppr.hs 184
-toPat (TConE n _)         = TH.ConP n []
-toPat (TListE l _)        = TH.ListP (map toPat l)
-toPat (TTupE [e] _)       = toPat e
-toPat (TTupE l _)         = TH.TupP (map toPat l)
-toPat e@(TAppE a1 a2 _)   = 
-    let ((TConE n _):as) =  unfoldTAppE e
-    in  TH.ConP n (map toPat as)                
-toPat (TInfixE l (TConE n _) r _) = 
-    TH.InfixP (toPat l) n (toPat r)
---toPat e = error $ "Cannot translate to Pat: " ++ (show e) 
+toPat (TConE n _) | isNil n = TH.ListP []
+                  | isTuple n 0 = TH.TupP []
+                  | otherwise = TH.ConP n []
+toPat e@(TAppE _ _ _)     =
+    let (TConE n _:as) = unfoldTAppE e
+    in case (isCons n, isAnyTuple n, map toPat as) of
+         (True, _, [bp, TH.ListP bsp]) -> TH.ListP (bp : bsp)
+         (True, _, [bp, bsp])          -> TH.InfixP bp n bsp
+         (_,    True, [component])     -> component
+         (_,    True, components)      -> TH.TupP components
+         (_,    _, asp)                -> TH.ConP n asp
+--toPat e = error $ "Cannot translate to Pat: " ++ show e
hunk ./tests/evens.out 28
-             evens        in 24     loops
+             evens        in 27     loops
hunk ./tests/lasts.out 28
-             lasts        in 6     loops
+             lasts        in 7     loops
hunk ./tests/lengths.out 28
-             lengths      in 174     loops
+             lengths      in 12     loops
hunk ./tests/lengths.out 34
-lengths (a0 : a1) = fun1 (a0 : a1) : fun2 (a0 : a1)
+lengths (a0 : a1) = fun1 (a0 : a1) : lengths a1
hunk ./tests/lengths.out 36
-fun1 [_ : a1] = S (fun1 [a1])
-fun1 [_ : a1, _] = S (fun1 [a1])
-fun2 [_] = []
-fun2 [[], a0] = [fun46 [[], a0]]
-fun2 [_ : _, a2] = fun2 [[], a2]
-fun46 [[], []] = Z
-fun46 [[], _ : a1] = S (fun46 [[], a1])
+fun1 ((_ : a1) : a2) = S (fun1 (a1 : a2))
hunk ./tests/mem.out 28
-             mem          in 60     loops
+             mem          in 56     loops
hunk ./tests/mem.out 35
+mem 1 (2 : a0) = mem 1 a0
+mem 1 (3 : a0) = mem 1 a0
hunk ./tests/mem.out 38
+mem 2 (2 : _) = True
hunk ./tests/mem.out 43
-mem 1 (2 : a0) = mem 1 a0
-mem 1 (3 : a0) = mem 1 a0
-mem 2 (2 : _) = True