Remove the (very) old strictness analyser

[ghc-hetmet.git] / compiler / coreSyn / CoreUtils.lhs

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 5dff2c8..9761db1 100644 (file)
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -210,7 +210,7 @@ mkCoerce co expr
 --    if to_ty `coreEqType` from_ty
 --    then expr
 --    else 
-        ASSERT2(from_ty `coreEqType` (exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionKindPredTy co))
+        WARN(not (from_ty `coreEqType` exprType expr), text "Trying to coerce" <+> text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ pprEqPred (coercionKind co))
          (Cast expr co)
 \end{code}
 
@@ -507,17 +507,20 @@ exprIsCheap' is_conlike (Note _ e)        = exprIsCheap' is_conlike e
 exprIsCheap' is_conlike (Cast e _)        = exprIsCheap' is_conlike e
 exprIsCheap' is_conlike (Lam x e)         = isRuntimeVar x
                                             || exprIsCheap' is_conlike e
+
 exprIsCheap' is_conlike (Case e _ _ alts) = exprIsCheap' is_conlike e && 
-                               and [exprIsCheap' is_conlike rhs | (_,_,rhs) <- alts]
+                                           and [exprIsCheap' is_conlike rhs | (_,_,rhs) <- alts]
        -- Experimentally, treat (case x of ...) as cheap
        -- (and case __coerce x etc.)
        -- This improves arities of overloaded functions where
        -- there is only dictionary selection (no construction) involved
+
 exprIsCheap' is_conlike (Let (NonRec x _) e)  
       | isUnLiftedType (idType x) = exprIsCheap' is_conlike e
       | otherwise                = False
-       -- strict lets always have cheap right hand sides,
-       -- and do no allocation.
+       -- Strict lets always have cheap right hand sides,
+       -- and do no allocation, so just look at the body
+       -- Non-strict lets do allocation so we don't treat them as cheap
 
 exprIsCheap' is_conlike other_expr     -- Applications and variables
   = go other_expr []
@@ -725,8 +728,9 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like
       || idArity v > 0         -- Catches (e.g.) primops that don't have unfoldings
       || is_con_unf (idUnfolding v)
        -- Check the thing's unfolding; it might be bound to a value
-       -- A worry: what if an Id's unfolding is just itself: 
-       -- then we could get an infinite loop...
+       -- We don't look through loop breakers here, which is a bit conservative
+       -- but otherwise I worry that if an Id's unfolding is just itself, 
+       -- we could get an infinite loop
 
     is_hnf_like (Lit _)          = True
     is_hnf_like (Type _)         = True       -- Types are honorary Values;
@@ -736,6 +740,7 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like
     is_hnf_like (Cast e _)       = is_hnf_like e
     is_hnf_like (App e (Type _)) = is_hnf_like e
     is_hnf_like (App e a)        = app_is_value e [a]
+    is_hnf_like (Let _ e)        = is_hnf_like e  -- Lazy let(rec)s don't affect us
     is_hnf_like _                = False
 
     -- There is at least one value argument