[project @ 1996-07-25 20:43:49 by partain]
[ghc-hetmet.git] / ghc / compiler / simplCore / BinderInfo.lhs
index 82e024d..9b44d2e 100644 (file)
@@ -14,11 +14,11 @@ module BinderInfo (
        BinderInfo(..),
        FunOrArg, DuplicationDanger, InsideSCC,  -- NB: all abstract (yay!)
 
-       inlineUnconditionally, oneTextualOcc, oneSafeOcc,
+       inlineUnconditionally, okToInline,
 
-       addBinderInfo, orBinderInfo,
+       addBinderInfo, orBinderInfo, andBinderInfo,
 
-       argOccurrence, funOccurrence,
+       argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
        markMany, markDangerousToDup, markInsideSCC,
        getBinderInfoArity,
        setBinderInfoArityToZero,
@@ -28,6 +28,7 @@ module BinderInfo (
 
 IMP_Ubiq(){-uitous-}
 
+import CoreUnfold      ( FormSummary(..) )
 import Pretty
 import Util            ( panic )
 \end{code}
@@ -95,30 +96,47 @@ data DuplicationDanger
 data InsideSCC
   = InsideSCC      -- Inside an SCC; so be careful when substituting.
   | NotInsideSCC    -- It's ok.
+
+noBinderInfo = ManyOcc 0       -- A non-committal value
 \end{code}
 
 
 Predicates
 ~~~~~~~~~~
 
-@oneTextualOcc@ checks for one occurrence, in any position.
-The occurrence may be inside a lambda, that's all right.
-
-\begin{code}
-oneTextualOcc :: Bool -> BinderInfo -> Bool
-
-oneTextualOcc ok_to_dup (OneOcc _ _ _ n_alts _) = n_alts <= 1 || ok_to_dup
-oneTextualOcc _         other                  = False
-\end{code}
-
-@safeSingleOcc@ detects single occurences of values that are safe to
-inline, {\em including} ones in an argument position.
-
 \begin{code}
-oneSafeOcc :: Bool -> BinderInfo -> Bool
-oneSafeOcc ok_to_dup (OneOcc _ NoDupDanger NotInsideSCC n_alts _)
-                                                    = n_alts <= 1 || ok_to_dup
-oneSafeOcc _         other                          = False
+okToInline
+       :: FormSummary  -- What the thing to be inlined is like
+       -> BinderInfo   -- How the thing to be inlined occurs
+       -> Bool         -- True => it's small enough to inline
+       -> Bool         -- True => yes, inline it
+
+-- Always inline bottoms
+okToInline BottomForm occ_info small_enough
+  = True       -- Unless one of the type args is unboxed??
+               -- This used to be checked for, but I can't
+               -- see why so I've left it out.
+
+-- A WHNF can be inlined if it occurs once, or is small
+okToInline form occ_info small_enough
+ | is_whnf_form form
+ = small_enough || one_occ
+ where
+   one_occ = case occ_info of
+               OneOcc _ _ _ n_alts _ -> n_alts <= 1
+               other                 -> False
+       
+   is_whnf_form VarForm   = True
+   is_whnf_form ValueForm = True
+   is_whnf_form other     = False
+    
+-- A non-WHNF can be inlined if it doesn't occur inside a lambda,
+-- and occurs exactly once or 
+--     occurs once in each branch of a case and is small
+okToInline OtherForm (OneOcc _ NoDupDanger _ n_alts _) small_enough 
+  = n_alts <= 1 || small_enough
+
+okToInline form any_occ small_enough = False
 \end{code}
 
 @inlineUnconditionally@ decides whether a let-bound thing can
@@ -166,6 +184,8 @@ markDangerousToDup (OneOcc posn _ in_scc n_alts ar)
   = OneOcc posn DupDanger in_scc n_alts ar
 markDangerousToDup other = other
 
+dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
+
 markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
   = OneOcc posn dup_danger InsideSCC n_alts ar
 markInsideSCC other = other
@@ -178,49 +198,55 @@ addBinderInfo info1 DeadCode = info1
 addBinderInfo info1 info2
        = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 
--- (orBinderInfo orig new) is used in two situations:
--- First, it combines occurrence info from branches of a case
---
--- Second, when a variable whose occurrence
---   info is currently "orig" is bound to a variable whose occurrence info is "new"
---     eg  (\new -> e) orig
---   What we want to do is to *worsen* orig's info to take account of new's
+-- (orBinderInfo orig new) is used when combining occurrence 
+-- info from branches of a case
 
 orBinderInfo DeadCode info2 = info2
 orBinderInfo info1 DeadCode = info1
 orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
-                     (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
+            (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
   = OneOcc (combine_posns posn1 posn2)
           (combine_dups  dup1  dup2)
           (combine_sccs  scc1  scc2)
           (n_alts1 + n_alts2)
           (min ar_1 ar_2)
-  where
-    combine_dups DupDanger _ = DupDanger       -- Too paranoid?? ToDo
-    combine_dups _ DupDanger = DupDanger
-    combine_dups _ _        = NoDupDanger
-
-    combine_sccs InsideSCC _ = InsideSCC       -- Too paranoid?? ToDo
-    combine_sccs _ InsideSCC = InsideSCC
-    combine_sccs _ _        = NotInsideSCC
-
 orBinderInfo info1 info2
        = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
 
+-- (andBinderInfo orig new) is used in two situations:
+-- First, when a variable whose occurrence info
+--   is currently "orig" is bound to a variable whose occurrence info is "new"
+--     eg  (\new -> e) orig
+--   What we want to do is to *worsen* orig's info to take account of new's
+--
+-- second, when completing a let-binding
+--     let new = ...orig...
+-- we compute the way orig occurs in (...orig...), and then use orBinderInfo
+-- to worsen this info by the way new occurs in the let body; then we use
+-- that to worsen orig's currently recorded occurrence info.
+
+andBinderInfo DeadCode info2 = DeadCode
+andBinderInfo info1 DeadCode = DeadCode
+andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
+             (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
+  = OneOcc (combine_posns posn1 posn2)
+          (combine_dups  dup1  dup2)
+          (combine_sccs  scc1  scc2)
+          (n_alts1 + n_alts2)
+          ar_1                                 -- Min arity just from orig
+andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
+
+
 combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
 combine_posns _         _  = ArgOcc
 
-{-
-multiplyBinderInfo orig@(ManyOcc _) new
-  = ManyOcc (min (getBinderInfoArity orig) (getBinderInfoArity new))
-
-multiplyBinderInfo orig new@(ManyOcc _)
-  = ManyOcc (min (getBinderInfoArity orig) (getBinderInfoArity new))
+combine_dups DupDanger _ = DupDanger   -- Too paranoid?? ToDo
+combine_dups _ DupDanger = DupDanger
+combine_dups _ _            = NoDupDanger
 
-multiplyBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
-                  (OneOcc posn2 dup2 scc2 n_alts2 ar_2)  
-  = OneOcc (combine_posns posn1 posn2) ???
--}
+combine_sccs InsideSCC _ = InsideSCC   -- Too paranoid?? ToDo
+combine_sccs _ InsideSCC = InsideSCC
+combine_sccs _ _            = NotInsideSCC
 
 setBinderInfoArityToZero :: BinderInfo -> BinderInfo
 setBinderInfoArityToZero DeadCode    = DeadCode