Remove the (very) old strictness analyser

[ghc-hetmet.git] / compiler / simplCore / Simplify.lhs

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index 5e63221..875061d 100644 (file)
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -23,7 +23,7 @@ import Coercion
 import FamInstEnv       ( topNormaliseType )
 import DataCon          ( DataCon, dataConWorkId, dataConRepStrictness )
 import CoreSyn
-import NewDemand        ( isStrictDmd, splitStrictSig )
+import Demand           ( isStrictDmd, splitStrictSig )
 import PprCore          ( pprParendExpr, pprCoreExpr )
 import CoreUnfold       ( mkUnfolding, mkCoreUnfolding, mkInlineRule, 
                           exprIsConApp_maybe, callSiteInline, CallCtxt(..) )
@@ -35,8 +35,7 @@ import BasicTypes       ( isMarkedStrict, Arity )
 import CostCentre       ( currentCCS, pushCCisNop )
 import TysPrim          ( realWorldStatePrimTy )
 import PrelInfo         ( realWorldPrimId )
-import BasicTypes       ( TopLevelFlag(..), isTopLevel,
-                          RecFlag(..), isNonRuleLoopBreaker )
+import BasicTypes       ( TopLevelFlag(..), isTopLevel, RecFlag(..) )
 import MonadUtils      ( foldlM, mapAccumLM )
 import Maybes           ( orElse )
 import Data.List        ( mapAccumL )
@@ -443,8 +442,8 @@ prepareRhs env id (Cast rhs co)    -- Note [Float coercions]
   = do  { (env', rhs') <- makeTrivialWithInfo env sanitised_info rhs
         ; return (env', Cast rhs' co) }
   where
-    sanitised_info = vanillaIdInfo `setNewStrictnessInfo` newStrictnessInfo info
-                                   `setNewDemandInfo`     newDemandInfo info
+    sanitised_info = vanillaIdInfo `setStrictnessInfo` strictnessInfo info
+                                   `setDemandInfo`     demandInfo info
     info = idInfo id
 
 prepareRhs env0 _ rhs0
@@ -645,7 +644,7 @@ addNonRecWithUnf env new_bndr new_rhs new_unfolding
               | otherwise                      = info2
 
         final_id = new_bndr `setIdInfo` info3
-       dmd_arity = length $ fst $ splitStrictSig $ idNewStrictness new_bndr
+       dmd_arity = length $ fst $ splitStrictSig $ idStrictness new_bndr
     in
     ASSERT( isId new_bndr )
     WARN( new_arity < old_arity || new_arity < dmd_arity, 
@@ -680,11 +679,14 @@ simplUnfolding env top_lvl _ _ _
                                  (guide { ir_info = mb_wkr' })) }
                -- See Note [Top-level flag on inline rules] in CoreUnfold
 
-simplUnfolding _ top_lvl _ occ_info new_rhs _
-  | omit_unfolding = return NoUnfolding        
-  | otherwise     = return (mkUnfolding (isTopLevel top_lvl) new_rhs)
-  where
-    omit_unfolding = isNonRuleLoopBreaker occ_info
+simplUnfolding _ top_lvl _ _occ_info new_rhs _
+  = return (mkUnfolding (isTopLevel top_lvl) new_rhs)
+  -- We make an  unfolding *even for loop-breakers*.
+  -- Reason: (a) It might be useful to know that they are WHNF
+  --        (b) In TidyPgm we currently assume that, if we want to
+  --            expose the unfolding then indeed we *have* an unfolding
+  --            to expose.  (We could instead use the RHS, but currently
+  --            we don't.)  The simple thing is always to have one.
 \end{code}
 
 Note [Arity decrease]
@@ -1466,7 +1468,7 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
   where
         -- The case binder is going to be evaluated later,
         -- and the scrutinee is a simple variable
-    var_demanded_later (Var v) = isStrictDmd (idNewDemandInfo case_bndr)
+    var_demanded_later (Var v) = isStrictDmd (idDemandInfo case_bndr)
                                  && not (isTickBoxOp v)
                                     -- ugly hack; covering this case is what
                                     -- exprOkForSpeculation was intended for.