X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreTidy.lhs;h=c825a6a0aadd31fd7ff25f636179899ece35b10d;hb=6677029a5084f59b4cd35d76ce3f19b154f2ac87;hp=037418fe8f7660538d1edca0bda285e240daac60;hpb=661d29564f24a7b19a6c42299461fd8db4922a3f;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 037418f..c825a6a 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -19,8 +19,9 @@ module CoreTidy (
 import CoreSyn
 import CoreUtils	( exprArity )
 import PprCore		( pprIdRules )
-import Id		( Id, mkUserLocal, idInfo, setIdInfo, idUnique, idType, idCoreRules )
-import IdInfo		( vanillaIdInfo, setArityInfo, 
+import Id		( Id, mkUserLocal, idInfo, setIdInfo, idUnique,
+			  idType, idCoreRules )
+import IdInfo		( setArityInfo, vanillaIdInfo,
 			  newStrictnessInfo, setAllStrictnessInfo,
 			  newDemandInfo, setNewDemandInfo )
 import Type		( tidyType, tidyTyVarBndr )
@@ -50,19 +51,17 @@ tidyBind :: TidyEnv
 	 ->  (TidyEnv, CoreBind)
 
 tidyBind env (NonRec bndr rhs)
-  = tidyLetBndr env (bndr,rhs)		=: \ (env', bndr') ->
+  = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
     (env', NonRec bndr' (tidyExpr env' rhs))
 
 tidyBind env (Rec prs)
-  = mapAccumL tidyLetBndr env prs	=: \ (env', bndrs') ->
+  = mapAccumL tidyLetBndr  env prs	=: \ (env', bndrs') ->
     map (tidyExpr env') (map snd prs)	=: \ rhss' ->
     (env', Rec (zip bndrs' rhss'))
 
 
 ------------  Expressions  --------------
-tidyCoreExpr :: CoreExpr -> IO CoreExpr
-tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
-
+tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
 tidyExpr env (Var v)   	=  Var (tidyVarOcc env v)
 tidyExpr env (Type ty) 	=  Type (tidyType env ty)
 tidyExpr env (Lit lit) 	=  Lit lit
@@ -137,8 +136,9 @@ tidyLetBndr env (id,rhs)
   where
     ((tidy_env,var_env), new_id) = tidyIdBndr env id
 
-	-- We need to keep around any interesting strictness and demand info
-	-- because later on we may need to use it when converting to A-normal form.
+	-- We need to keep around any interesting strictness and
+	-- demand info because later on we may need to use it when
+	-- converting to A-normal form.
 	-- eg.
 	--	f (g x),  where f is strict in its argument, will be converted
 	--	into  case (g x) of z -> f z  by CorePrep, but only if f still
@@ -148,9 +148,10 @@ tidyLetBndr env (id,rhs)
 	-- CorePrep to turn the let into a case.
 	--
 	-- Similarly arity info for eta expansion in CorePrep
+	--
     final_id = new_id `setIdInfo` new_info
     idinfo   = idInfo id
-    new_info = vanillaIdInfo 
+    new_info = vanillaIdInfo
 		`setArityInfo`		exprArity rhs
 		`setAllStrictnessInfo`	newStrictnessInfo idinfo
 		`setNewDemandInfo`	newDemandInfo idinfo
@@ -170,11 +171,12 @@ tidyIdBndr env@(tidy_env, var_env) id
 	-- The SrcLoc isn't important now, 
 	-- though we could extract it from the Id
 	-- 
-	-- All nested Ids now have the same IdInfo, namely none,
+	-- All nested Ids now have the same IdInfo, namely vanillaIdInfo,
 	-- which should save some space.
 	-- But note that tidyLetBndr puts some of it back.
         ty'          	  = tidyType env (idType id)
 	id'          	  = mkUserLocal occ' (idUnique id) ty' noSrcLoc
+				`setIdInfo` vanillaIdInfo
 	var_env'	  = extendVarEnv var_env id id'
     in
      ((tidy_env', var_env'), id')
@@ -184,5 +186,3 @@ tidyIdBndr env@(tidy_env, var_env) id
 \begin{code}
 m =: k = m `seq` k m
 \end{code}
-
-