Zubin pushed to branch wip/26416 at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Core/Opt/DmdAnal.hs
    ... ... @@ -23,7 +23,7 @@ import GHC.Core.DataCon
    23 23 
     import GHC.Core.Utils
    24 24 
     import GHC.Core.TyCon
    25 25 
     import GHC.Core.Type
    26 
    -import GHC.Core.FVs      ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds )
    26 
    +import GHC.Core.FVs      ( rulesRhsFreeIds, bndrRuleAndUnfoldingIds, idRuleVars )
    27 27 
     import GHC.Core.Coercion ( Coercion )
    28 28 
     import GHC.Core.TyCo.FVs     ( coVarsOfCos )
    29 29 
     import GHC.Core.TyCo.Compare ( eqType )
    ... ... @@ -1113,7 +1113,8 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs
    1113 1113 
         -- might use arguments that the (optimised) RHS doesn't.
    1114 1114 
         -- Any argument with a demand absent in one but not the other can
    1115 1115 
         -- be problematic, see #26416
    1116 
    -    combined_rhs_dmds = combineUnfoldingDmds env rhs_sd id rhs_dmds
    1116 
    +    -- Also combine the DmdEnv (free variables) from the unfolding
    1117 
    +    (unf_fv_env, combined_rhs_dmds) = combineUnfoldingDmds env rhs_sd id rhs_env rhs_dmds
    1117 1118
    1118 1119 
         (final_rhs_dmds, final_rhs) = finaliseArgBoxities env id ww_arity
    1119 1120 
                                                           combined_rhs_dmds (de_div rhs_env) rhs'
    ... ... @@ -1144,7 +1145,10 @@ dmdAnalRhsSig top_lvl rec_flag env let_sd id rhs
    1144 1145 
                     NonRecursive -> rhs_env
    1145 1146
    1146 1147 
         -- See Note [Absence analysis for stable unfoldings and RULES]
    1147 
    -    rhs_env2 = rhs_env1 `plusDmdEnv` demandRootSet env (bndrRuleAndUnfoldingIds id)
    1148 
    +    -- The unfolding FVs are handled via unf_fv_env from combineUnfoldingDmds.
    1149 
    +    -- Here we only need demandRoots for RULES.
    1150 
    +    rhs_env2 = rhs_env1 `plusDmdEnv` unf_fv_env
    1151 
    +                        `plusDmdEnv` demandRootSet env (idRuleVars id)
    1148 1152
    1149 1153 
         -- See Note [Lazy and unleashable free variables]
    1150 1154 
         !(!sig_env, !weak_fvs) = splitWeakDmds rhs_env2
    ... ... @@ -1153,27 +1157,30 @@ splitWeakDmds :: DmdEnv -> (DmdEnv, WeakDmds)
    1153 1157 
     splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs)
    1154 1158 
       where (!weak_fvs, !sig_fvs) = partitionVarEnv isWeakDmd fvs
    1155 1159
    1156 
    --- | If there is a stable unfolding, don't let any demand be absent that
    1157 
    --- is also not absent in the unfolding
    1160 
    +-- | If there is a stable unfolding, combine argument demands and free variable
    1161 
    +-- demands from the unfolding with those from the RHS.
    1158 1162 
     -- See Note [Absence analysis for stable unfoldings and RULES], Wrinkle (W3).
    1159 
    -combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> [Demand] -> [Demand]
    1160 
    -combineUnfoldingDmds env rhs_sd id rhs_dmds
    1163 
    +--
    1164 
    +-- Returns (combined DmdEnv for free variables, combined arg demands)
    1165 
    +-- The DmdEnv is nopDmdEnv if there's no stable unfolding.
    1166 
    +combineUnfoldingDmds :: AnalEnv -> SubDemand -> Id -> DmdEnv -> [Demand] -> (DmdEnv, [Demand])
    1167 
    +combineUnfoldingDmds env rhs_sd id rhs_fv_env rhs_dmds
    1161 1168 
       | not (isStableUnfolding unf)
    1162 
    -  = rhs_dmds  -- No stable unfolding, nothing to do
    1169 
    +  = (nopDmdEnv, rhs_dmds)  -- No stable unfolding, nothing to do
    1163 1170
    1164 1171 
       | Just unf_body <- maybeUnfoldingTemplate unf
    1165 
    -  , let WithDmdType (DmdType _ unf_dmds) _ = dmdAnal env rhs_sd unf_body
    1166 
    -  , let result = go rhs_dmds unf_dmds
    1167 
    -  = -- pprTrace "lubUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr result) $
    1168 
    -   result
    1169 
    -  | otherwise = rhs_dmds
    1172 
    +  , let WithDmdType (DmdType unf_fv_env unf_dmds) _ = dmdAnal env rhs_sd unf_body
    1173 
    +  , let combined_dmds = go rhs_dmds unf_dmds
    1174 
    +        -- Lub the free variable demands from unfolding with RHS
    1175 
    +        combined_fv_env = lubDmdEnv rhs_fv_env unf_fv_env
    1176 
    +  = -- pprTrace "combineUnfoldingDmds" (ppr id $$ ppr rhs_dmds $$ ppr unf_dmds $$ ppr combined_dmds) $
    1177 
    +   (combined_fv_env, combined_dmds)
    1178 
    +  | otherwise = (nopDmdEnv, rhs_dmds)
    1170 1179 
       where
    1171 1180 
         unf = realIdUnfolding id
    1172 1181 
         go rhs          []            = rhs
    1173 1182 
         go []           _             = []
    1174 
    -    go (AbsDmd:rhs) (u:unfs)      = u : go rhs unfs
    1175 
    -    go (r:rhs)      (AbsDmd:unfs) = r : go rhs unfs
    1176 
    -    go (r:rhs)      (_:unfs) = r : go rhs unfs
    1183 
    +    go (r:rhs)      (u:unfs)      = lubUBglbLBDmd r u : go rhs unfs
    1177 1184
    1178 1185 
     -- | The result type after applying 'idArity' many arguments. Returns 'Nothing'
    1179 1186 
     -- when the type doesn't have exactly 'idArity' many arrows.
    ... ... @@ -1555,7 +1562,7 @@ Wrinkles:
    1555 1562 
         error instead of the `really important message`.
    1556 1563
    1557 1564 
       (W3) The SOLUTION above handles /free variables/ of stable unfoldings, but
    1558 
    -    what about /arguments/?  Consider (#25965)
    1565 
    +    what about /arguments/?  Consider (#26416)
    1559 1566
    1560 1567 
            fromVector :: (Storable a, KnownNat n) => Vector a -> Vector a
    1561 1568 
            fromVector v = ... (uses Storable dictionary) ...
    ... ... @@ -1569,9 +1576,18 @@ Wrinkles:
    1569 1576 
         dictionary, leading to a segfault!
    1570 1577
    1571 1578 
         SOLUTION: in `dmdAnalRhsSig`, if the function has a stable unfolding,
    1572 
    -    analyse it and drop any AbsDmds which are not absent in the unfolding.
    1573 
    -    This is done by `combineUnfoldingDmds`.  This ensures that if the unfolding
    1574 
    -    uses an argument, it won't be marked as absent.
    1579 
    +    analyse it with `dmdAnal` and combine the resulting `DmdType` with the
    1580 
    +    RHS's `DmdType`. This is done by `combineUnfoldingDmds`, which:
    1581 
    +
    1582 
    +      * For argument demands: combines them using `lubUBglbLBDmd`, which takes
    1583 
    +        the glb (max) of lower bounds (strictness) and lub (max) of upper
    1584 
    +        bounds (usage). See Note [Combining demands for stable unfoldings].
    1585 
    +        This ensures that if the unfolding uses an argument, it won't be
    1586 
    +        marked as absent, while preserving any strictness the RHS reveals.
    1587 
    +
    1588 
    +      * For free variable demands: combines them using `lubDmdEnv`. This
    1589 
    +        replaces the `demandRoots` approach for stable unfoldings (though
    1590 
    +        we still use `demandRoots` for RULES via `idRuleVars`).
    1575 1591
    1576 1592 
     Note [DmdAnal for DataCon wrappers]
    1577 1593 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Types/Demand.hs
    ... ... @@ -23,6 +23,8 @@ module GHC.Types.Demand (
    23 23 
         lubCard, lubDmd, lubSubDmd,
    24 24 
         -- *** Greatest lower bound
    25 25 
         glbCard,
    26 
    +    -- *** Unfolding combination (glb on strictness, lub on usage)
    27 
    +    lubUBglbLBDmd,
    26 28 
         -- *** Plus
    27 29 
         plusCard, plusDmd, plusSubDmd,
    28 30 
         -- *** Multiply
    ... ... @@ -49,7 +51,7 @@ module GHC.Types.Demand (
    49 51
    50 52 
         -- * Demand environments
    51 53 
         DmdEnv(..), addVarDmdEnv, mkTermDmdEnv, nopDmdEnv, plusDmdEnv, plusDmdEnvs,
    52 
    -    multDmdEnv, reuseEnv,
    54 
    +    lubDmdEnv, multDmdEnv, reuseEnv,
    53 55
    54 56 
         -- * Demand types
    55 57 
         DmdType(..), dmdTypeDepth,
    ... ... @@ -864,6 +866,77 @@ lubSubDmd sd1@Poly{} sd2 = lubSubDmd sd2 sd1
    864 866 
     -- Otherwise (Call `lub` Prod) return Top
    865 867 
     lubSubDmd _            _            = topSubDmd
    866 868
    869 
    +{- Note [Combining demands for stable unfoldings]
    870 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    871 
    +When a function has a stable unfolding, the optimised RHS and the unfolding
    872 
    +may have different demand signatures for the same arguments. This can happen
    873 
    +because:
    874 
    +
    875 
    +  * The optimised RHS may have had transformations applied that reveal
    876 
    +    strictness (e.g., inlining exposes a case on an argument).
    877 
    +
    878 
    +  * The optimised RHS may have had transformations applied that drop usage
    879 
    +    (e.g., a rewrite rule fires that doesn't use an argument, or a seq on
    880 
    +    a dictionary is dropped because dictionaries are known to terminate).
    881 
    +
    882 
    +When we inline the stable unfolding at a call site, we get the unfolding's
    883 
    +behaviour, not the RHS's. So we must be conservative and combine the demands:
    884 
    +
    885 
    +  * For strictness (lower bounds): we can take the MAXIMUM (glb).
    886 
    +    If the RHS reveals that an argument is strict, that strictness was
    887 
    +    always there semantically - the analysis just couldn't see it in the
    888 
    +    unfolding. Sound optimisations never make lazy code strict.
    889 
    +
    890 
    +  * For usage (upper bounds): we must take the MAXIMUM (lub).
    891 
    +    If the unfolding uses an argument but the RHS doesn't, we must not
    892 
    +    mark it absent, or we'll replace it with rubbish that the unfolding
    893 
    +    will then try to use, causing a segfault. See #26416.
    894 
    +
    895 
    +So for cardinality bounds [l1..u1] from RHS and [l2..u2] from unfolding,
    896 
    +we compute [max(l1,l2)..max(u1,u2)].
    897 
    +
    898 
    +See Note [Absence analysis for stable unfoldings and RULES] in GHC.Core.Opt.DmdAnal
    899 
    +for the broader context.
    900 
    +-}
    901 
    +
    902 
    +-- | Combine demands for stable unfolding analysis.
    903 
    +-- See Note [Combining demands for stable unfoldings].
    904 
    +lubUBglbLBCard :: Card -> Card -> Card
    905 
    +-- Given Note [Bit vector representation for Card]:
    906 
    +--   * bit 0 (strictness): take AND (glb) - 0 means strict, so 0 wins
    907 
    +--   * bits 1,2 (usage): take OR (lub) - if either uses, result uses
    908 
    +lubUBglbLBCard (Card a) (Card b) = Card ((a .&. b .&. 0b001) .|. ((a .|. b) .&. 0b110))
    909 
    +
    910 
    +-- | See Note [Combining demands for stable unfoldings].
    911 
    +lubUBglbLBDmd :: Demand -> Demand -> Demand
    912 
    +lubUBglbLBDmd BotDmd      dmd2        = dmd2
    913 
    +lubUBglbLBDmd dmd1        BotDmd      = dmd1
    914 
    +lubUBglbLBDmd (n1 :* sd1) (n2 :* sd2) =
    915 
    +  lubUBglbLBCard n1 n2 :* lubUBglbLBSubDmd sd1 sd2
    916 
    +
    917 
    +lubUBglbLBSubDmd :: SubDemand -> SubDemand -> SubDemand
    918 
    +-- Shortcuts for neutral and absorbing elements.
    919 
    +lubUBglbLBSubDmd (Poly Unboxed C_10)  sd                   = sd
    920 
    +lubUBglbLBSubDmd sd                   (Poly Unboxed C_10)  = sd
    921 
    +lubUBglbLBSubDmd sd@(Poly Boxed C_0N) _                    = sd
    922 
    +lubUBglbLBSubDmd _                    sd@(Poly Boxed C_0N) = sd
    923 
    +-- Prod
    924 
    +lubUBglbLBSubDmd (Prod b1 ds1) (Poly b2 n2)
    925 
    +  | let !d = polyFieldDmd b2 n2
    926 
    +  = mkProd (lubBoxity b1 b2) (strictMap (lubUBglbLBDmd d) ds1)
    927 
    +lubUBglbLBSubDmd (Prod b1 ds1) (Prod b2 ds2)
    928 
    +  | equalLength ds1 ds2
    929 
    +  = mkProd (lubBoxity b1 b2) (strictZipWith lubUBglbLBDmd ds1 ds2)
    930 
    +-- Handle Call
    931 
    +lubUBglbLBSubDmd (Call n1 sd1) (viewCall -> Just (n2, sd2)) =
    932 
    +  mkCall (lubUBglbLBCard n1 n2) (lubUBglbLBSubDmd sd1 sd2)
    933 
    +-- Handle Poly
    934 
    +lubUBglbLBSubDmd (Poly b1 n1) (Poly b2 n2) = Poly (lubBoxity b1 b2) (lubUBglbLBCard n1 n2)
    935 
    +-- Other Poly case by commutativity
    936 
    +lubUBglbLBSubDmd sd1@Poly{}   sd2          = lubUBglbLBSubDmd sd2 sd1
    937 
    +-- Otherwise (Call `lubUBglbLB` Prod) return Top
    938 
    +lubUBglbLBSubDmd _            _            = topSubDmd
    939 
    +
    867 940 
     -- | Denotes '+' on 'Demand'.
    868 941 
     plusDmd :: Demand -> Demand -> Demand
    869 942 
     plusDmd AbsDmd      dmd2        = dmd2

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