Simon Peyton Jones pushed to branch wip/T26425 at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Core/Opt/OccurAnal.hs
    ... ... @@ -660,18 +660,35 @@ through A, so it should have ManyOcc. Bear this case in mind!
    660 660
     * In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps
    
    661 661
       each in-scope non-recursive join point, such as `j` above, to
    
    662 662
       a "zeroed form" of its RHS's usage details. The "zeroed form"
    
    663
    +    * has only occ_nested_lets in its domain  (see (W5) below)
    
    663 664
         * deletes ManyOccs
    
    664 665
         * maps a OneOcc to OneOcc{ occ_n_br = 0 }
    
    665
    -  In our example, occ_join_points will be extended with
    
    666
    +  In our example, assuming `v` is locally-let-bound, occ_join_points will
    
    667
    +  be extended with
    
    666 668
           [j :-> [v :-> OneOcc{occ_n_br=0}]]
    
    667 669
       See `addJoinPoint` and (W5) below.
    
    668 670
     
    
    669 671
     * At an occurrence of a join point, we do everything as normal, but add in the
    
    670 672
       UsageDetails from the occ_join_points.  See mkOneOcc.
    
    671 673
     
    
    672
    -* Crucially, at the NonRec binding of the join point, in `occAnalBind`, we use
    
    673
    -  `combineJoinPointUDs`, not `andUDs` to combine the usage from the RHS with
    
    674
    -  the usage from the body.
    
    674
    +* Crucially, at the NonRec binding of a join point `j`, in `occAnalBind`,
    
    675
    +  we use `combineJoinPointUDs`, not `andUDs` to combine the usage from the
    
    676
    +  RHS with the usage from the body.  `combineJoinPointUDs` behaves like this:
    
    677
    +
    
    678
    +   * For all variables than `occ_nested_lets`, use `andUDs`, just like for
    
    679
    +     any normal let-binding.
    
    680
    +
    
    681
    +   * But for a variable `v` in `occ_nested_lets`, use `orUDs`:
    
    682
    +     - If `v` occurs `ManyOcc` in the join-point RHS, the variable won't be in
    
    683
    +       `occ_join_points`; but we'll get `ManyOcc` anyway.
    
    684
    +     - If `v` occurs `OneOcc` in the join-point RHS, the variable will be in
    
    685
    +       `occ_join_points` and we'll thereby get a `OneOcc{occ_n_br=0}` from
    
    686
    +       each of j's tail calls.  We can `or` that with the `OncOcc{occ_n_br=n}`
    
    687
    +       from j's RHS.
    
    688
    +
    
    689
    +  The only reason for `occ_nested_lets` is to reduce the size of the info
    
    690
    +  duplicate at each tail call; see (W5). It would sound to put *all* variables
    
    691
    +  into `occ_nested_lets`.
    
    675 692
     
    
    676 693
     Here are the consequences
    
    677 694
     
    
    ... ... @@ -682,8 +699,9 @@ Here are the consequences
    682 699
       There are two lexical occurrences of `v`!
    
    683 700
       (NB: `orUDs` adds occ_n_br together, so occ_n_br=1 is impossible, too.)
    
    684 701
     
    
    685
    -* In the tricky (P3) we'll get an `andUDs` of
    
    686
    -    * OneOcc{occ_n_br=0} from the occurrences of `j`)
    
    702
    +* In the tricky (P3), when analysing `case (f v) of ...`, we'll get
    
    703
    +  an `andUDs` of
    
    704
    +    * OneOcc{occ_n_br=0} from the occurrences of `j`
    
    687 705
         * OneOcc{occ_n_br=1} from the (f v)
    
    688 706
       These are `andUDs` together in `addOccInfo`, and hence
    
    689 707
       `v` gets ManyOccs, just as it should.  Clever!
    
    ... ... @@ -739,7 +757,7 @@ Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3).
    739 757
          will use only one of them. So again, we can use `combineJoinPointUDs`
    
    740 758
          to combine usage info from all these alternatives RHSs.
    
    741 759
     
    
    742
    -(W5) Other things being equal, we want keep the OccInfoEnv in the range of
    
    760
    +(W5) Other things being equal, we want keep the OccInfoEnv stored in
    
    743 761
       `occ_join_points` as small as possible, because it is /duplicated/ at
    
    744 762
       /every occurrence/ of the join point.  We really only want to include
    
    745 763
       OccInfo for
    
    ... ... @@ -759,9 +777,10 @@ Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3).
    759 777
       not `x` (lambda bound) nor `z` (occurs many times).
    
    760 778
     
    
    761 779
       To exploit this:
    
    762
    -     * `occ_local_lets` tracks which Ids are local, non-recursive lets
    
    780
    +     * `occ_nested_lets` tracks which Ids are
    
    781
    +              nested (not-top-level), non-recursive lets
    
    763 782
          * `addJoinPoint` only populates j's entry with occ-info for the "tracked Ids"
    
    764
    -       of `j`; that is, that are (a) in occ_local_lets and (b) have OneOcc.
    
    783
    +       of `j`; that is, that are (a) in occ_nested_lets and (b) have OneOcc.
    
    765 784
          * `combineJoinPointUDs` uses
    
    766 785
               orLocalOcc  for local-let Ids
    
    767 786
               andLocalOcc for non-local-let Ids
    
    ... ... @@ -2913,7 +2932,7 @@ data OccEnv
    2913 2932
                  -- See Note [Occurrence analysis for join points]
    
    2914 2933
                , occ_join_points :: !JoinPointInfo
    
    2915 2934
     
    
    2916
    -           , occ_local_lets :: IdSet    -- Non-top-level non-rec-bound lets
    
    2935
    +           , occ_nested_lets :: IdSet    -- Non-top-level, non-rec-bound lets
    
    2917 2936
                     -- I tried making this field strict, but
    
    2918 2937
                     -- doing so slightly increased allocation
    
    2919 2938
                }
    
    ... ... @@ -2968,7 +2987,7 @@ initOccEnv
    2968 2987
                , occ_join_points = emptyVarEnv
    
    2969 2988
                , occ_bs_env = emptyVarEnv
    
    2970 2989
                , occ_bs_rng = emptyVarSet
    
    2971
    -           , occ_local_lets = emptyVarSet }
    
    2990
    +           , occ_nested_lets = emptyVarSet }
    
    2972 2991
     
    
    2973 2992
     noBinderSwaps :: OccEnv -> Bool
    
    2974 2993
     noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env
    
    ... ... @@ -3209,19 +3228,19 @@ postprocess_uds bndrs bad_joins uds
    3209 3228
           | otherwise                  = env
    
    3210 3229
     
    
    3211 3230
     addLocalLet :: OccEnv -> TopLevelFlag -> Id -> OccEnv
    
    3212
    -addLocalLet env@(OccEnv { occ_local_lets = ids }) top_lvl id
    
    3231
    +addLocalLet env@(OccEnv { occ_nested_lets = ids }) top_lvl id
    
    3213 3232
       | isTopLevel top_lvl = env
    
    3214
    -  | otherwise          = env { occ_local_lets = ids `extendVarSet` id }
    
    3233
    +  | otherwise          = env { occ_nested_lets = ids `extendVarSet` id }
    
    3215 3234
     
    
    3216 3235
     addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv
    
    3217
    -addJoinPoint env@(OccEnv { occ_join_points = join_points, occ_local_lets = local_lets })
    
    3236
    +addJoinPoint env@(OccEnv { occ_join_points = join_points, occ_nested_lets = nested_lets })
    
    3218 3237
                  join_bndr (UD { ud_env = rhs_occs })
    
    3219 3238
       | isEmptyVarEnv zeroed_form
    
    3220 3239
       = env
    
    3221 3240
       | otherwise
    
    3222 3241
       = env { occ_join_points = extendVarEnv join_points join_bndr zeroed_form }
    
    3223 3242
       where
    
    3224
    -    zeroed_form = mapMaybeUniqSetToUFM do_one local_lets
    
    3243
    +    zeroed_form = mapMaybeUniqSetToUFM do_one nested_lets
    
    3225 3244
          -- See Note [Occurrence analysis for join points] for "zeroed form"
    
    3226 3245
     
    
    3227 3246
         do_one :: Var -> Maybe LocalOcc
    
    ... ... @@ -3748,12 +3767,12 @@ orUDs = combineUsageDetailsWith (\_uniq -> orLocalOcc)
    3748 3767
     
    
    3749 3768
     combineJoinPointUDs :: OccEnv -> UsageDetails -> UsageDetails -> UsageDetails
    
    3750 3769
     -- See (W5) in Note [Occurrence analysis for join points]
    
    3751
    -combineJoinPointUDs (OccEnv { occ_local_lets = local_lets }) uds1 uds2
    
    3770
    +combineJoinPointUDs (OccEnv { occ_nested_lets = nested_lets }) uds1 uds2
    
    3752 3771
       = combineUsageDetailsWith combine uds1 uds2
    
    3753 3772
       where
    
    3754 3773
         combine uniq occ1 occ2
    
    3755
    -      | uniq `elemVarSetByKey` local_lets = orLocalOcc  occ1 occ2
    
    3756
    -      | otherwise                         = andLocalOcc occ1 occ2
    
    3774
    +      | uniq `elemVarSetByKey` nested_lets = orLocalOcc  occ1 occ2
    
    3775
    +      | otherwise                          = andLocalOcc occ1 occ2
    
    3757 3776
     
    
    3758 3777
     mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails
    
    3759 3778
     mkOneOcc !env id int_cxt arity
    

  • compiler/GHC/Core/Opt/Simplify/Iteration.hs
    ... ... @@ -4595,21 +4595,13 @@ mkLetUnfolding :: SimplEnv -> TopLevelFlag -> UnfoldingSource
    4595 4595
                    -> InId -> Bool    -- True <=> this is a join point
    
    4596 4596
                    -> OutExpr -> SimplM Unfolding
    
    4597 4597
     mkLetUnfolding env top_lvl src id is_join new_rhs
    
    4598
    ---  | is_join
    
    4599
    ---  , UnfNever <- guidance
    
    4600
    ---  = -- For large join points, don't keep an unfolding at all if it is large
    
    4601
    ---    -- This is just an attempt to keep residency under control in
    
    4602
    ---    -- deeply-nested join-point such as those arising in #26425
    
    4603
    ---    return NoUnfolding
    
    4604
    -
    
    4605
    -  | otherwise
    
    4606
    -  = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance)
    
    4607
    -    -- We make an  unfolding *even for loop-breakers*.
    
    4608
    -    -- Reason: (a) It might be useful to know that they are WHNF
    
    4609
    -    --         (b) In GHC.Iface.Tidy we currently assume that, if we want to
    
    4610
    -    --             expose the unfolding then indeed we *have* an unfolding
    
    4611
    -    --             to expose.  (We could instead use the RHS, but currently
    
    4612
    -    --             we don't.)  The simple thing is always to have one.
    
    4598
    +  = return (mkUnfolding uf_opts src is_top_lvl is_bottoming is_join new_rhs Nothing)
    
    4599
    +            -- We make an  unfolding *even for loop-breakers*.
    
    4600
    +            -- Reason: (a) It might be useful to know that they are WHNF
    
    4601
    +            --         (b) In GHC.Iface.Tidy we currently assume that, if we want to
    
    4602
    +            --             expose the unfolding then indeed we *have* an unfolding
    
    4603
    +            --             to expose.  (We could instead use the RHS, but currently
    
    4604
    +            --             we don't.)  The simple thing is always to have one.
    
    4613 4605
       where
    
    4614 4606
         -- !opts: otherwise, we end up retaining all the SimpleEnv
    
    4615 4607
         !uf_opts = seUnfoldingOpts env
    
    ... ... @@ -4620,9 +4612,6 @@ mkLetUnfolding env top_lvl src id is_join new_rhs
    4620 4612
         -- See Note [Force bottoming field]
    
    4621 4613
         !is_bottoming = isDeadEndId id
    
    4622 4614
     
    
    4623
    -    is_top_bottoming = is_top_lvl && is_bottoming
    
    4624
    -    guidance         = calcUnfoldingGuidance uf_opts is_top_bottoming is_join new_rhs
    
    4625
    -
    
    4626 4615
     -------------------
    
    4627 4616
     simplStableUnfolding :: SimplEnv -> BindContext
    
    4628 4617
                          -> InId