X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=eb9ea41b2cf2564abddbbf1cba0162df4a1127a2;hb=7e8cba32c6f045dde3db8a9ddc9831ec8ab4ed43;hp=0fe04cbd2b8b559f01c55c1faef1516fb6a0b728;hpb=a26a4f61262227c1efcf608b94e3ce20c660b50c;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 0fe04cb..eb9ea41 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -18,7 +18,7 @@ module CoreUtils (
 	-- * Constructing expressions
 	mkInlineMe, mkSCC, mkCoerce, mkCoerceI,
 	bindNonRec, needsCaseBinding,
-	mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes,
+	mkAltExpr, mkPiType, mkPiTypes,
 
 	-- * Taking expressions apart
 	findDefault, findAlt, isDefaultAlt, mergeAlts, trimConArgs,
@@ -71,7 +71,6 @@ import NewDemand
 import Type
 import Coercion
 import TyCon
-import TysWiredIn
 import CostCentre
 import BasicTypes
 import Unique
@@ -154,12 +153,16 @@ applyTypeToArgs e op_ty (Type ty : args)
     go rev_tys (Type ty : args) = go (ty:rev_tys) args
     go rev_tys rest_args        = applyTypeToArgs e op_ty' rest_args
 			 	where
-				  op_ty' = applyTys op_ty (reverse rev_tys)
+				  op_ty' = applyTysD msg op_ty (reverse rev_tys)
+				  msg = panic_msg e op_ty
 
 applyTypeToArgs e op_ty (_ : args)
   = case (splitFunTy_maybe op_ty) of
 	Just (_, res_ty) -> applyTypeToArgs e res_ty args
-	Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e $$ ppr op_ty)
+	Nothing -> pprPanic "applyTypeToArgs" (panic_msg e op_ty)
+
+panic_msg :: CoreExpr -> Type -> SDoc
+panic_msg e op_ty = pprCoreExpr e $$ ppr op_ty
 \end{code}
 
 %************************************************************************
@@ -294,13 +297,6 @@ mkAltExpr (LitAlt lit) [] []
   = Lit lit
 mkAltExpr (LitAlt _) _ _ = panic "mkAltExpr LitAlt"
 mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT"
-
-mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
-mkIfThenElse guard then_expr else_expr
--- Not going to be refining, so okay to take the type of the "then" clause
-  = Case guard (mkWildId boolTy) (exprType then_expr) 
-	 [ (DataAlt falseDataCon, [], else_expr),	-- Increasing order of tag!
-    	   (DataAlt trueDataCon,  [], then_expr) ]
 \end{code}
 
 
@@ -1474,7 +1470,7 @@ hashExpr :: CoreExpr -> Int
 hashExpr e = fromIntegral (hash_expr (1,emptyVarEnv) e .&. 0x7fffffff)
              -- UniqFM doesn't like negative Ints
 
-type HashEnv = (Int, VarEnv Int)  -- ^ Hash code for bound variables
+type HashEnv = (Int, VarEnv Int)  -- Hash code for bound variables
 
 hash_expr :: HashEnv -> CoreExpr -> Word32
 -- Word32, because we're expecting overflows here, and overflowing