sheaf pushed to branch wip/andreask/ticked_joins at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Core/Opt/Exitify.hs
    ... ... @@ -327,16 +327,16 @@ Rationale for (ExitQuasi2):
    327 327
    328 328 
       Suppose we have:
    329 329
    330 
    -  quasijoinrec j x = case x of { 0 -> 100; _ -> j (x-1) } in j 0 |> co
    330 
    +    quasijoinrec j x = case x of { 0 -> 100; _ -> j (x-1) } in j 0 |> co
    331 331
    332 332 
       If we float an exit out of 'j', we end up with
    333 333
    334 
    -  join exit = 100 in
    335 
    -  quasijoinrec j x = case x of { 0 -> exit ; _ -> j (x-1) } in j 0 |> co
    334 
    +    join exit = 100 in
    335 
    +    quasijoinrec j x = case x of { 0 -> exit ; _ -> j (x-1) } in j 0 |> co
    336 336
    337 337 
       Now suppose we inline j and simplify; we end up with:
    338 338
    339 
    -  join exit = 100 in exit |> co
    339 
    +    join exit = 100 in (exit |> co)
    340 340
    341 341 
       We see now that 'exit' must be a quasi join point, due to the cast.
    342 342

  • compiler/GHC/Core/Opt/OccurAnal.hs
    ... ... @@ -3714,31 +3714,21 @@ localTailCallInfo (OneOccL { lo_tail = tci }) = tci
    3714 3714 
     localTailCallInfo (ManyOccL tci)               = tci
    3715 3715
    3716 3716 
     type ZappedSet = OccInfoEnv -- Values are ignored
    3717 
    -
    3718 
    --- | Either zap a tail call or set it to a quasi tail call.
    3719 
    ---
    3720 
    --- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.
    3721 
    -type ZapTailSet = IdEnv MarkNonTail
    3722 
    -
    3723 
    -data MarkNonTail
    3724 
    -  = MarkQuasi
    3725 
    -  | MarkNonTail
    3726 
    -  deriving stock ( Eq, Show )
    3727 
    -instance Outputable MarkNonTail where
    3728 
    -  ppr MarkQuasi   = text "MarkQuasi"
    3729 
    -  ppr MarkNonTail = text "MarkNonTail"
    3730 
    -instance Semigroup MarkNonTail where
    3731 
    -  MarkQuasi <> MarkQuasi = MarkQuasi
    3732 
    -  _ <> _ = MarkNonTail
    3733 
    -
    3734 3717 
     data UsageDetails
    3735 3718 
       = UD { ud_env       :: !OccInfoEnv
    3736 3719 
            , ud_z_many    :: !ZappedSet   -- ^ apply 'markMany' to these
    3737 3720 
            , ud_z_in_lam  :: !ZappedSet   -- ^ apply 'markInsideLam' to these
    3738 
    -       , ud_z_tail    :: !ZapTailSet  -- ^ zap tail-call info for these
    3721 
    +       , ud_z_tail    :: !ZappedSet   -- ^ zap tail-call info for these
    3722 
    +       , ud_z_quasi   :: !ZappedSet   -- ^ mark these as quasi tail-calls
    3723 
    +                                      -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration
    3739 3724 
            }
    3740 3725 
       -- INVARIANT: All three zapped sets are subsets of ud_env
    3741 3726
    3727 
    +-- Implementation remark: having two separate sets (ud_z_tail and ud_z_quasi)
    3728 
    +-- is significantly more efficient than having a single 'IdEnv IsTrueJoinPoint',
    3729 
    +-- as having to use 'strictPlusVarEnv_C' in 'combineUsageDetailsWith'
    3730 
    +-- hugely regresses allocations in e.g. T24471.
    3731 
    +
    3742 3732 
     instance Outputable UsageDetails where
    3743 3733 
       ppr ud@(UD { ud_env = env, ud_z_tail = z_tail })
    3744 3734 
         = text "UD" <> (braces (vcat
    ... ... @@ -3852,19 +3842,25 @@ mkSimpleDetails :: OccInfoEnv -> UsageDetails
    3852 3842 
     mkSimpleDetails env = UD { ud_env       = env
    3853 3843 
                              , ud_z_many    = emptyVarEnv
    3854 3844 
                              , ud_z_in_lam  = emptyVarEnv
    3855 
    -                         , ud_z_tail    = emptyVarEnv }
    3845 
    +                         , ud_z_tail    = emptyVarEnv
    3846 
    +                         , ud_z_quasi   = emptyVarEnv }
    3856 3847
    3857 3848 
     modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails
    3858 3849 
     modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env }
    3859 3850
    3860 3851 
     delBndrsFromUDs :: [Var] -> UsageDetails -> UsageDetails
    3861 3852 
     -- Delete these binders from the UsageDetails
    3862 
    -delBndrsFromUDs bndrs (UD { ud_env = env, ud_z_many = z_many
    3863 
    -                          , ud_z_in_lam  = z_in_lam, ud_z_tail = z_tail })
    3864 
    -  = UD { ud_env       = env      `delVarEnvList` bndrs
    3865 
    -       , ud_z_many    = z_many   `delVarEnvList` bndrs
    3866 
    -       , ud_z_in_lam  = z_in_lam `delVarEnvList` bndrs
    3867 
    -       , ud_z_tail    = z_tail   `delVarEnvList` bndrs }
    3853 
    +delBndrsFromUDs bndrs
    3854 
    +  (UD { ud_env      = env
    3855 
    +      , ud_z_many   = z_many
    3856 
    +      , ud_z_in_lam = z_in_lam
    3857 
    +      , ud_z_tail   = z_tail
    3858 
    +      , ud_z_quasi  = z_quasi })
    3859 
    +  = UD { ud_env      = env      `delVarEnvList` bndrs
    3860 
    +       , ud_z_many   = z_many   `delVarEnvList` bndrs
    3861 
    +       , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs
    3862 
    +       , ud_z_tail   = z_tail   `delVarEnvList` bndrs
    3863 
    +       , ud_z_quasi  = z_quasi  `delVarEnvList` bndrs }
    3868 3864
    3869 3865 
     markAllMany, markAllInsideLam, markAllNonTail, markAllQuasiTail, markAllManyNonTail
    3870 3866 
       :: HasDebugCallStack => UsageDetails -> UsageDetails
    ... ... @@ -3872,13 +3868,8 @@ markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env }
    3872 3868 
     markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env }
    3873 3869 
     markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo
    3874 3870
    3875 
    -markAllNonTail ud@(UD { ud_env = env }) =
    3876 
    -  ud { ud_z_tail   = fmap (const MarkNonTail) env }
    3877 
    -markAllQuasiTail ud@(UD { ud_env = env, ud_z_tail = z_tail }) =
    3878 
    -  let quasis = fmap (const MarkQuasi) env
    3879 
    -  in ud { ud_z_tail   = strictPlusVarEnv_C (Semi.<>) quasis z_tail }
    3880 
    -  -- NB: be careful not to override any MarkNonTail with MarkQuasi.
    3881 
    -
    3871 
    +markAllNonTail   ud@(UD { ud_env = env }) = ud { ud_z_tail  = env }
    3872 
    +markAllQuasiTail ud@(UD { ud_env = env }) = ud { ud_z_quasi = env }
    3882 3873 
     markAllInsideLamIf, markAllNonTailIf :: HasDebugCallStack => Bool -> UsageDetails -> UsageDetails
    3883 3874
    3884 3875 
     markAllInsideLamIf  True  ud = markAllInsideLam ud
    ... ... @@ -3888,24 +3879,28 @@ markAllNonTailIf True ud = markAllNonTail ud
    3888 3879 
     markAllNonTailIf False ud = ud
    3889 3880
    3890 3881 
     lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo
    3891 
    -lookupTailCallInfo (UD { ud_env = env, ud_z_tail = z_tail }) id =
    3882 
    +lookupTailCallInfo (UD { ud_env = env, ud_z_tail = z_tail, ud_z_quasi = z_quasi }) id =
    3892 3883 
       case localTailCallInfo <$> lookupVarEnv env id of
    3893 3884 
         Nothing -> NoTailCallInfo
    3894 
    -    Just ti -> maybeZapTailCallInfo ti z_tail (idUnique id)
    3895 
    -
    3896 
    -maybeZapTailCallInfo :: TailCallInfo -> ZapTailSet -> Unique -> TailCallInfo
    3897 
    -maybeZapTailCallInfo tail_info0 z_tail id_unique =
    3898 
    -  case lookupVarEnv_Directly z_tail id_unique of
    3899 
    -    Just MarkNonTail -> NoTailCallInfo
    3900 
    -
    3901 
    -    -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.
    3902 
    -    Just MarkQuasi ->
    3903 
    -      case tail_info0 of
    3904 
    -        NoTailCallInfo -> NoTailCallInfo
    3905 
    -        atc@AlwaysTailCalled {} ->
    3906 
    -          atc { tailCallJoinPointType = QuasiJoinPoint }
    3907 
    -
    3908 
    -    Nothing -> tail_info0
    3885 
    +    Just ti -> maybeZapTailCallInfo ti z_tail z_quasi (idUnique id)
    3886 
    +
    3887 
    +maybeZapTailCallInfo
    3888 
    +  :: TailCallInfo
    3889 
    +  -> ZappedSet -- ^ zap tail
    3890 
    +  -> ZappedSet -- ^ quasi tail
    3891 
    +  -> Unique
    3892 
    +  -> TailCallInfo
    3893 
    +maybeZapTailCallInfo tail_info0 no_tail quasi_tail id_unique
    3894 
    +  | elemVarEnvByKey id_unique no_tail
    3895 
    +  = NoTailCallInfo
    3896 
    +  | elemVarEnvByKey id_unique quasi_tail
    3897 
    +  -- See Note [Quasi join points] in GHC.Core.Opt.Simplify.Iteration.
    3898 
    +  = case tail_info0 of
    3899 
    +      NoTailCallInfo -> NoTailCallInfo
    3900 
    +      atc@AlwaysTailCalled {} ->
    3901 
    +        atc { tailCallJoinPointType = QuasiJoinPoint }
    3902 
    +  | otherwise
    3903 
    +  = tail_info0
    3909 3904
    3910 3905 
     udFreeVars :: VarSet -> UsageDetails -> VarSet
    3911 3906 
     -- Find the subset of bndrs that are mentioned in uds
    ... ... @@ -3921,18 +3916,20 @@ combineUsageDetailsWith :: (Unique -> LocalOcc -> LocalOcc -> LocalOcc)
    3921 3916 
                             -> UsageDetails -> UsageDetails -> UsageDetails
    3922 3917 
     {-# INLINE combineUsageDetailsWith #-}
    3923 3918 
     combineUsageDetailsWith plus_occ_info
    3924 
    -    uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 })
    3925 
    -    uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 })
    3919 
    +    uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1, ud_z_quasi = z_quasi1 })
    3920 
    +    uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2, ud_z_quasi = z_quasi2 })
    3926 3921 
       | isEmptyVarEnv env1 = uds2
    3927 3922 
       | isEmptyVarEnv env2 = uds1
    3928 3923 
       | otherwise
    3929 3924 
       -- See Note [Strictness in the occurrence analyser]
    3930 3925 
       -- Using strictPlusVarEnv here speeds up the test T26425
    3931 3926 
       -- by about 10% by avoiding intermediate thunks.
    3932 
    -  = UD { ud_env       = strictPlusVarEnv_C_Directly plus_occ_info env1 env2
    3933 
    -       , ud_z_many    = strictPlusVarEnv z_many1   z_many2
    3934 
    -       , ud_z_in_lam  = plusVarEnv z_in_lam1 z_in_lam2
    3935 
    -       , ud_z_tail    = strictPlusVarEnv_C (Semi.<>) z_tail1 z_tail2 }
    3927 
    +  = UD { ud_env      = strictPlusVarEnv_C_Directly plus_occ_info env1 env2
    3928 
    +       , ud_z_many   = strictPlusVarEnv z_many1   z_many2
    3929 
    +       , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2
    3930 
    +       , ud_z_tail   = strictPlusVarEnv z_tail1 z_tail2
    3931 
    +       , ud_z_quasi  = strictPlusVarEnv z_quasi1 z_quasi2
    3932 
    +       }
    3936 3933
    3937 3934 
     lookupLetOccInfo :: UsageDetails -> Id -> OccInfo
    3938 3935 
     -- Don't use locally-generated occ_info for exported (visible-elsewhere)
    ... ... @@ -3950,13 +3947,14 @@ lookupOccInfoByUnique :: UsageDetails -> Unique -> OccInfo
    3950 3947 
     lookupOccInfoByUnique (UD { ud_env       = env
    3951 3948 
                               , ud_z_many    = z_many
    3952 3949 
                               , ud_z_in_lam  = z_in_lam
    3953 
    -                          , ud_z_tail    = z_tail })
    3950 
    +                          , ud_z_tail    = z_tail
    3951 
    +                          , ud_z_quasi   = z_quasi })
    3954 3952 
                       uniq
    3955 3953 
       = case lookupVarEnv_Directly env uniq of
    3956 3954 
           Nothing -> IAmDead
    3957 3955 
           Just (OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt
    3958 3956 
                         , lo_tail = tail_info })
    3959 
    -          | uniq `elemVarEnvByKey`z_many
    3957 
    +          | uniq `elemVarEnvByKey` z_many
    3960 3958 
               -> ManyOccs { occ_tail = mk_tail_info tail_info }
    3961 3959 
               | otherwise
    3962 3960 
               -> OneOcc { occ_in_lam  = in_lam
    ... ... @@ -3969,7 +3967,7 @@ lookupOccInfoByUnique (UD { ud_env = env
    3969 3967
    3970 3968 
           Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info }
    3971 3969 
       where
    3972 
    -    mk_tail_info ti = maybeZapTailCallInfo ti z_tail uniq
    3970 
    +    mk_tail_info ti = maybeZapTailCallInfo ti z_tail z_quasi uniq
    3973 3971
    3974 3972 
     -------------------
    3975 3973 
     -- See Note [Adjusting right-hand sides]

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help