Remove StgBinderInfo and related computation in CoreToStg
authorÖmer Sinan Ağacan <omeragacan@gmail.com>
Mon, 12 Nov 2018 03:50:54 +0000 (06:50 +0300)
committerÖmer Sinan Ağacan <omeragacan@gmail.com>
Mon, 12 Nov 2018 03:51:49 +0000 (06:51 +0300)
- The StgBinderInfo type was never used in the code gen, so the type, related
  computation in CoreToStg, and some comments about it are removed. See #15770
  for more details.

- Simplified CoreToStg after removing the StgBinderInfo computation: removed
  StgBinderInfo arguments and mfix stuff.

The StgBinderInfo values were not used in the code gen, but I still run nofib
just to make sure: 0.0% change in allocations and binary sizes.

Test Plan: Validated locally

Reviewers: simonpj, simonmar, bgamari, sgraf

Reviewed By: sgraf

Subscribers: AndreasK, sgraf, rwbarton, carter

Differential Revision: https://phabricator.haskell.org/D5232

compiler/codeGen/StgCmm.hs
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmExpr.hs
compiler/simplStg/StgCse.hs
compiler/simplStg/StgStats.hs
compiler/simplStg/UnariseStg.hs
compiler/stgSyn/CoreToStg.hs
compiler/stgSyn/StgLint.hs
compiler/stgSyn/StgSyn.hs

index 60be1ca..5b80ba6 100644 (file)
@@ -153,9 +153,9 @@ cgTopRhs dflags _rec bndr (StgRhsCon _cc con args)
       -- con args are always non-void,
       -- see Note [Post-unarisation invariants] in UnariseStg
 
-cgTopRhs dflags rec bndr (StgRhsClosure cc bi fvs upd_flag args body)
+cgTopRhs dflags rec bndr (StgRhsClosure cc fvs upd_flag args body)
   = ASSERT(null fvs)    -- There should be no free variables
-    cgTopRhsClosure dflags rec bndr cc bi upd_flag args body
+    cgTopRhsClosure dflags rec bndr cc upd_flag args body
 
 
 ---------------------------------------------------------------
index aa2b954..004bf90 100644 (file)
@@ -62,13 +62,12 @@ cgTopRhsClosure :: DynFlags
                 -> RecFlag              -- member of a recursive group?
                 -> Id
                 -> CostCentreStack      -- Optional cost centre annotation
-                -> StgBinderInfo
                 -> UpdateFlag
                 -> [Id]                 -- Args
                 -> StgExpr
                 -> (CgIdInfo, FCode ())
 
-cgTopRhsClosure dflags rec id ccs upd_flag args body =
+cgTopRhsClosure dflags rec id ccs upd_flag args body =
   let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id)
       cg_id_info    = litIdInfo dflags id lf_info (CmmLabel closure_label)
       lf_info       = mkClosureLFInfo dflags id TopLevel [] upd_flag args
@@ -207,15 +206,15 @@ cgRhs id (StgRhsCon cc con args)
       -- see Note [Post-unarisation invariants] in UnariseStg
 
 {- See Note [GC recovery] in compiler/codeGen/StgCmmClosure.hs -}
-cgRhs id (StgRhsClosure cc bi fvs upd_flag args body)
+cgRhs id (StgRhsClosure cc fvs upd_flag args body)
   = do dflags <- getDynFlags
-       mkRhsClosure dflags id cc bi (nonVoidIds fvs) upd_flag args body
+       mkRhsClosure dflags id cc (nonVoidIds fvs) upd_flag args body
 
 ------------------------------------------------------------------------
 --              Non-constructor right hand sides
 ------------------------------------------------------------------------
 
-mkRhsClosure :: DynFlags -> Id -> CostCentreStack -> StgBinderInfo
+mkRhsClosure :: DynFlags -> Id -> CostCentreStack
              -> [NonVoid Id]                    -- Free vars
              -> UpdateFlag
              -> [Id]                            -- Args
@@ -258,7 +257,7 @@ for semi-obvious reasons.
 -}
 
 ---------- Note [Selectors] ------------------
