X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreTidy.lhs;h=377bfd8c84cf9dabee556fb58bda0076922ded08;hp=b77186e7f86787386ffbce7136540e5b7a655f3c;hb=febf1ced754a3996ac1a5877dcded87828560d1c;hpb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba

diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs
index b77186e..377bfd8 100644
--- a/compiler/coreSyn/CoreTidy.lhs
+++ b/compiler/coreSyn/CoreTidy.lhs
@@ -8,7 +8,7 @@ The code for *top-level* bindings is in TidyPgm.
 
 \begin{code}
 module CoreTidy (
-	tidyExpr, tidyVarOcc, tidyRule, tidyRules 
+	tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
     ) where
 
 #include "HsVersions.h"
@@ -17,15 +17,15 @@ import CoreSyn
 import CoreArity
 import Id
 import IdInfo
-import Type
+import TcType( tidyType, tidyCo, tidyTyVarBndr )
 import Var
 import VarEnv
 import UniqFM
 import Name hiding (tidyNameOcc)
 import SrcLoc
 import Maybes
-
 import Data.List
+import Outputable
 \end{code}
 
 
@@ -41,11 +41,13 @@ tidyBind :: TidyEnv
 	 ->  (TidyEnv, CoreBind)
 
 tidyBind env (NonRec bndr rhs)
-  = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
+  = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
     (env', NonRec bndr' (tidyExpr env' rhs))
 
 tidyBind env (Rec prs)
-  = mapAccumL tidyLetBndr  env prs	=: \ (env', bndrs') ->
+  = let 
+       (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
+    in
     map (tidyExpr env') (map snd prs)	=: \ rhss' ->
     (env', Rec (zip bndrs' rhss'))
 
@@ -53,11 +55,12 @@ tidyBind env (Rec prs)
 ------------  Expressions  --------------
 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
 tidyExpr env (Var v)   	 =  Var (tidyVarOcc env v)
-tidyExpr env (Type ty) 	 =  Type (tidyType env ty)
+tidyExpr env (Type ty)  =  Type (tidyType env ty)
+tidyExpr env (Coercion co) = Coercion (tidyCo env co)
 tidyExpr _   (Lit lit)   =  Lit lit
 tidyExpr env (App f a) 	 =  App (tidyExpr env f) (tidyExpr env a)
 tidyExpr env (Note n e)  =  Note (tidyNote env n) (tidyExpr env e)
-tidyExpr env (Cast e co) =  Cast (tidyExpr env e) (tidyType env co)
+tidyExpr env (Cast e co) =  Cast (tidyExpr env e) (tidyCo env co)
 
 tidyExpr env (Let b e) 
   = tidyBind env b 	=: \ (env', b') ->
@@ -129,12 +132,17 @@ tidyBndr env var
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 tidyBndrs env vars = mapAccumL tidyBndr env vars
 
-tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
+tidyLetBndr :: TidyEnv	       -- Knot-tied version for unfoldings
+            -> TidyEnv 	       -- The one to extend
+            -> (Id, CoreExpr) -> (TidyEnv, Var)
 -- Used for local (non-top-level) let(rec)s
-tidyLetBndr env (id,rhs) 
-  = ((tidy_env,new_var_env), final_id)
+tidyLetBndr rec_tidy_env env (id,rhs) 
+  = ((tidy_occ_env,new_var_env), final_id)
   where
-    ((tidy_env,var_env), new_id) = tidyIdBndr env id
+    ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
+    new_var_env = extendVarEnv var_env id final_id
+       -- Override the env we get back from tidyId with the 
+       -- new IdInfo so it gets propagated to the usage sites.
 
 	-- We need to keep around any interesting strictness and
 	-- demand info because later on we may need to use it when
@@ -156,12 +164,13 @@ tidyLetBndr env (id,rhs)
     new_info = idInfo new_id
 		`setArityInfo`		exprArity rhs
 		`setStrictnessInfo`	strictnessInfo idinfo
-		`setDemandInfo`	demandInfo idinfo
+		`setDemandInfo`		demandInfo idinfo
 		`setInlinePragInfo`	inlinePragInfo idinfo
+		`setUnfoldingInfo`	new_unf
 
-    -- Override the env we get back from tidyId with the new IdInfo
-    -- so it gets propagated to the usage sites.
-    new_var_env = extendVarEnv var_env id final_id
+    new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
+            | otherwise	            = noUnfolding
+    unf = unfoldingInfo idinfo
 
 -- Non-top-level variables
 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
@@ -185,6 +194,24 @@ tidyIdBndr env@(tidy_env, var_env) id
     in
     ((tidy_env', var_env'), id')
    }
+
+------------ Unfolding  --------------
+tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
+tidyUnfolding tidy_env (DFunUnfolding ar con ids) _
+  = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) ids)
+tidyUnfolding tidy_env 
+              unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
+              unf_from_rhs
+  | isStableSource src
+  = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, 	   -- Preserves OccInfo
+	  uf_src  = tidySrc tidy_env src }
+  | otherwise
+  = unf_from_rhs
+tidyUnfolding _ unf _ = unf	-- NoUnfolding or OtherCon
+
+tidySrc :: TidyEnv -> UnfoldingSource -> UnfoldingSource
+tidySrc tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
+tidySrc _        inl_info          = inl_info
 \end{code}
 
 Note [Tidy IdInfo]