[project @ 2005-03-21 13:57:28 by simonmar]

[ghc-hetmet.git] / ghc / compiler / ndpFlatten / Flattening.hs

diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs
index a28be20..3fc1d55 100644 (file)
--- a/ghc/compiler/ndpFlatten/Flattening.hs
+++ b/ghc/compiler/ndpFlatten/Flattening.hs
@@ -63,11 +63,11 @@ import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
                     mk'indexOfP,mk'eq,mk'neq) 
 
 -- GHC
-import CmdLineOpts  (opt_Flatten)
+import StaticFlags  (opt_Flatten)
 import Panic        (panic)
 import ErrUtils     (dumpIfSet_dyn)
 import UniqSupply   (mkSplitUniqSupply)
-import CmdLineOpts  (DynFlag(..))
+import DynFlags  (DynFlag(..))
 import Literal      (Literal, literalType)
 import Var         (Var(..), idType, isTyVar)
 import Id          (setIdType)
@@ -285,11 +285,12 @@ vectorise (Let bind body) =
     (vbody, vbodyTy) <- vectorise body
     return ((Let vbind vbody), vbodyTy)
 
-vectorise (Case expr b alts) =
+vectorise (Case expr b ty alts) =
   do 
     (vexpr, vexprTy) <- vectorise expr
     valts <- mapM vectorise' alts
-    return (Case vexpr (setIdType b vexprTy) (map fst valts), snd (head valts))
+    let res_ty = snd (head valts)
+    return (Case vexpr (setIdType b vexprTy) res_ty (map fst valts), res_ty)
   where vectorise' (con, bs, expr) = 
           do 
             (vexpr, vexprTy) <- vectorise expr
@@ -441,7 +442,8 @@ lift (Let (Rec binds) expr2) =
 --        otherwise (a) compute index vector for simpleAlts (for def permute
 --                      later on
 --                  (b) 
-lift cExpr@(Case expr b alts)  =
+-- gaw 2004 FIX? 
+lift cExpr@(Case expr b _ alts)  =
   do  
     (lExpr, _) <- lift expr
     lb    <- liftBinderType  b     -- lift alt-expression
@@ -802,7 +804,8 @@ showCoreExpr (Let bnds expr) =
   where showBinds (NonRec b e) = showBind (b,e)
         showBinds (Rec bnds)   = concat (map showBind bnds)
         showBind (b,e) = "  b = " ++ (showCoreExpr e)++ "\n"
-showCoreExpr (Case ex b alts) =
+-- gaw 2004 FIX?
+showCoreExpr (Case ex b ty alts) =
   "Case b = " ++ (showCoreExpr ex) ++ " of \n" ++ (showAlts alts)
   where showAlts _ = ""  
 showCoreExpr (Note _ ex) = "Note n " ++ (showCoreExpr ex)