-mkRhsClosure    dflags bndr _cc _bi
+mkRhsClosure    dflags bndr _cc
                 [NonVoid the_fv]                -- Just one free var
                 upd_flag                -- Updatable thunk
                 []                      -- A thunk
@@ -291,7 +290,7 @@ mkRhsClosure    dflags bndr _cc _bi
     in cgRhsStdThunk bndr lf_info [StgVarArg the_fv]
 
 ---------- Note [Ap thunks] ------------------
-mkRhsClosure    dflags bndr _cc _bi
+mkRhsClosure    dflags bndr _cc
                 fvs
                 upd_flag
                 []                      -- No args; a thunk
@@ -323,7 +322,7 @@ mkRhsClosure    dflags bndr _cc _bi
     payload = StgVarArg fun_id : args
 
 ---------- Default case ------------------
-mkRhsClosure dflags bndr cc fvs upd_flag args body
+mkRhsClosure dflags bndr cc fvs upd_flag args body
   = do  { let lf_info = mkClosureLFInfo dflags bndr NotTopLevel fvs upd_flag args
         ; (id_info, reg) <- rhsIdInfo bndr lf_info
         ; return (id_info, gen_code lf_info reg) }
index 6f0feaa..65e7cf7 100644 (file)
@@ -623,92 +623,6 @@ getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs)
 getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method"
 
 -----------------------------------------------------------------------------
---                staticClosureRequired
------------------------------------------------------------------------------
-
-{-  staticClosureRequired is never called (hence commented out)
-
-    SimonMar writes (Sept 07) It's an optimisation we used to apply at
-    one time, I believe, but it got lost probably in the rewrite of
-    the RTS/code generator.  I left that code there to remind me to
-    look into whether it was worth doing sometime
-
-{- Avoiding generating entries and info tables
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-At present, for every function we generate all of the following,
-just in case.  But they aren't always all needed, as noted below:
-
-[NB1: all of this applies only to *functions*.  Thunks always
-have closure, info table, and entry code.]
-
-[NB2: All are needed if the function is *exported*, just to play safe.]
-
-* Fast-entry code  ALWAYS NEEDED
-
-* Slow-entry code
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) we're in the parallel world and the function has free vars
-                       [Reason: in parallel world, we always enter functions
-                       with free vars via the closure.]
-
-* The function closure
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) if the function has free vars (ie not top level)
-
-  Why case (a) here?  Because if the arg-satis check fails,
-  UpdatePAP stuffs a pointer to the function closure in the PAP.
-  [Could be changed; UpdatePAP could stuff in a code ptr instead,
-   but doesn't seem worth it.]
-
-  [NB: these conditions imply that we might need the closure
-  without the slow-entry code.  Here's how.
-
-        f x y = let g w = ...x..y..w...
-                in
-                ...(g t)...
-
-  Here we need a closure for g which contains x and y,
-  but since the calls are all saturated we just jump to the
-  fast entry point for g, with R1 pointing to the closure for g.]
-
-
-* Standard info table
-        Needed iff (a) we have any un-saturated calls to the function
-        OR         (b) the function is passed as an arg
-        OR         (c) the function has free vars (ie not top level)
-
-        NB.  In the sequential world, (c) is only required so that the function closure has
-        an info table to point to, to keep the storage manager happy.
-        If (c) alone is true we could fake up an info table by choosing
-        one of a standard family of info tables, whose entry code just
-        bombs out.
-
-        [NB In the parallel world (c) is needed regardless because
-        we enter functions with free vars via the closure.]
-
-        If (c) is retained, then we'll sometimes generate an info table
-        (for storage mgr purposes) without slow-entry code.  Then we need
-        to use an error label in the info table to substitute for the absent
-        slow entry code.
--}
-
-staticClosureRequired
-        :: Name
-        -> StgBinderInfo
-        -> LambdaFormInfo
-        -> Bool
-staticClosureRequired binder bndr_info
-                      (LFReEntrant top_level _ _ _ _)        -- It's a function
-  = ASSERT( isTopLevel top_level )
-        -- Assumption: it's a top-level, no-free-var binding
-        not (satCallsOnly bndr_info)
-
-staticClosureRequired binder other_binder_info other_lf_info = True
--}
-
------------------------------------------------------------------------------
 --              Data types for closure information
 -----------------------------------------------------------------------------
 
