[add type of expression field to ECase to help typechecking of GADT and typecase case statements
John Meacham <john@repetae.net>**20060222044821] hunk ./E/Annotate.hs 87
-        return  ECase { eCaseScrutinee = e', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts }
+        t' <- f (eCaseType ec)
+        return  ECase { eCaseScrutinee = e', eCaseType = t', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts }
hunk ./E/E.hs 73
+       eCaseType :: E, -- due to GADTs and typecases, the final type of the expression might not be so obvious, so we include it here.
hunk ./E/E.hs 317
-caseBodiesMapM f (ECase e b as d) = do
+caseBodiesMapM f ec@ECase { eCaseAlts = as, eCaseDefault = d } = do
hunk ./E/E.hs 321
-    return $ ECase e b as' d'
+    return $ ec { eCaseAlts = as', eCaseDefault = d' }
hunk ./E/FreeVars.hs 73
-    fv (ECase e b as d) = IM.unions ( fv e:freeVars (getTyp  b):(IM.delete (tvrNum b) $ IM.unions (freeVars d:map freeVars as)  ):[])
+    fv ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d, eCaseType = ty } = IM.unions ( fv e:freeVars (getTyp  b):freeVars ty:(IM.delete (tvrNum b) $ IM.unions (freeVars d:map freeVars as)  ):[])
hunk ./E/FreeVars.hs 93
-    fv (ECase e b as d) = Set.unions ( fv e:freeVars (getTyp  b):(Set.delete b $ Set.unions (freeVars d:map freeVars as)  ):[])
+    fv ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d, eCaseType = ty } =Set.unions ( fv e:freeVars ty:freeVars (getTyp  b):(Set.delete b $ Set.unions (freeVars d:map freeVars as)  ):[])
hunk ./E/FreeVars.hs 114
-    fv (ECase e b as d) = Map.unions ( fv e:freeVars' (getTyp  b):(Map.delete (tvrNum b) $ Map.unions (freeVars d:map freeVars as)  ):[])
+    fv ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d, eCaseType = ty } = Map.unions ( fv e:freeVars' ty:freeVars' (getTyp  b):(Map.delete (tvrNum b) $ Map.unions (freeVars d:map freeVars as)  ):[])
hunk ./E/FromHs.hs 261
-unbox dataTable e vn wtd = ECase e (tVr 0 te) [Alt (LitCons cna [tvra] te) (wtd tvra)] Nothing where
+unbox dataTable e vn wtd = eCase e [Alt (LitCons cna [tvra] te) (wtd tvra)] Unknown where
hunk ./E/FromHs.hs 273
-    esr (tvr,n',(cn,st,_)) e = ECase (EVar tvr) (tVr 0 te) [Alt (LitCons cn [tVr n' st] te) e] Nothing  where
+    esr (tvr,n',(cn,st,_)) e = eCase (EVar tvr) [Alt (LitCons cn [tVr n' st] te) e] Unknown  where
hunk ./E/Inline.hs 104
-    caseBodiesMapM f ec
+    ec' <- caseBodiesMapM f ec
+    let t = foldl eAp (eCaseType ec') xs
+    return ec' { eCaseType = t }
hunk ./E/Inline.hs 150
-    z (ECase e b as d) = do
-        e' <- f e
-        b' <- fmapM g b
-        as' <- mapM mapmAlt as
-        d' <- fmapM f d
-        return (ECase e' b' as' d')
+    z ec@ECase {} = do
+        e' <- f $ eCaseScrutinee ec
+        b' <- fmapM g (eCaseBind ec)
+        as' <- mapM mapmAlt (eCaseAlts ec)
+        d' <- fmapM f (eCaseDefault ec)
+        t' <- g (eCaseType ec)
+        return ECase { eCaseScrutinee =e', eCaseBind = b', eCaseAlts = as', eCaseDefault = d', eCaseType = t'}
hunk ./E/LambdaLift.hs 75
-        g (ECase (EVar v) b as d) | sortStarLike (tvrType v) = do
+        g ec@ECase { eCaseScrutinee = (EVar v), eCaseAlts = as, eCaseDefault = d} | sortStarLike (tvrType v) = do
hunk ./E/LambdaLift.hs 82
-            return $ ECase (EVar v) b as' d'
+            return ec { eCaseAlts = as', eCaseDefault = d'}
hunk ./E/LetFloat.hs 103
-    f (ECase e b as d) xs = letRec p' $ ECase (f e pe) b [ Alt l (f e pn) | Alt l e <- as | pn <- ps ] (fmap (flip f pd) d)  where
+    f ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault =  d } xs = letRec p' $ ec { eCaseScrutinee = (f e pe), eCaseAlts = [ Alt l (f e pn) | Alt l e <- as | pn <- ps ], eCaseDefault = (fmap (flip f pd) d)}  where
hunk ./E/PrimOpt.hs 28
-create_integralCast dataTable e t = ECase e (tVr 0 te) [Alt (LitCons cna [tvra] te) cc] Nothing  where
+create_integralCast dataTable e t = eCase e [Alt (LitCons cna [tvra] te) cc] Unknown  where
hunk ./E/PrimOpt.hs 39
-unbox dataTable e vn wtd = ECase e (tVr 0 te) [Alt (LitCons cna [tvra] te) (wtd tvra)] Nothing where
+unbox dataTable e vn wtd = eCase e  [Alt (LitCons cna [tvra] te) (wtd tvra)] Unknown where
hunk ./E/SSimplify.hs 79
-    f ec@(ECase e b as d) = do
+    f ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d} = do
hunk ./E/SSimplify.hs 86
-        return (ECase e' b as' d', fvs, sa `andOM` orMaps (sb:ass) )
+        return (ec { eCaseScrutinee = e', eCaseAlts = as', eCaseDefault = d'}, fvs, sa `andOM` orMaps (sb:ass) )
hunk ./E/SSimplify.hs 241
-    g ec@(ECase e b as d) sub inb = do
+    g ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d} sub inb = do
hunk ./E/SSimplify.hs 244
-        doCase e' b as d sub inb
+        doCase e' (eCaseType ec) b as d sub inb
hunk ./E/SSimplify.hs 330
-    doCase (ELetRec ds e) b as d sub inb = do
+    doCase (ELetRec ds e) t b as d sub inb = do
hunk ./E/SSimplify.hs 332
-        e' <- doCase e b as d sub inb
+        e' <- doCase e t b as d sub inb
hunk ./E/SSimplify.hs 335
-    doCase (EVar v) b as d sub inb |  Just (IsBoundTo _ (ELit l)) <- Map.lookup (tvrNum v) (envInScope inb)  = doConstCase l b as d sub inb
-    doCase (ELit l) b as d sub inb  = doConstCase l b as d sub inb
+    doCase (EVar v) t b as d sub inb |  Just (IsBoundTo _ (ELit l)) <- Map.lookup (tvrNum v) (envInScope inb)  = doConstCase l t  b as d sub inb
+    doCase (ELit l) t b as d sub inb  = doConstCase l t b as d sub inb
hunk ./E/SSimplify.hs 338
-    doCase (EVar v) b as d sub inb | Just (IsBoundTo _ e) <- Map.lookup (tvrNum v) (envInScope inb) , isBottom e = do
+    doCase (EVar v) t b as d sub inb | Just (IsBoundTo _ e) <- Map.lookup (tvrNum v) (envInScope inb) , isBottom e = do
hunk ./E/SSimplify.hs 340
-        let t = getType (ECase (EVar v) b as d)
hunk ./E/SSimplify.hs 343
-    doCase ic@(ECase e b as d) b' as' d' sub inb | length (filter (not . isBottom) (caseBodies ic)) <= 1 || all whnfOrBot (caseBodies ic)  || all whnfOrBot (caseBodies (ECase Unknown b' as' d'))  = do
+    doCase ic@ECase { eCaseScrutinee = e, eCaseBind =  b, eCaseAlts =  as, eCaseDefault =  d } t b' as' d' sub inb | length (filter (not . isBottom) (caseBodies ic)) <= 1 || all whnfOrBot (caseBodies ic)  || all whnfOrBot (caseBodies emptyCase { eCaseAlts = as', eCaseDefault = d'} )  = do
hunk ./E/SSimplify.hs 346
-                e' <- doCase e b' as' d' sub (envInScope_u (Map.fromList [ (n,NotKnown) | TVr { tvrIdent = n } <- litBinds l ] `Map.union`) inb)
+                e' <- doCase e t b' as' d' sub (envInScope_u (Map.fromList [ (n,NotKnown) | TVr { tvrIdent = n } <- litBinds l ] `Map.union`) inb)
hunk ./E/SSimplify.hs 349
-            g x = doCase x b' as' d' sub (envInScope_u (Map.insert (tvrNum b) NotKnown) inb)
+            g x = doCase x t b' as' d' sub (envInScope_u (Map.insert (tvrNum b) NotKnown) inb)
hunk ./E/SSimplify.hs 352
-        return (ECase e b as'' d'')      -- we duplicate code so continue for next renaming pass before going further.
-    doCase e b as d sub inb | isBottom e = do
+        return ECase { eCaseScrutinee = e, eCaseType = t, eCaseBind = b, eCaseAlts = as'', eCaseDefault = d''} -- XXX     -- we duplicate code so continue for next renaming pass before going further.
+    doCase e t b as d sub inb | isBottom e = do
hunk ./E/SSimplify.hs 355
-        let t = getType (ECase e b as d)
hunk ./E/SSimplify.hs 358
-    doCase e b as@(Alt (LitCons n _ _) _:_) (Just d) sub inb | Just ss <- getSiblings (so_dataTable sopts) n, length ss <= length as = do
+    doCase e t b as@(Alt (LitCons n _ _) _:_) (Just d) sub inb | Just ss <- getSiblings (so_dataTable sopts) n, length ss <= length as = do
hunk ./E/SSimplify.hs 360
-        doCase e b as Nothing sub inb
-    doCase e b as (Just d) sub inb | te /= tWorld__, (ELit (LitCons cn _ _)) <- followAliases dt te, Just Constructor { conChildren = Just cs } <- getConstructor cn dt, length as == length cs - 1 || (False && length as < length cs && isAtomic d)  = do
+        doCase e t b as Nothing sub inb
+    doCase e t b as (Just d) sub inb | te /= tWorld__, (ELit (LitCons cn _ _)) <- followAliases dt te, Just Constructor { conChildren = Just cs } <- getConstructor cn dt, length as == length cs - 1 || (False && length as < length cs && isAtomic d)  = do
hunk ./E/SSimplify.hs 374
-        doCase e b (as ++ ls') Nothing sub inb
+        doCase e t b (as ++ ls') Nothing sub inb
hunk ./E/SSimplify.hs 378
-    doCase e b [] (Just d) sub inb | not (isLifted e || isUnboxed (getType e)) = do
+    doCase e _ b [] (Just d) sub inb | not (isLifted e || isUnboxed (getType e)) = do
hunk ./E/SSimplify.hs 383
-    doCase (EVar v) b [] (Just d) sub inb | Just (NotAmong _) <-  Map.lookup (tvrNum v) (envInScope inb)  = do
+    doCase (EVar v) _ b [] (Just d) sub inb | Just (NotAmong _) <-  Map.lookup (tvrNum v) (envInScope inb)  = do
hunk ./E/SSimplify.hs 387
-    doCase scrut v [] (Just sc@ECase { eCaseScrutinee = EVar v'} ) sub inb | v == v', not $ tvrNum v `Set.member` freeVars (caseBodies sc)  = do
+    doCase scrut _ v [] (Just sc@ECase { eCaseScrutinee = EVar v'} ) sub inb | v == v', not $ tvrNum v `Set.member` freeVars (caseBodies sc)  = do
hunk ./E/SSimplify.hs 390
-    doCase e b as d sub inb = do
+    doCase e t b as d sub inb = do
hunk ./E/SSimplify.hs 413
-        return $ ECase e b' as' d'
+        t' <- dosub sub t
+        return ECase { eCaseScrutinee = e, eCaseType = t', eCaseBind =  b', eCaseAlts = as', eCaseDefault = d'}
hunk ./E/SSimplify.hs 416
-    doConstCase l b as d sub inb = do
+    doConstCase l t b as d sub inb = do
hunk ./E/SSimplify.hs 425
-                let t = getType (ECase (ELit l) b as d)
hunk ./E/Strictness.hs 128
-    f ec@(ECase e b as d) = do
+    f ec@ECase { eCaseScrutinee = e, eCaseBind =  b, eCaseAlts = as, eCaseDefault = d} = do
hunk ./E/Subst.hs 104
-        return  ECase { eCaseScrutinee = e', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts }
+        nty <- f (eCaseType ec)
+        return  ec { eCaseScrutinee = e', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts, eCaseType = nty }
hunk ./E/Subst.hs 222
-        return  ECase { eCaseScrutinee = e', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts }
+        nty <- inType (f $ eCaseType ec)
+        return  ec { eCaseScrutinee = e', eCaseDefault = d, eCaseBind = b', eCaseAlts = alts, eCaseType = nty }
hunk ./E/Traverse.hs 154
-    g ec@(ECase e b as d) = do
+    g ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d} = do
hunk ./E/Traverse.hs 156
+        t' <- f' (eCaseType ec)
hunk ./E/Traverse.hs 162
-            return $ ECase e' b' as' d'
+            return $ ec { eCaseScrutinee = e', eCaseType = t', eCaseBind = b', eCaseAlts = as', eCaseDefault = d' }
hunk ./E/TypeCheck.hs 33
-typ (ECase {eCaseScrutinee = e, eCaseDefault = Just d}) | sortTypeLike e = typ d
-typ (ECase {eCaseAlts = (x:_)}) = getType x
-typ (ECase {eCaseDefault = Just e}) = typ e
-typ (ECase _ _ [] Nothing) = error "empty case"
+typ ECase {eCaseScrutinee = e, eCaseDefault = Just d} | sortTypeLike e = typ d
+typ ECase {eCaseAlts = (x:_)} = getType x
+typ ECase {eCaseDefault = Just e} = typ e
+typ ECase {eCaseAlts = [], eCaseDefault =  Nothing} = error "empty case"
hunk ./E/TypeCheck.hs 106
-    fc ec@(ECase e@ELit {} b as (Just d)) | sortTypeLike e = do   -- TODO - this is a hack to get around case of constants.
+    fc ec@ECase { eCaseScrutinee = e@ELit {}, eCaseBind = b, eCaseAlts = as, eCaseDefault =  (Just d) } | sortTypeLike e = do   -- TODO - this is a hack to get around case of constants.
hunk ./E/TypeCheck.hs 115
-    fc ec@(ECase e b as (Just d)) | sortTypeLike e  = do   -- TODO - we should substitute the tested for value into the default type.
+    fc ec@ECase {eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = Just d} | sortTypeLike e  = do   -- TODO - we should substitute the tested for value into the default type.
hunk ./E/TypeCheck.hs 126
-    fc ec@(ECase e b _ _) = do
+    fc ec@ECase { eCaseScrutinee =e, eCaseBind = b } = do
hunk ./E/TypeCheck.hs 269
-    fc ec@(ECase e b as (Just d)) | sortTypeLike e  = do   -- TODO - we should substitute the tested for value into the default type.
+    fc ec@ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = Just d} | sortTypeLike e  = do   -- TODO - we should substitute the tested for value into the default type.
hunk ./E/TypeCheck.hs 272
-    fc ec@(ECase e b _ _) = do
+    fc ec@ECase { eCaseScrutinee = e, eCaseBind = b } = do
hunk ./E/Values.hs 30
-eIf e a b = ECase { eCaseScrutinee = e, eCaseBind = (tVr 0 tBool),  eCaseAlts =  [Alt vTrue a,Alt vFalse b], eCaseDefault = Nothing }
+eIf e a b = ECase { eCaseScrutinee = e, eCaseType = getType a, eCaseBind = (tVr 0 tBool),  eCaseAlts =  [Alt vTrue a,Alt vFalse b], eCaseDefault = Nothing }
hunk ./E/Values.hs 106
-eCaseTup e vs w = ECase e (tVr 0 (getType e)) [Alt (LitCons (nameTuple DataConstructor (length vs)) vs (getType e)) w] Nothing
-eCaseTup' e vs w = ECase e (tVr 0 (getType e)) [Alt (LitCons (unboxedNameTuple DataConstructor (length vs)) vs (getType e)) w] Nothing
+emptyCase = ECase { eCaseDefault = Nothing, eCaseAlts = [], eCaseBind = error "emptyCase: bind", eCaseType = error "emptyCase: type", eCaseScrutinee = error "emptyCase: scrutinee" }
+
+eCaseTup e vs w = emptyCase { eCaseScrutinee = e, eCaseBind =  (tVr 0 (getType e)), eCaseType = getType w, eCaseAlts =  [Alt (LitCons (nameTuple DataConstructor (length vs)) vs (getType e)) w] }
+eCaseTup' e vs w = emptyCase { eCaseScrutinee = e, eCaseBind = (tVr 0 (getType e)), eCaseType = getType w, eCaseAlts =  [Alt (LitCons (unboxedNameTuple DataConstructor (length vs)) vs (getType e)) w] }
hunk ./E/Values.hs 114
-eCase e alts Unknown = ECase { eCaseScrutinee = e, eCaseBind = (tVr 0 (getType e)), eCaseDefault = Nothing, eCaseAlts =  alts }
-eCase e alts els = ECase { eCaseScrutinee = e, eCaseBind = (tVr 0 (getType e)), eCaseDefault = Just els, eCaseAlts =  alts }
+eCase e alts@(alt:_) Unknown = emptyCase { eCaseScrutinee = e, eCaseBind = (tVr 0 (getType e)), eCaseType = getType alt,  eCaseAlts =  alts }
+eCase e alts els = emptyCase { eCaseScrutinee = e, eCaseBind = (tVr 0 (getType e)), eCaseDefault = Just els, eCaseAlts =  alts, eCaseType = getType els }
hunk ./E/Values.hs 129
-eStrictLet t v e = ECase v t [] (Just e)
+eStrictLet t v e = emptyCase { eCaseScrutinee = v, eCaseBind = t, eCaseDefault = Just e, eCaseType = getType e }
hunk ./E/Values.hs 181
-prim_seq a b = ECase a (tVr 0 (getType a)) [] (Just b)
+prim_seq a b = emptyCase { eCaseScrutinee = a, eCaseBind =  (tVr 0 (getType a)), eCaseDefault = Just b, eCaseType = getType b }
hunk ./Grin/FromE.hs 362
-    ce (ECase e _ [Alt (LitCons n xs _) wh] _) | Just _ <- fromUnboxedNameTuple n, DataConstructor <- nameType n  = do
+    ce ECase { eCaseScrutinee = e, eCaseAlts = [Alt (LitCons n xs _) wh] } | Just _ <- fromUnboxedNameTuple n, DataConstructor <- nameType n  = do
hunk ./Grin/FromE.hs 366
-    ce (ECase e _ [] (Just r)) | getType e == tWorld__ = do
+    ce ECase { eCaseScrutinee = e, eCaseAlts = [], eCaseDefault = (Just r)} | getType e == tWorld__ = do
hunk ./Grin/FromE.hs 370
-    ce (ECase e b as d) | (ELit (LitCons n [] _)) <- getType e, RawType <- nameType n = do
+    ce ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d } | (ELit (LitCons n [] _)) <- getType e, RawType <- nameType n = do
hunk ./Grin/FromE.hs 378
-    ce (ECase e b as d)  = do
+    ce ECase { eCaseScrutinee = e, eCaseBind = b, eCaseAlts = as, eCaseDefault = d }  = do
hunk ./data/PrimitiveOperators-in.hs 26
-unbox' e cn tvr wtd = ECase e (tVr 0 te) [Alt (LitCons cn [tvr] te) wtd] Nothing where
+unbox' e cn tvr wtd = eCase e [Alt (LitCons cn [tvr] te) wtd] Unknown where