More work on the simplifier's inlining strategies

[ghc-hetmet.git] / compiler / iface / TcIface.lhs

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 689dd4b..2ec9de9 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -40,6 +40,7 @@ import DataCon
 import TysWiredIn
 import TysPrim         ( anyTyConOfKind )
 import Var              ( TyVar )
+import BasicTypes      ( nonRuleLoopBreaker )
 import qualified Var
 import VarEnv
 import Name
@@ -989,12 +990,15 @@ tcIdInfo ignore_prags name ty info
     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str) = return (info `setAllStrictnessInfo` Just str)
+    tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
 
        -- The next two are lazy, so they don't transitively suck stuff in
-    tcPrag info (HsUnfold if_unf)  = do { unf <- tcUnfolding name ty info if_unf
-                                       ; return (info `setUnfoldingInfoLazily` unf) }
+    tcPrag info (HsUnfold lb if_unf) 
+      = do { unf <- tcUnfolding name ty info if_unf
+          ; let info1 | lb        = info `setOccInfo` nonRuleLoopBreaker
+                      | otherwise = info
+          ; return (info1 `setUnfoldingInfoLazily` unf) }
 \end{code}
 
 \begin{code}
@@ -1005,14 +1009,11 @@ tcUnfolding name _ _ (IfCoreUnfold if_expr)
                    Nothing -> NoUnfolding
                    Just expr -> mkTopUnfolding expr) }
 
-tcUnfolding name _ _ (IfInlineRule arity sat if_expr)
+tcUnfolding name _ _ (IfInlineRule arity unsat_ok if_expr)
   = do         { mb_expr <- tcPragExpr name if_expr
        ; return (case mb_expr of
                    Nothing   -> NoUnfolding
-                   Just expr -> mkInlineRule inl_info expr arity) }
-  where
-    inl_info | sat       = InlSat
-            | otherwise = InlUnSat
+                   Just expr -> mkInlineRule unsat_ok expr arity) }
 
 tcUnfolding name ty info (IfWrapper arity wkr)
   = do         { mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
@@ -1030,7 +1031,7 @@ tcUnfolding name ty info (IfWrapper arity wkr)
 
        -- We are relying here on strictness info always appearing 
        -- before worker info,  fingers crossed ....
-    strict_sig = case newStrictnessInfo info of
+    strict_sig = case strictnessInfo info of
                   Just sig -> sig
                   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 
@@ -1215,7 +1216,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
     tc_info [] = vanillaIdInfo
     tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p 
     tc_info (HsArity a      : i) = tc_info i `setArityInfo` a 
-    tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s 
+    tc_info (HsStrictness s : i) = tc_info i `setStrictnessInfo` Just s 
     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
                                            (ppr other) (tc_info i)