index 1af8fb3..7fc9dfc 100644 (file)
@@ -151,7 +151,7 @@ cgLetNoEscapeRhsBody
     -> Id
     -> StgRhs
     -> FCode (CgIdInfo, FCode ())
-cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _bi _ _upd args body)
+cgLetNoEscapeRhsBody local_cc bndr (StgRhsClosure cc _ _upd args body)
   = cgLetNoEscapeClosure bndr local_cc cc (nonVoidIds args) body
 cgLetNoEscapeRhsBody local_cc bndr (StgRhsCon cc con args)
   = cgLetNoEscapeClosure bndr local_cc cc []
index 2caf006..fe7943c 100644 (file)
@@ -284,9 +284,9 @@ stgCseTopLvl in_scope (StgTopLifted (StgRec eqs))
   where in_scope' = in_scope `extendInScopeSetList` [ bndr | (bndr, _) <- eqs ]
 
 stgCseTopLvlRhs :: InScopeSet -> InStgRhs -> OutStgRhs
-stgCseTopLvlRhs in_scope (StgRhsClosure ccs info occs upd args body)
+stgCseTopLvlRhs in_scope (StgRhsClosure ccs occs upd args body)
     = let body' = stgCseExpr (initEnv in_scope) body
-      in  StgRhsClosure ccs info occs upd args body'
+      in  StgRhsClosure ccs occs upd args body'
 stgCseTopLvlRhs _ (StgRhsCon ccs dataCon args)
     = StgRhsCon ccs dataCon args
 
