[project @ 2004-09-30 10:35:15 by simonpj]

[ghc-hetmet.git] / ghc / compiler / stranal / DmdAnal.lhs

diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
index 2c6f394..12b25bc 100644 (file)
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ b/ghc/compiler/stranal/DmdAnal.lhs
@@ -204,7 +204,8 @@ dmdAnal sigs dmd (Lam var body)
     in
     (deferType lam_ty, Lam var' body')
 
-dmdAnal sigs dmd (Case scrut case_bndr [alt@(DataAlt dc,bndrs,rhs)])
+-- gaw 2004
+dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
   | let tycon = dataConTyCon dc,
     isProductTyCon tycon,
     not (isRecursiveTyCon tycon)
@@ -250,16 +251,19 @@ dmdAnal sigs dmd (Case scrut case_bndr [alt@(DataAlt dc,bndrs,rhs)])
 
        (scrut_ty, scrut') = dmdAnal sigs scrut_dmd scrut
     in
-    (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' [alt'])
+-- gaw 2004 
+    (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' ty [alt'])
 
-dmdAnal sigs dmd (Case scrut case_bndr alts)
+-- gaw 2004
+dmdAnal sigs dmd (Case scrut case_bndr ty alts)
   = let
        (alt_tys, alts')        = mapAndUnzip (dmdAnalAlt sigs dmd) alts
        (scrut_ty, scrut')      = dmdAnal sigs evalDmd scrut
        (alt_ty, case_bndr')    = annotateBndr (foldr1 lubType alt_tys) case_bndr
     in
 --    pprTrace "dmdAnal:Case" (ppr alts $$ ppr alt_tys)
-    (alt_ty `bothType` scrut_ty, Case scrut' case_bndr' alts')
+-- gaw 2004
+    (alt_ty `bothType` scrut_ty, Case scrut' case_bndr' ty alts')
 
 dmdAnal sigs dmd (Let (NonRec id rhs) body) 
   = let