Andreas Klebinger pushed to branch wip/ak/spec-loop at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • changelog.d/T27705
    1 
    +section: ghc
    2 
    +synopsis: Prevent the specializer from looping on recursive dictionary superclasses.
    3 
    +issues: #27705
    4 
    +mrs: !16559
    5 
    +

  • compiler/GHC/Core/Opt/Specialise.hs
    ... ... @@ -3120,8 +3120,8 @@ interestingDict :: SpecEnv -> CoreExpr -> Bool
    3120 3120 
     -- This is a subtle and important function
    3121 3121 
     -- See Note [Interesting dictionary arguments]
    3122 3122 
     interestingDict env (Var v)  -- See (ID3) and (ID5)
    3123 
    +  -- (ID6.a) Might fail for loop breaker dicts but that seems fine.
    3123 3124 
       | Just rhs <- maybeUnfoldingTemplate (idUnfolding v)
    3124 
    -  -- Might fail for loop breaker dicts but that seems fine.
    3125 3125 
       = interestingDict env rhs
    3126 3126
    3127 3127 
     interestingDict env arg  -- Main Plan: use exprIsConApp_maybe
    ... ... @@ -3152,7 +3152,8 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe
    3152 3152 
       where
    3153 3153 
         arg_ty                  = exprType arg
    3154 3154 
         definitely_not_ip_like  = not (couldBeIPLike arg_ty)
    3155 
    -    in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding
    3155 
    +    -- idUnfolding rather than realIdUnfolding: See (ID6.a)
    3156 
    +    in_scope_env = ISE (substInScopeSet $ se_subst env) idUnfolding
    3156 3157
    3157 3158 
     {- Note [Ticks on applications]
    3158 3159 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -3268,6 +3269,24 @@ case we can clearly specialise. But there are wrinkles:
    3268 3269 
        (Remember: a constraint tuple is just a class with N superclasses and no methods.)
    3269 3270 
        See discussion on #26831.
    3270 3271
    3272 
    +(ID6.a) If we deal with a recursive dictionary as in #27705 we want to avoid
    3273 
    +    infinite recursion while recursing into superclasses.
    3274 
    +
    3275 
    +    For example we might have:
    3276 
    +
    3277 
    +    class D1 a => D2 a
    3278 
    +    class D2 a => D1 a
    3279 
    +
    3280 
    +  The primary concern is that we want to avoid looping on recursive instances.
    3281 
    +  We can achieve this by simply not looking through loop breakers by using idUnfolding
    3282 
    +  rather than readIdUnfolding.
    3283 
    +
    3284 
    +  It's possible that this prevents specialization of edge cases that have loop breakers
    3285 
    +  in their recursive loop. But even if we can find a dictionary like this the simplifier
    3286 
    +  won't look through loopbreaker dictionaries either killing any potential benefit.
    3287 
    +  So while we could handle this case via a already-seen set or fuel we simply don't bother
    3288 
    +  for now.
    3289 
    +
    3271 3290 
     (ID7) A unary (single-method) class is currently represented by (meth |> co).  We
    3272 3291 
        will unwrap the cast (see (ID5)) and then want to reply "yes" if the method
    3273 3292 
        has any struture.  We rather arbitrarily use `exprIsHNF` for this.  (We plan a

  • testsuite/tests/simplCore/should_run/T27705.hs
    1 
    +module Main where
    2 
    +
    3 
    +import T27705_Inst
    4 
    +
    5 
    +-- The dictionaries (D1/D2) are mutually recursive. We have to watch
    6 
    +-- out for the specializer looping on them. This was first detected in #22802
    7 
    +-- but no test was added, which caused it to break again #27705 :(
    8 
    +main :: IO ()
    9 
    +main = print (b (3 :: Int))

  • testsuite/tests/simplCore/should_run/T27705.stdout
    1 
    +42

  • testsuite/tests/simplCore/should_run/T27705_Inst.hs
    1 
    +{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses, FlexibleInstances #-}
    2 
    +module T27705_Inst where
    3 
    +
    4 
    +-- The two dictionaries are mutually recursive, and we have to ensure the specialiser
    5 
    +-- doesn't loop when it's peaking through their unfoldings.
    6 
    +class D2 a => D1 a
    7 
    +class D1 a => D2 a
    8 
    +instance D2 Int => D1 Int
    9 
    +instance D1 Int => D2 Int
    10 
    +
    11 
    +{-# NOINLINE b #-}
    12 
    +b :: D1 a => a -> Int
    13 
    +b _ = 42

  • testsuite/tests/simplCore/should_run/all.T
    ... ... @@ -123,3 +123,5 @@ test('T24359b', normal, compile_and_run, ['-O'])
    123 123 
     test('T23429', normal, compile_and_run, ['-O'])
    124 124 
     test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv'])
    125 125 
     test('T27005', [], multimod_compile_and_run, ['T27005', '-O'])
    126 
    +test('T27705', [extra_hc_opts('+RTS -M500M -RTS')], multimod_compile_and_run,
    127 
    +     ['T27705', '-O2 -fexpose-all-unfoldings'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/b4f2c4b23cdbb919e8efeb349d197804de2ae438 at 1787684745