Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-22 at Glasgow Haskell Compiler / GHC

Commits:

11 changed files:

Changes:

  • .gitlab-ci.yml
    ... ... @@ -1300,7 +1300,7 @@ ghcup-metadata-nightly:
    1300 1300 
           artifacts: false
    1301 1301 
         - job: project-version
    1302 1302 
       script:
    1303 
    -    - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml"
    1303 
    +    - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" metadata_test.yaml
    1304 1304 
       rules:
    1305 1305 
         - if: $NIGHTLY
    1306 1306

  • .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
    ... ... @@ -324,6 +324,7 @@ def main() -> None:
    324 324 
         # TODO: We could work out the --version from the project-version CI job.
    325 325 
         parser.add_argument('--version', required=True, type=str, help='Version of the GHC compiler')
    326 326 
         parser.add_argument('--date', required=True, type=str, help='Date of the compiler release')
    327 
    +    parser.add_argument('output_path', nargs='?', type=Path, help='Path to write the output to, if not set, dump to stdout')
    327 328 
         args = parser.parse_args()
    328 329
    329 330 
         project = gl.projects.get(1, lazy=True)
    ... ... @@ -352,13 +353,14 @@ def main() -> None:
    352 353 
             with open(args.metadata, 'r') as file:
    353 354 
                 ghcup_metadata = yaml.safe_load(file)
    354 355 
                 if  args.version in ghcup_metadata['ghcupDownloads']['GHC']:
    355 
    -                # if there are days without a commit, then the nightly metadata
    356 
    -                # is up to date by default, no need to fail, no need to upload anything
    357 
    -                print("Refusing to override existing version in metadata, exiting")
    358 
    -                sys.exit()
    356 
    +                eprint("GHCUp nightly run produced the same metadata as last night")
    359 357 
                 setNightlyTags(ghcup_metadata)
    360 358 
                 ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml
    361 
    -            print(yaml.dump(ghcup_metadata))
    359 
    +            if args.output_path:
    360 
    +                with open(args.output_path, 'w') as ofile:
    361 
    +                    yaml.dump(ghcup_metadata, ofile)
    362 
    +            else:
    363 
    +                print(yaml.dump(ghcup_metadata))
    362 364
    363 365
    364 366

  • changelog.d/T27705
    1 
    +section: compiler
    2 
    +synopsis: Fixed an issue that caused the specializer to sometimes loop 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
    ... ... @@ -3136,9 +3136,9 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe
    3136 3136 
            , isIPClass cls      -- See (ID5)
    3137 3137 
            -> False
    3138 3138
    3139 
    -       -- Otherwise we are unwrapping a unary type class
    3139 
    +       -- Shouldn't happen.
    3140 3140 
            | otherwise
    3141 
    -       -> exprIsHNF arg   -- See (ID7)
    3141 
    +       -> pprTraceDebug "shouldn't happen anymore" (ppr arg) $ exprIsHNF arg -- See (ID7)
    3142 3142
    3143 3143 
       | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg
    3144 3144 
       , Just cls <- tyConClass_maybe (dataConTyCon data_con)
    ... ... @@ -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,11 +3269,27 @@ 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
    3271 
    -(ID7) A unary (single-method) class is currently represented by (meth |> co).  We
    3272 
    -   will unwrap the cast (see (ID5)) and then want to reply "yes" if the method
    3273 
    -   has any struture.  We rather arbitrarily use `exprIsHNF` for this.  (We plan a
    3274 
    -   new story for unary classes, see #23109, and this special case will become
    3275 
    -   irrelevant.)
    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 realIdUnfolding.
    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 
    +
    3290 
    +(ID7) A unary (single-method) class is currently handled by the same path as regular dicts
    3291 
    +   since they are represented by faking a regular Dictionary.
    3292 
    +   See Note [Unary class magic] for the details.
    3276 3293
    3277 3294 
     (ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a
    3278 3295 
        non-trivial argument as interesting. In T19695 we have this:

  • compiler/GHC/Hs/Doc.hs
    ... ... @@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc
    58 58 
     import Language.Haskell.Syntax.Extension
    59 59 
     import Language.Haskell.Syntax.Module.Name
    60 60
    61 
    +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
    61 62 
     type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan
    62 63
    63 64 
     deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass)

  • compiler/GHC/Hs/Extension/Pass.hs
    ... ... @@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a
    46 46 
     -- but pass-independent, source location
    47 47 
     type XRecGhc a = GenLocated (Anno a) a
    48 48
    49 
    +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine
    49 50 
     type instance Anno (HsDocString (GhcPass _))  = SrcSpan
    50 51 
     type instance Anno HsDocStringChunk           = SrcSpan
    51 52

  • 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'])

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -3397,13 +3397,13 @@ instance ExactPrint (HsCmd GhcPs) where
    3397 3397 
           e' <- markAnnotated e
    3398 3398 
           return (HsCmdLet (tkLet', tkIn') binds' e')
    3399 3399
    3400 
    -  exact (HsCmdDo (an0,loc) (L l es)) = do
    3400 
    +  exact (HsCmdDo (an0,loc) es) = do
    3401 3401 
         debugM $ "HsCmdDo"
    3402 3402 
         loc' <- printStringAtAA loc "do"
    3403 3403 
         (an1,es') <- markAnnList' an0 $ do
    3404 
    -      ee <- mapM markAnnotated es
    3404 
    +      ee <- markAnnotated es
    3405 3405 
           return ee
    3406 
    -    return (HsCmdDo (an1,loc') (L l es'))
    3406 
    +    return (HsCmdDo (an1,loc') es')
    3407 3407
    3408 3408 
     -- ---------------------------------------------------------------------
    3409 3409
    ... ... @@ -4462,10 +4462,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe
    4462 4462 
           Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
    4463 4463 
             debugM $ "LocatedL [ExprLStmt: snocView"
    4464 4464 
             ls' <- markAnnotated ls
    4465 
    -        initStmts' <- markAnnotated initStmts
    4465 
    +        initStmts' <- mapM markAnnotated initStmts
    4466 4466 
             return (initStmts' ++ [ls'])
    4467 4467 
           _ -> do
    4468 
    -        stmts' <- markAnnotated stmts
    4468 
    +        stmts' <- mapM markAnnotated stmts
    4469 4469 
             return stmts'
    4470 4470
    4471 4471 
     instance ExactPrint [Located HsDocStringChunk] where

    • —
    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/-/compare/e9c6b1d38e91dc92fdfb0aee06b9403762b8cadb...ee1c879eaf97bd0e168234f96237322187baab86 at 1788175940