Add 'hadrian/' from commit '45f3bff7016a2a0cd9a5455a882ced984655e90b'
[ghc.git] / compiler / coreSyn / CoreTidy.hs
index 325950c..be5e6c1 100644 (file)
@@ -14,11 +14,15 @@ module CoreTidy (
 
 #include "HsVersions.h"
 
+import GhcPrelude
+
 import CoreSyn
+import CoreSeq ( seqUnfolding )
 import CoreArity
 import Id
 import IdInfo
-import Type( tidyType, tidyTyVarBndr )
+import Demand ( zapUsageEnvSig )
+import Type( tidyType, tidyVarBndr )
 import Coercion( tidyCo )
 import Var
 import VarEnv
@@ -54,30 +58,30 @@ 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 (Var v)       = Var (tidyVarOcc env v)
+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 (Tick t e)  Tick (tidyTickish env t) (tidyExpr env e)
-tidyExpr env (Cast e co)  Cast (tidyExpr env e) (tidyCo env co)
+tidyExpr _   (Lit lit)     = Lit lit
+tidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)
+tidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)
+tidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)
 
 tidyExpr env (Let b e)
   = tidyBind env b      =: \ (env', b') ->
     Let b' (tidyExpr env' e)
 
 tidyExpr env (Case e b ty alts)
-  = tidyBndr env b      =: \ (env', b) ->
+  = tidyBndr env b  =: \ (env', b) ->
     Case (tidyExpr env e) b (tidyType env ty)
-         (map (tidyAlt env') alts)
+         (map (tidyAlt env') alts)
 
 tidyExpr env (Lam b e)
   = tidyBndr env b      =: \ (env', b) ->
     Lam b (tidyExpr env' e)
 
 ------------  Case alternatives  --------------
-tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
-tidyAlt _case_bndr env (con, vs, rhs)
+tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
+tidyAlt env (con, vs, rhs)
   = tidyBndrs env vs    =: \ (env', vs) ->
     (con, vs, tidyExpr env' rhs)
 
@@ -126,13 +130,13 @@ tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
 -- tidyBndr is used for lambda and case binders
 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 tidyBndr env var
-  | isTyVar var = tidyTyVarBndr env var
-  | otherwise   = tidyIdBndr env var
+  | isTyCoVar var = tidyVarBndr env var
+  | otherwise     = tidyIdBndr env var
 
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 tidyBndrs env vars = mapAccumL tidyBndr env vars
 
--- Non-top-level variables
+-- Non-top-level variables, not covars
 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
 tidyIdBndr env@(tidy_env, var_env) id
   = -- Do this pattern match strictly, otherwise we end up holding on to
@@ -155,9 +159,7 @@ tidyIdBndr env@(tidy_env, var_env) id
                                  `setOneShotInfo` oneShotInfo old_info
         old_info = idInfo id
         old_unf  = unfoldingInfo old_info
-        new_unf | isEvaldUnfolding old_unf = evaldUnfolding
-                | otherwise                = noUnfolding
-          -- See Note [Preserve evaluatedness]
+        new_unf  = zapUnfolding old_unf  -- See Note [Preserve evaluatedness]
     in
     ((tidy_env', var_env'), id')
    }
@@ -172,7 +174,8 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
     let
         ty'      = tidyType env (idType id)
         name'    = mkInternalName (idUnique id) occ' noSrcSpan
-        id'      = mkLocalIdWithInfo name' ty' new_info
+        details  = idDetails id
+        id'      = mkLocalVar details name' ty' new_info
         var_env' = extendVarEnv var_env id id'
 
         -- Note [Tidy IdInfo]
@@ -186,6 +189,8 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
         --
         -- Similarly for the demand info - on a let binder, this tells
         -- CorePrep to turn the let into a case.
+        -- But: Remove the usage demand here
+        --      (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap)
         --
         -- Similarly arity info for eta expansion in CorePrep
         --
@@ -195,14 +200,15 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
         new_info = vanillaIdInfo
                     `setOccInfo`        occInfo old_info
                     `setArityInfo`      exprArity rhs
-                    `setStrictnessInfo` strictnessInfo old_info
+                    `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)
                     `setDemandInfo`     demandInfo old_info
                     `setInlinePragInfo` inlinePragInfo old_info
                     `setUnfoldingInfo`  new_unf
 
-        new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
-                | otherwise                 = noUnfolding
         old_unf = unfoldingInfo old_info
+        new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
+                | otherwise                 = zapUnfolding old_unf
+                                              -- See Note [Preserve evaluatedness]
     in
     ((tidy_env', var_env'), id') }
 
@@ -217,9 +223,14 @@ 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
+  = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
+    -- This seqIt avoids a space leak: otherwise the uf_is_value,
+    -- uf_is_conlike, ... fields may retain a reference to the
+    -- pre-tidied expression forever (ToIface doesn't look at them)
+
   | otherwise
   = unf_from_rhs
+  where seqIt unf = seqUnfolding unf `seq` unf
 tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
 
 {-
@@ -258,12 +269,11 @@ but that seems more indirect and surprising.)
 
 Note [Preserve OneShotInfo]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 We keep the OneShotInfo because we want it to propagate into the interface.
 Not all OneShotInfo is determined by a compiler analysis; some is added by a
 call of GHC.Exts.oneShot, which is then discarded before the end of the
 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
-must preserve this info in inlinings.
+must preserve this info in inlinings. See Note [The oneShot function] in MkId.
 
 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
 -}