Remove the (very) old strictness analyser
[ghc-hetmet.git] / compiler / coreSyn / CoreSyn.lhs
index 01e2be7..0724630 100644 (file)
@@ -35,7 +35,7 @@ module CoreSyn (
        isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
 
        -- * Unfolding data types
-       Unfolding(..),  UnfoldingGuidance(..), InlineRuleInfo(..),
+       Unfolding(..),  UnfoldingGuidance(..), InlineRuleInfo(..), InlSatFlag(..),
                -- Abstract everywhere but in CoreUnfold.lhs
        
        -- ** Constructing 'Unfolding's
@@ -45,7 +45,7 @@ module CoreSyn (
        unfoldingTemplate, setUnfoldingTemplate,
        maybeUnfoldingTemplate, otherCons, unfoldingArity,
        isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
-        isExpandableUnfolding, 
+        isExpandableUnfolding, isConLikeUnfolding,
        isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, 
        isStableUnfolding, canUnfold, neverUnfoldGuidance,
 
@@ -413,6 +413,8 @@ data Unfolding
        uf_is_top     :: Bool,          -- True <=> top level binding
        uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard a `seq` on
                                        --      this variable
+        uf_is_conlike :: Bool,          -- True <=> application of constructor or CONLIKE function
+                                        --      Cached version of exprIsConLike
        uf_is_cheap   :: Bool,          -- True <=> doesn't waste (much) work to expand inside an inlining
                                        --      Cached version of exprIsCheap
        uf_expandable :: Bool,          -- True <=> can expand in RULE matching
@@ -438,20 +440,14 @@ data Unfolding
 ------------------------------------------------
 -- | 'UnfoldingGuidance' says when unfolding should take place
 data UnfoldingGuidance
-  = UnfoldAlways       -- There is /no original definition/, so you'd better unfold.
-                       -- The unfolding is guaranteed to have no free variables
-                       -- so no need to think about it during dependency analysis
-
-  | InlineRule {       -- See Note [InlineRules]
-                        -- Be very keen to inline this
+  = InlineRule {        -- Be very keen to inline this; See Note [InlineRules]
                        -- The uf_tmpl is the *original* RHS; do *not* replace it on
                        --   each simlifier run.  Hence, the *actual* RHS of the function 
                        --   may be different by now, because it may have been optimised.
-      ug_ir_info :: InlineRuleInfo,    -- Supplementary info about the InlineRule
-      ug_small :: Bool                 -- True <=> the RHS is so small (eg no bigger than a call) 
-                                       --          that you should always inline a saturated call,
-    }                                  --           regardless of how boring the context is
-                                       -- See Note [INLINE for small functions] in CoreUnfold]
+
+        ir_sat  :: InlSatFlag,  
+        ir_info :: InlineRuleInfo
+    }
 
   | UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the
                        -- result of a simple analysis of the RHS
@@ -466,20 +462,30 @@ data UnfoldingGuidance
     }                    -- a context (case (thing args) of ...),
                          -- (where there are the right number of arguments.)
 
-  | UnfoldNever
+  | UnfoldNever                  -- A variant of UnfoldIfGoodArgs, used for big RHSs
 
 data InlineRuleInfo
-  = InlSat             -- A user-specifed or compiler injected INLINE pragma
-                       -- ONLY inline when it's applied to 'arity' arguments
+  = InlAlways       -- Inline absolutely always, however boring the context.
+                    -- There is /no original definition/. Only a few primop-like things 
+                   -- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding).
 
-  | InlUnSat           -- The compiler decided to "capture" the RHS into an
-                       -- InlineRule, but do not require that it appears saturated
+  | InlSmall       -- The RHS is very small (eg no bigger than a call), so inline any
+                   -- /saturated/ application, regardless of context
+                    -- See Note [INLINE for small functions] in CoreUnfold
 
-  | InlWrapper Id      -- This unfolding is a the wrapper in a 
-                       --     worker/wrapper split from the strictness analyser
-                       -- Used to abbreviate the uf_tmpl in interface files
-                       --      which don't need to contain the RHS; 
-                       --      it can be derived from the strictness info
+  | InlVanilla
+
+  | InlWrapper Id   -- This unfolding is a the wrapper in a 
+                   --     worker/wrapper split from the strictness analyser
+                   -- The Id is the worker-id
+                   -- Used to abbreviate the uf_tmpl in interface files
+                   --  which don't need to contain the RHS; 
+                   --  it can be derived from the strictness info
+                   -- [In principle this is orthogonal to the InlSmall/InVanilla thing, 
+                    --  but it's convenient to have it here.]
+
+data InlSatFlag = InlSat | InlUnSat
+    -- Specifies whether to INLINE only if the thing is applied to 'arity' args
 
 ------------------------------------------------
 noUnfolding :: Unfolding
@@ -496,8 +502,9 @@ mkOtherCon = OtherCon
 seqUnfolding :: Unfolding -> ()
 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 
                uf_is_value = b1, uf_is_cheap = b2, 
-               uf_expandable = b3, uf_arity = a, uf_guidance = g})
-  = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` seqGuidance g
+               uf_expandable = b3, uf_is_conlike = b4,
+                uf_arity = a, uf_guidance = g})
+  = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
 
 seqUnfolding _ = ()
 
@@ -541,6 +548,13 @@ isEvaldUnfolding (OtherCon _)                                  = True
 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 isEvaldUnfolding _                                          = False
 
+-- | @True@ if the unfolding is a constructor application, the application
+-- of a CONLIKE function or 'OtherCon'
+isConLikeUnfolding :: Unfolding -> Bool
+isConLikeUnfolding (OtherCon _)                             = True
+isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
+isConLikeUnfolding _                                        = False
+
 -- | Is the thing we will unfold into certainly cheap?
 isCheapUnfolding :: Unfolding -> Bool
 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
@@ -554,10 +568,10 @@ isInlineRule :: Unfolding -> Bool
 isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
 isInlineRule _                                             = False
 
-isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo
-isInlineRule_maybe (CoreUnfolding {
-                       uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl
-isInlineRule_maybe _                                                   = Nothing
+isInlineRule_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag)
+isInlineRule_maybe (CoreUnfolding { uf_guidance = 
+                        InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat)
+isInlineRule_maybe _                                                 = Nothing
 
 isStableUnfolding :: Unfolding -> Bool
 -- True of unfoldings that should not be overwritten