X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FndpFlatten%2FFlattening.hs;h=276b6a96d1e802b5c6425362bd61501fbbdd3462;hb=1f19d1989866ec3c42083e5a4612248842f07814;hp=ccced5a9f070d1bcf340dc0331bd2fc087da1970;hpb=f714e6b642fd614a9971717045ae47c3d871275e;p=ghc-hetmet.git

diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs
index ccced5a..276b6a9 100644
--- 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
@@ -651,8 +653,7 @@ dftbpBinders indexBnds exprBnds =
 	return ((fBnd, (newBnd:restBnds)), liftTy ty)
 
     dftbpBinders'  _ _ _ = 
-      panic "Flattening.dftbpBinders: index and expression binder lists \ 
-	    \have different length!"
+      panic "Flattening.dftbpBinders: index and expression binder lists have different length!"
 
 getExprOfBind:: CoreBind -> CoreExpr
 getExprOfBind (NonRec _ expr) = expr
@@ -754,7 +755,7 @@ mkIndexOfExprDft idType b lits =
 
 -- create a back-permute binder
 --
--- * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a
+--  * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a
 --   Core binding of the form
 --
 --     x = bpermuteDftP indexArrayVar srcArrayVar dftArrayVar
@@ -803,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)