X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=ec808d484b80880a8af8d86ea20db19a6e84e52b;hb=6084fb5517da34f65034370a3695e2af3b85ce2b;hp=2599f4abef847c2af0980ed9bf1e3c668a5dfc47;hpb=8d6bc9bf51829ea04da5f599b84114ef220f0a19;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 2599f4a..ec808d4 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -23,7 +23,7 @@ module CoreUtils (
 	findDefault, findAlt, isDefaultAlt, mergeAlts, trimConArgs,
 
 	-- Properties of expressions
-	exprType, coreAltType,
+	exprType, coreAltType, coreAltsType,
 	exprIsDupable, exprIsTrivial, exprIsCheap, 
 	exprIsHNF,exprOkForSpeculation, exprIsBig, 
 	exprIsConApp_maybe, exprIsBottom,
@@ -109,6 +109,10 @@ exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
 
 coreAltType :: CoreAlt -> Type
 coreAltType (_,_,rhs) = exprType rhs
+
+coreAltsType :: [CoreAlt] -> Type
+coreAltsType (alt:_) = coreAltType alt
+coreAltsType []	     = panic "corAltsType"
 \end{code}
 
 @mkPiType@ makes a (->) type or a forall type, depending on whether
@@ -674,9 +678,9 @@ app_is_value _          _  = False
 dataConRepInstPat, dataConOrigInstPat :: [Unique] -> DataCon -> [Type] -> ([TyVar], [CoVar], [Id])
 dataConRepFSInstPat :: [FastString] -> [Unique] -> DataCon -> [Type] -> ([TyVar], [CoVar], [Id])
 -- These InstPat functions go here to avoid circularity between DataCon and Id
-dataConRepInstPat   = dataConInstPat dataConRepArgTys (repeat (FSLIT("ipv")))
+dataConRepInstPat   = dataConInstPat dataConRepArgTys (repeat ((fsLit "ipv")))
 dataConRepFSInstPat = dataConInstPat dataConRepArgTys
-dataConOrigInstPat  = dataConInstPat dc_arg_tys       (repeat (FSLIT("ipv")))
+dataConOrigInstPat  = dataConInstPat dc_arg_tys       (repeat ((fsLit "ipv")))
   where 
     dc_arg_tys dc = map mkPredTy (dataConEqTheta dc) ++ map mkPredTy (dataConDictTheta dc) ++ dataConOrigArgTys dc
 	-- Remember to include the existential dictionaries
@@ -993,8 +997,8 @@ arityType :: DynFlags -> CoreExpr -> ArityType
 
 arityType dflags (Note _ e) = arityType dflags e
 --	Not needed any more: etaExpand is cleverer
---  | ok_note n = arityType dflags e
---  | otherwise = ATop
+-- removed: | ok_note n = arityType dflags e
+-- removed: | otherwise = ATop
 
 arityType dflags (Cast e _) = arityType dflags e
 
@@ -1114,7 +1118,6 @@ etaExpand n us expr ty
   | manifestArity expr >= n = expr		-- The no-op case
   | otherwise 		    
   = eta_expand n us expr ty
-  where
 
 -- manifestArity sees how many leading value lambdas there are
 manifestArity :: CoreExpr -> Arity
@@ -1175,7 +1178,7 @@ eta_expand n us expr ty
 
               Lam lam_tv (eta_expand n us2 (App expr (Type (mkTyVarTy lam_tv))) (substTyWith [tv] [mkTyVarTy lam_tv] ty'))
                   where 
-                    lam_tv = setVarName tv (mkSysTvName uniq FSLIT("etaT"))
+                    lam_tv = setVarName tv (mkSysTvName uniq (fsLit "etaT"))
 			-- Using tv as a base retains its tyvar/covar-ness
                     (uniq:us2) = us 
  	; Nothing ->
@@ -1183,7 +1186,7 @@ eta_expand n us expr ty
     	case splitFunTy_maybe ty of {
  	  Just (arg_ty, res_ty) -> Lam arg1 (eta_expand (n-1) us2 (App expr (Var arg1)) res_ty)
 				where
-				   arg1	      = mkSysLocal FSLIT("eta") uniq arg_ty
+				   arg1	      = mkSysLocal (fsLit "eta") uniq arg_ty
  				   (uniq:us2) = us
 				   
 	; Nothing ->
@@ -1435,7 +1438,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