@@ -402,11 +402,11 @@ stgCseRhs env bndr (StgRhsCon ccs dataCon args)
           pair = (bndr, StgRhsCon ccs dataCon args')
       in (Just pair, env')
   where args' = substArgs env args
-stgCseRhs env bndr (StgRhsClosure ccs info occs upd args body)
+stgCseRhs env bndr (StgRhsClosure ccs occs upd args body)
     = let (env1, args') = substBndrs env args
           env2 = forgetCse env1 -- See note [Free variables of an StgClosure]
           body' = stgCseExpr env2 body
-      in (Just (substVar env bndr, StgRhsClosure ccs info occs' upd args' body'), env)
+      in (Just (substVar env bndr, StgRhsClosure ccs occs' upd args' body'), env)
   where occs' = substVars env occs
 
 
index 712ec2d..c548d80 100644 (file)
@@ -131,7 +131,7 @@ statRhs :: Bool -> (Id, StgRhs) -> StatEnv
 statRhs top (_, StgRhsCon _ _ _)
   = countOne (ConstructorBinds top)
 
-statRhs top (_, StgRhsClosure _ fv u _ body)
+statRhs top (_, StgRhsClosure _ fv u _ body)
   = statExpr body                       `combineSE`
     countN FreeVariables (length fv)    `combineSE`
     countOne (
index 5c271c2..a464974 100644 (file)
@@ -281,11 +281,11 @@ unariseBinding rho (StgRec xrhss)
   = StgRec <$> mapM (\(x, rhs) -> (x,) <$> unariseRhs rho rhs) xrhss
 
 unariseRhs :: UnariseEnv -> StgRhs -> UniqSM StgRhs
-unariseRhs rho (StgRhsClosure ccs b_info fvs update_flag args expr)
+unariseRhs rho (StgRhsClosure ccs fvs update_flag args expr)
   = do (rho', args1) <- unariseFunArgBinders rho args
        expr' <- unariseExpr rho' expr
        let fvs' = unariseFreeVars rho fvs
-       return (StgRhsClosure ccs b_info fvs' update_flag args1 expr')
+       return (StgRhsClosure ccs fvs' update_flag args1 expr')
 
 unariseRhs rho (StgRhsCon ccs con args)
   = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con))
index 8275564..1294075 100644 (file)
@@ -118,19 +118,6 @@ import Control.Monad (liftM, ap)
 --
 -- See also: Commentary/Rts/Storage/GC/CAFs on the GHC Wiki.
 
--- Note [Collecting live CAF info]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- In this pass we also collect information on which CAFs are live.
---
--- A top-level Id has CafInfo, which is
---
---         - MayHaveCafRefs, if it may refer indirectly to
---           one or more CAFs, or
---         - NoCafRefs if it definitely doesn't
---
--- The CafInfo has already been calculated during the CoreTidy pass.
---
 -- Note [What is a non-escaping let]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -282,7 +269,7 @@ coreTopBindToStg dflags this_mod env body_fvs ccs (NonRec id rhs)
 
         (stg_rhs, fvs', ccs') =
             initCts env $
-              coreToTopStgRhs dflags ccs this_mod body_fvs (id,rhs)
+              coreToTopStgRhs dflags ccs this_mod (id,rhs)
 
         bind = StgTopLifted $ StgNonRec id stg_rhs
     in
@@ -308,7 +295,7 @@ coreTopBindToStg dflags this_mod env body_fvs ccs (Rec pairs)
           = initCts env' $ do
                mapAccumLM (\(fvs, ccs) rhs -> do
                             (rhs', fvs', ccs') <-
-                              coreToTopStgRhs dflags ccs this_mod body_fvs rhs
+                              coreToTopStgRhs dflags ccs this_mod rhs
                             return ((fvs' `unionFVInfo` fvs, ccs'), rhs'))
                           (body_fvs, ccs)
                           pairs
@@ -338,15 +325,14 @@ coreToTopStgRhs
         :: DynFlags
         -> CollectedCCs
         -> Module
-        -> FreeVarsInfo         -- Free var info for the scope of the binding
         -> (Id,CoreExpr)
         -> CtsM (StgRhs, FreeVarsInfo, CollectedCCs)
 
-coreToTopStgRhs dflags ccs this_mod scope_fv_info (bndr, rhs)
+coreToTopStgRhs dflags ccs this_mod (bndr, rhs)
   = do { (new_rhs, rhs_fvs) <- coreToStgExpr rhs
 
        ; let (stg_rhs, ccs') =
-               mkTopStgRhs dflags this_mod ccs rhs_fvs bndr bndr_info new_rhs
+               mkTopStgRhs dflags this_mod ccs rhs_fvs bndr new_rhs
              stg_arity =
                stgRhsArity stg_rhs
 
@@ -354,8 +340,6 @@ coreToTopStgRhs dflags ccs this_mod scope_fv_info (bndr, rhs)
                  rhs_fvs,
                  ccs') }
   where
-    bndr_info = lookupFVInfo scope_fv_info bndr
-
         -- It's vital that the arity on a top-level Id matches
         -- the arity of the generated STG binding, else an importing
         -- module will use the wrong calling convention
@@ -558,8 +542,7 @@ coreToStgApp _ f args ticks = do
 
     let
         n_val_args       = valArgCount args
-        not_letrec_bound = not (isLetBound how_bound)
-        fun_fvs = singletonFVInfo f how_bound fun_occ
+        fun_fvs = singletonFVInfo f how_bound
             -- e.g. (f :: a -> int) (x :: a)
             -- Here the free variables are "f", "x" AND the type variable "a"
             -- coreToStgArgs will deal with the arguments recursively
@@ -574,11 +557,6 @@ coreToStgApp _ f args ticks = do
         f_arity   = stgArity f how_bound
         saturated = f_arity <= n_val_args
 
-        fun_occ
-         | not_letrec_bound         = noBinderInfo      -- Uninteresting variable
-         | f_arity > 0 && saturated = stgSatOcc -- Saturated or over-saturated function call
-         | otherwise                = stgUnsatOcc       -- Unsaturated function or thunk
-
         res_ty = exprType (mkApps (Var f) args)
         app = case idDetails f of
                 DataConWorkId dc
@@ -612,8 +590,6 @@ coreToStgApp _ f args ticks = do
         fvs
      )
 
-
-
 -- ---------------------------------------------------------------------------
 -- Argument lists
 -- This is the guy that turns applications into A-normal form
@@ -686,10 +662,10 @@ coreToStgLet
 coreToStgLet bind body = do
     (bind2, bind_fvs,
      body2, body_fvs)
-       <- mfix $ \ ~(_, _, _, rec_body_fvs) -> do
+       <- do
 
           ( bind2, bind_fvs, env_ext)
-                <- vars_bind rec_body_fvs bind
+                <- vars_bind bind
 
           -- Do the body
           extendVarEnvCts env_ext $ do
@@ -698,7 +674,6 @@ coreToStgLet bind body = do
              return (bind2, bind_fvs,
                      body2, body_fvs)
 
-
         -- Compute the new let-expression
     let
         new_let | isJoinBind bind = StgLetNoEscape bind2 body2
@@ -717,59 +692,51 @@ coreToStgLet bind body = do
     mk_binding binder rhs
         = (binder, LetBound NestedLet (manifestArity rhs))
 
-    vars_bind :: FreeVarsInfo           -- Free var info for body of binding
-              -> CoreBind
+    vars_bind :: CoreBind
               -> CtsM (StgBinding,
                        FreeVarsInfo,
                        [(Id, HowBound)])  -- extension to environment
 
-
-    vars_bind body_fvs (NonRec binder rhs) = do
-        (rhs2, bind_fvs) <- coreToStgRhs body_fvs (binder,rhs)
+    vars_bind (NonRec binder rhs) = do
+        (rhs2, bind_fvs) <- coreToStgRhs (binder,rhs)
         let
             env_ext_item = mk_binding binder rhs
 
         return (StgNonRec binder rhs2,
                 bind_fvs, [env_ext_item])
 
-
-    vars_bind body_fvs (Rec pairs)
-      = mfix $ \ ~(_, rec_rhs_fvs, _) ->
-           let
-                rec_scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
+    vars_bind (Rec pairs)
+      =    let
                 binders = map fst pairs
                 env_ext = [ mk_binding b rhs
                           | (b,rhs) <- pairs ]
            in
            extendVarEnvCts env_ext $ do
               (rhss2, fvss)
-                     <- mapAndUnzipM (coreToStgRhs rec_scope_fvs) pairs
+                     <- mapAndUnzipM coreToStgRhs pairs
               let
                         bind_fvs = unionFVInfos fvss
 
               return (StgRec (binders `zip` rhss2),
                       bind_fvs, env_ext)
 
-coreToStgRhs :: FreeVarsInfo      -- Free var info for the scope of the binding
-             -> (Id,CoreExpr)
+coreToStgRhs :: (Id,CoreExpr)
              -> CtsM (StgRhs, FreeVarsInfo)
 
-coreToStgRhs scope_fv_info (bndr, rhs) = do
+coreToStgRhs (bndr, rhs) = do
     (new_rhs, rhs_fvs) <- coreToStgExpr rhs
-    return (mkStgRhs rhs_fvs bndr bndr_info new_rhs, rhs_fvs)
-  where
-    bndr_info = lookupFVInfo scope_fv_info bndr
+    return (mkStgRhs rhs_fvs bndr new_rhs, rhs_fvs)
 
 -- Generate a top-level RHS. Any new cost centres generated for CAFs will be
 -- appended to `CollectedCCs` argument.
 mkTopStgRhs :: DynFlags -> Module -> CollectedCCs
-            -> FreeVarsInfo -> Id -> StgBinderInfo -> StgExpr
+            -> FreeVarsInfo -> Id -> StgExpr
             -> (StgRhs, CollectedCCs)
 
-mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
+mkTopStgRhs dflags this_mod ccs rhs_fvs bndr rhs
   | StgLam bndrs body <- rhs
   = -- StgLam can't have empty arguments, so not CAF
-    ( StgRhsClosure dontCareCCS binder_info
+    ( StgRhsClosure dontCareCCS
                     (getFVs rhs_fvs)
                     ReEntrant
                     (toList bndrs) body
@@ -785,13 +752,13 @@ mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
 
   -- Otherwise it's a CAF, see Note [Cost-centre initialization plan].
   | gopt Opt_AutoSccsOnIndividualCafs dflags
-  = ( StgRhsClosure caf_ccs binder_info
+  = ( StgRhsClosure caf_ccs
                     (getFVs rhs_fvs)
                     upd_flag [] rhs
     , collectCC caf_cc caf_ccs ccs )
 
   | otherwise
-  = ( StgRhsClosure all_cafs_ccs binder_info
+  = ( StgRhsClosure all_cafs_ccs
                     (getFVs rhs_fvs)
                     upd_flag [] rhs
     , ccs )
@@ -816,17 +783,17 @@ mkTopStgRhs dflags this_mod ccs rhs_fvs bndr binder_info rhs
 
 -- Generate a non-top-level RHS. Cost-centre is always currentCCS,
 -- see Note [Cost-centre initialzation plan].
-mkStgRhs :: FreeVarsInfo -> Id -> StgBinderInfo -> StgExpr -> StgRhs
-mkStgRhs rhs_fvs bndr binder_info rhs
+mkStgRhs :: FreeVarsInfo -> Id -> StgExpr -> StgRhs
+mkStgRhs rhs_fvs bndr rhs
   | StgLam bndrs body <- rhs
-  = StgRhsClosure currentCCS binder_info
+  = StgRhsClosure currentCCS
                   (getFVs rhs_fvs)
                   ReEntrant
                   (toList bndrs) body
 
   | isJoinId bndr -- must be a nullary join point
   = ASSERT(idJoinArity bndr == 0)
-    StgRhsClosure currentCCS binder_info
+    StgRhsClosure currentCCS
                   (getFVs rhs_fvs)
                   ReEntrant -- ignored for LNE
                   [] rhs
@@ -835,7 +802,7 @@ mkStgRhs rhs_fvs bndr binder_info rhs
   = StgRhsCon currentCCS con args
 
   | otherwise
-  = StgRhsClosure currentCCS binder_info
+  = StgRhsClosure currentCCS
                   (getFVs rhs_fvs)
                   upd_flag [] rhs
   where
@@ -924,10 +891,6 @@ data LetInfo
   | NestedLet
   deriving (Eq)
 
-isLetBound :: HowBound -> Bool
-isLetBound (LetBound _ _) = True
-isLetBound _              = False
-
 topLevelBound :: HowBound -> Bool
 topLevelBound ImportBound         = True
 topLevelBound (LetBound TopLet _) = True
@@ -974,11 +937,6 @@ instance Applicative CtsM where
 instance Monad CtsM where
     (>>=)  = thenCts
 
-instance MonadFix CtsM where
-    mfix expr = CtsM $ \env ->
-                       let result = unCtsM (expr result) env
-                       in  result
-
 -- Functions specific to this monad:
 
 extendVarEnvCts :: [(Id, HowBound)] -> CtsM a -> CtsM a
@@ -1007,7 +965,7 @@ getAllCAFsCC this_mod =
 -- Free variable information
 -- ---------------------------------------------------------------------------
 
-type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
+type FreeVarsInfo = VarEnv (Var, HowBound)
         -- The Var is so we can gather up the free variables
         -- as a set.
         --
@@ -1017,31 +975,16 @@ type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
         --            Imported Ids without CAF refs are simply
         --            not put in the FreeVarsInfo for an expression.
         --            See singletonFVInfo and freeVarsToLiveVars
-        --
-        -- StgBinderInfo records how it occurs; notably, we
-        -- are interested in whether it only occurs in saturated
-        -- applications, because then we don't need to build a
-        -- curried version.
-        -- If f is mapped to noBinderInfo, that means
-        -- that f *is* mentioned (else it wouldn't be in the
-        -- IdEnv at all), but perhaps in an unsaturated applications.
-        --
-        -- All case/lambda-bound things are also mapped to
-        -- noBinderInfo, since we aren't interested in their
-        -- occurrence info.
-        --
-        -- For ILX we track free var info for type variables too;
-        -- hence VarEnv not IdEnv
 
 emptyFVInfo :: FreeVarsInfo
 emptyFVInfo = emptyVarEnv
 
-singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
+singletonFVInfo :: Id -> HowBound -> FreeVarsInfo
 -- Don't record non-CAF imports at all, to keep free-var sets small
-singletonFVInfo id ImportBound info
-   | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound, info)
+singletonFVInfo id ImportBound
+   | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound)
    | otherwise                     = emptyVarEnv
-singletonFVInfo id how_bound info  = unitVarEnv id (id, how_bound, info)
+singletonFVInfo id how_bound = unitVarEnv id (id, how_bound)
 
 unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
 unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
@@ -1060,29 +1003,20 @@ minusFVBinder v fv = fv `delVarEnv` v
 elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
 elementOfFVInfo id fvs = isJust (lookupVarEnv fvs id)
 
-lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
--- Find how the given Id is used.
--- Externally visible things may be used any old how
-lookupFVInfo fvs id
-  | isExternalName (idName id) = noBinderInfo
-  | otherwise = case lookupVarEnv fvs id of
-                        Nothing         -> noBinderInfo
-                        Just (_,_,info) -> info
-
 -- Non-top-level things only, both type variables and ids
 getFVs :: FreeVarsInfo -> [Var]
-getFVs fvs = [id | (id, how_bound, _) <- nonDetEltsUFM fvs,
+getFVs fvs = [id | (id, how_bound) <- nonDetEltsUFM fvs,
   -- It's OK to use nonDetEltsUFM here because we're not aiming for
   -- bit-for-bit determinism.
   -- See Note [Unique Determinism and code generation]
                     not (topLevelBound how_bound) ]
 
-plusFVInfo :: (Var, HowBound, StgBinderInfo)
-           -> (Var, HowBound, StgBinderInfo)
-           -> (Var, HowBound, StgBinderInfo)
-plusFVInfo (id1,hb1,info1) (id2,hb2,info2)
+plusFVInfo :: (Var, HowBound)
+           -> (Var, HowBound)
+           -> (Var, HowBound)
+plusFVInfo (id1,hb1) (id2,hb2)
   = ASSERT(id1 == id2 && hb1 == hb2)
-    (id1, hb1, combineStgBinderInfo info1 info2)
+    (id1, hb1)
 
 -- Misc.
 
index 58f14a1..35a498f 100644 (file)
@@ -116,10 +116,10 @@ lint_binds_help (binder, rhs)
 
 lintStgRhs :: StgRhs -> LintM ()
 
-lintStgRhs (StgRhsClosure _ _ _ [] expr)
+lintStgRhs (StgRhsClosure _ _ _ [] expr)
   = lintStgExpr expr
 
-lintStgRhs (StgRhsClosure _ _ _ binders expr)
+lintStgRhs (StgRhsClosure _ _ _ binders expr)
   = addLoc (LambdaBodyOf binders) $
       addInScopeVars binders $
         lintStgExpr expr
index eb905f7..7d347f4 100644 (file)
@@ -19,10 +19,6 @@ module StgSyn (
 
         UpdateFlag(..), isUpdatable,
 
-        StgBinderInfo,
-        noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
-        combineStgBinderInfo,
-
         -- a set of synonyms for the most common (only :-) parameterisation
         StgArg,
         StgTopBinding, StgBinding, StgExpr, StgRhs, StgAlt,
@@ -393,7 +389,6 @@ flavour is for closures:
 data GenStgRhs bndr occ
   = StgRhsClosure
         CostCentreStack         -- CCS to be attached (default is CurrentCCS)
-        StgBinderInfo           -- Info about how this binder is used (see below)
         [occ]                   -- non-global free vars; a list, rather than
                                 -- a set, because order is important
         !UpdateFlag             -- ReEntrant | Updatable | SingleEntry
@@ -428,7 +423,7 @@ The second flavour of right-hand-side is for constructors (simple but important)
         [GenStgArg occ]  -- Args
 
 stgRhsArity :: StgRhs -> Int
-stgRhsArity (StgRhsClosure _ _ _ bndrs _)
+stgRhsArity (StgRhsClosure _ _ _ bndrs _)
   = ASSERT( all isId bndrs ) length bndrs
   -- The arity never includes type parameters, but they should have gone by now
 stgRhsArity (StgRhsCon _ _ _) = 0
@@ -455,7 +450,7 @@ topStgBindHasCafRefs StgTopStringLit{}
   = False
 
 topRhsHasCafRefs :: GenStgRhs bndr Id -> Bool
-topRhsHasCafRefs (StgRhsClosure _ _ upd _ body)
+topRhsHasCafRefs (StgRhsClosure _ _ upd _ body)
   = -- See Note [CAF consistency]
     isUpdatable upd || exprHasCafRefs body
 topRhsHasCafRefs (StgRhsCon _ _ args)
@@ -488,7 +483,7 @@ bindHasCafRefs (StgRec binds)
   = any rhsHasCafRefs (map snd binds)
 
 rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
-rhsHasCafRefs (StgRhsClosure _ _ _ _ body)
+rhsHasCafRefs (StgRhsClosure _ _ _ _ body)
   = exprHasCafRefs body
 rhsHasCafRefs (StgRhsCon _ _ args)
   = any stgArgHasCafRefs args
@@ -509,33 +504,6 @@ stgIdHasCafRefs id =
   -- imported or defined in this module) are GlobalIds, so the test is easy.
   isGlobalId id && mayHaveCafRefs (idCafInfo id)
 
--- Here's the @StgBinderInfo@ type, and its combining op:
-
-data StgBinderInfo
-  = NoStgBinderInfo
-  | SatCallsOnly        -- All occurrences are *saturated* *function* calls
-                        -- This means we don't need to build an info table and
-                        -- slow entry code for the thing
-                        -- Thunks never get this value
-
-noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
-noBinderInfo = NoStgBinderInfo
-stgUnsatOcc  = NoStgBinderInfo
-stgSatOcc    = SatCallsOnly
-
-satCallsOnly :: StgBinderInfo -> Bool
-satCallsOnly SatCallsOnly    = True
-satCallsOnly NoStgBinderInfo = False
-
-combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
-combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
-combineStgBinderInfo _            _            = NoStgBinderInfo
-
---------------
-pp_binder_info :: StgBinderInfo -> SDoc
-pp_binder_info NoStgBinderInfo = empty
-pp_binder_info SatCallsOnly    = text "sat-only"
-
 {-
 ************************************************************************
 *                                                                      *
@@ -818,19 +786,17 @@ pprStgRhs :: (OutputableBndr bndr, Outputable bdee, Ord bdee)
           => GenStgRhs bndr bdee -> SDoc
 
 -- special case
-pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag [{-no args-}] (StgApp func []))
+pprStgRhs (StgRhsClosure cc [free_var] upd_flag [{-no args-}] (StgApp func []))
   = sdocWithDynFlags $ \dflags ->
     hsep [ ppr cc,
-           pp_binder_info bi,
            if not $ gopt Opt_SuppressStgFreeVars dflags
              then brackets (ppr free_var) else empty,
            text " \\", ppr upd_flag, ptext (sLit " [] "), ppr func ]
 
 -- general case
-pprStgRhs (StgRhsClosure cc bi free_vars upd_flag args body)
+pprStgRhs (StgRhsClosure cc free_vars upd_flag args body)
   = sdocWithDynFlags $ \dflags ->
     hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
-                pp_binder_info bi,
                 if not $ gopt Opt_SuppressStgFreeVars dflags
                   then brackets (interppSP free_vars) else empty,
                 char '\\' <> ppr upd_flag, brackets (interppSP args)])