Zubin pushed to branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC

Commits:

18 changed files:

Changes:

  • compiler/GHC/Core/Map/Type.hs
    ... ... @@ -47,7 +47,7 @@ import GHC.Types.Name
    47 47 
     import GHC.Types.Name.Env
    48 48 
     import GHC.Types.Var
    49 49 
     import GHC.Types.Var.Env
    50 
    -import GHC.Types.Unique.FM
    50 
    +import GHC.Types.Unique.DFM
    51 51 
     import GHC.Utils.Outputable
    52 52
    53 53 
     import GHC.Utils.Panic
    ... ... @@ -364,14 +364,14 @@ filterT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon
    364 364
    365 365 
     ------------------------
    366 366 
     data TyLitMap a = TLM { tlm_number :: Map.Map Integer a
    367 
    -                      , tlm_string :: UniqFM  FastString a
    367 
    +                      , tlm_string :: UniqDFM  FastString a
    368 368 
                           , tlm_char   :: Map.Map Char a
    369 369 
                           }
    370 370
    371 371 
     -- TODO(22292): derive
    372 372 
     instance Functor TyLitMap where
    373 373 
         fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM
    374 
    -      { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc }
    374 
    +      { tlm_number = Map.map f tn, tlm_string = mapUDFM f ts, tlm_char = Map.map f tc }
    375 375
    376 376 
     instance TrieMap TyLitMap where
    377 377 
        type Key TyLitMap = TyLit
    ... ... @@ -382,30 +382,30 @@ instance TrieMap TyLitMap where
    382 382 
        filterTM = filterTyLit
    383 383
    384 384 
     emptyTyLitMap :: TyLitMap a
    385 
    -emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty }
    385 
    +emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUDFM, tlm_char = Map.empty }
    386 386
    387 387 
     lkTyLit :: TyLit -> TyLitMap a -> Maybe a
    388 388 
     lkTyLit l =
    389 389 
       case l of
    390 390 
         NumTyLit n -> tlm_number >.> Map.lookup n
    391 
    -    StrTyLit n -> tlm_string >.> (`lookupUFM` n)
    391 
    +    StrTyLit n -> tlm_string >.> (`lookupUDFM` n)
    392 392 
         CharTyLit n -> tlm_char >.> Map.lookup n
    393 393
    394 394 
     xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a
    395 395 
     xtTyLit l f m =
    396 396 
       case l of
    397 397 
         NumTyLit n ->  m { tlm_number = Map.alter f n (tlm_number m) }
    398 
    -    StrTyLit n ->  m { tlm_string = alterUFM  f (tlm_string m) n }
    398 
    +    StrTyLit n ->  m { tlm_string = alterUDFM  f (tlm_string m) n }
    399 399 
         CharTyLit n -> m { tlm_char = Map.alter f n (tlm_char m) }
    400 400
    401 401 
     foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b
    402 
    -foldTyLit l m = flip (nonDetFoldUFM l) (tlm_string m)
    402 
    +foldTyLit l m = flip (foldUDFM l)  (tlm_string m)
    403 403 
                   . flip (Map.foldr l) (tlm_number m)
    404 404 
                   . flip (Map.foldr l) (tlm_char m)
    405 405
    406 406 
     filterTyLit :: (a -> Bool) -> TyLitMap a -> TyLitMap a
    407 407 
     filterTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc })
    408 
    -  = TLM { tlm_number = Map.filter f tn, tlm_string = filterUFM f ts, tlm_char = Map.filter f tc }
    408 
    +  = TLM { tlm_number = Map.filter f tn, tlm_string = filterUDFM f ts, tlm_char = Map.filter f tc }
    409 409
    410 410 
     -------------------------------------------------
    411 411 
     -- | @TypeMap a@ is a map from 'Type' to @a@.  If you are a client, this

  • compiler/GHC/Core/Opt/Simplify/Iteration.hs
    ... ... @@ -474,14 +474,14 @@ leaving a simpler job for demand-analysis worker/wrapper. See #19874.
    474 474
    475 475 
     Wrinkles
    476 476
    477 
    -1. We must /not/ do cast w/w on
    477 
    +(CWW1) We must /not/ do cast w/w on
    478 478 
          f = g |> co
    479 479 
        otherwise it'll just keep repeating forever! You might think this
    480 480 
        is avoided because the call to tryCastWorkerWrapper is guarded by
    481 
    -   preInlineUnconditinally, but I'm worried that a loop-breaker or an
    482 
    -   exported Id might say False to preInlineUnonditionally.
    481 
    +   preInlineUnconditionally, but I'm worried that a loop-breaker or an
    482 
    +   exported Id might say False to preInlineUnconditionally.
    483 483
    484 
    -2. We need to be careful with inline/noinline pragmas:
    484 
    +(CWW2) We need to be careful with inline/noinline pragmas:
    485 485 
            rec { {-# NOINLINE f #-}
    486 486 
                  f = (...g...) |> co
    487 487 
                ; g = ...f... }
    ... ... @@ -496,15 +496,15 @@ Wrinkles
    496 496 
                f = $wf |> co
    497 497 
              ; g = ...f... }
    498 498 
        and that is bad: the whole point is that we want to inline that
    499 
    -   cast!  We want to transfer the pagma to $wf:
    499 
    +   cast!  We want to transfer the pragma to $wf:
    500 500 
           rec { {-# NOINLINE $wf #-}
    501 501 
                 $wf = ...g...
    502 502 
               ; f = $wf |> co
    503 503 
               ; g = ...f... }
    504 504 
        c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.
    505 505
    506 
    -3. We should still do cast w/w even if `f` is INLINEABLE.  E.g.
    507 
    -      {- f: Stable unfolding = <stable-big> -}
    506 
    +(CWW3) We should still do cast w/w even if `f` is INLINEABLE.  E.g.
    507 
    +      {- f: Stable unfolding (arity 2) = <stable-big> -}
    508 508 
           f = (\xy. <big-body>) |> co
    509 509 
        Then we want to w/w to
    510 510 
           {- $wf: Stable unfolding = <stable-big> |> sym co -}
    ... ... @@ -513,15 +513,43 @@ Wrinkles
    513 513 
        Notice that the stable unfolding moves to the worker!  Now demand analysis
    514 514 
        will work fine on $wf, whereas it has trouble with the original f.
    515 515 
        c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap.
    516 
    -   This point also applies to strong loopbreakers with INLINE pragmas, see
    517 
    -   wrinkle (4).
    518 516
    519 
    -4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence
    520 
    -   hasInlineUnfolding in tryCastWorkerWrapper, which responds False to
    521 
    -   loop-breakers) because they'll definitely be inlined anyway, cast and
    522 
    -   all. And if we do cast w/w for an INLINE function with arity zero, we get
    517 
    +(CWW4) We should /not/ do cast w/w for INLINE functions (hence `hasInlineUnfolding`
    518 
    +   in `tryCastWorkerWrapper`) because they'll definitely be inlined anyway, cast
    519 
    +   and all.
    520 
    +
    521 
    +   Moreover, if we do cast w/w for an INLINE function with arity zero, we get
    523 522 
        something really silly: we inline that "worker" right back into the wrapper!
    524 
    -   Worse than a no-op, because we have then lost the stable unfolding.
    523 
    +   In fact it is Much Worse than a no-op, because we have then lost the stable
    524 
    +   unfolding --- aargh (see #26903).  E.g. similar example to (CWW3)
    525 
    +      {- g: Stable unfolding (arity 0) = <stable-big> -}   NB arity 0!
    526 
    +      g = (\xy. <big-body>) |> co
    527 
    +   If we w/w to this:
    528 
    +      {- $wg: Stable unfolding (arity 0) = <stable-big> |> sym co -}
    529 
    +      $wg = \xy. <big-body>
    530 
    +      g = $wg |> co
    531 
    +   then we'll inline $wg at the call site in `g` giving
    532 
    +      {- $wg: Stable unfolding (arity 0) = <stable-big> |> sym co -}
    533 
    +      $wg = \xy. <big-body>
    534 
    +      g = (<stable-big> |> sym co) |> co
    535 
    +   and now we'll drop `$wg` as dead and we have lost the unfolding on `g`.
    536 
    +   (We could /also/ give the binding `g = $wf |> co` a stable unfolding. Then
    537 
    +   things would work right; but there is also no point in doing the cast
    538 
    +   worker/wrapper in the first place.)
    539 
    +
    540 
    +   NB: you might wonder about a loop-breaker with an INLINE pragma; after all, a
    541 
    +   loop breaker won't "definitely be inlined anyway", so arguably we should not
    542 
    +   disable cast w/w/ for it.  But a Rec group can /look/ recursive at an early
    543 
    +   stage, and subsequently /become/ non-recursive after some simplification.
    544 
    +   (This is common in instance decls; see Note [Checking for INLINE loop breakers]
    545 
    +   in GHC.Core.Lint.)  So the danger is that we'll permanently lose that stable
    546 
    +   unfolding that we specifically wanted (#26903).  Simple solution: disable cast
    547 
    +   w/w for /any/ INLINE function.  See the defn
    548 
    +   of `GHC.Types.Id.Info.hasInlineUnfolding`.
    549 
    +
    550 
    +   The danger is that an INLINE pragma on a genuninely-recursive function
    551 
    +   will kill worker-wrapper.  Well, so be it.  They are pretty suspicious anyway;
    552 
    +   see Note [Checking for INLINE loop breakers].
    525 553
    526 554 
     All these wrinkles are exactly like worker/wrapper for strictness analysis:
    527 555 
       f is the wrapper and must inline like crazy
    ... ... @@ -586,11 +614,11 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
    586 614 
       | BC_Let top_lvl is_rec <- bind_cxt  -- Not join points
    587 615 
       , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform
    588 616 
                             --            a DFunUnfolding in mk_worker_unfolding
    589 
    -  , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1
    590 
    -  , not (hasInlineUnfolding info)  -- Not INLINE things: Wrinkle 4
    591 
    -  , typeHasFixedRuntimeRep work_ty    -- Don't peel off a cast if doing so would
    592 
    -                                      -- lose the underlying runtime representation.
    593 
    -                                      -- See Note [Preserve RuntimeRep info in cast w/w]
    617 
    +  , not (exprIsTrivial rhs)          -- Not x = y |> co; see (CWW1)
    618 
    +  , not (hasInlineUnfolding info)    -- Not INLINE things: see (CWW4)
    619 
    +  , typeHasFixedRuntimeRep work_ty   -- Don't peel off a cast if doing so would
    620 
    +                                     -- lose the underlying runtime representation.
    621 
    +                                     -- See Note [Preserve RuntimeRep info in cast w/w]
    594 622 
       , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
    595 623 
                                                        -- See Note [OPAQUE pragma]
    596 624 
       = do  { uniq <- getUniqueM
    ... ... @@ -637,13 +665,13 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co)
    637 665 
                                   `setArityInfo`      work_arity
    638 666 
                -- We do /not/ want to transfer OccInfo, Rules
    639 667 
                -- Note [Preserve strictness in cast w/w]
    640 
    -           -- and Wrinkle 2 of Note [Cast worker/wrapper]
    668 
    +           -- and (CWW2) of Note [Cast worker/wrapper]
    641 669
    642 670 
         ----------- Worker unfolding -----------
    643 671 
         -- Stable case: if there is a stable unfolding we have to compose with (Sym co);
    644 672 
         --   the next round of simplification will do the job
    645 673 
         -- Non-stable case: use work_rhs
    646 
    -    -- Wrinkle 3 of Note [Cast worker/wrapper]
    674 
    +    -- See (CWW4) of Note [Cast worker/wrapper]
    647 675 
         mk_worker_unfolding top_lvl work_id work_rhs
    648 676 
           = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers
    649 677 
                unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })

  • compiler/GHC/Core/Opt/WorkWrap.hs
    ... ... @@ -176,8 +176,9 @@ several liked-named Ids bouncing around at the same time---absolute
    176 176 
     mischief.)
    177 177
    178 178 
     Notice that we refrain from w/w'ing an INLINE function even if it is
    179 
    -in a recursive group.  It might not be the loop breaker.  (We could
    180 
    -test for loop-breaker-hood, but I'm not sure that ever matters.)
    179 
    +in a recursive group.  It might not be the loop breaker.  (We used to
    180 
    +test for loop-breaker-hood, but see (CWW4) in Note [Cast worker/wrapper]
    181 
    +in GHC.Core.Opt.Simplify.Iteration.)
    181 182
    182 183 
     Note [Worker/wrapper for INLINABLE functions]
    183 184 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • compiler/GHC/Driver/Config/Core/Lint.hs
    ... ... @@ -147,6 +147,12 @@ perPassFlags dflags pass
    147 147 
         check_lbs = case pass of
    148 148 
                           CoreDesugar    -> False
    149 149 
                           CoreDesugarOpt -> False
    150 
    +
    151 
    +                      -- Disable Lint warnings on the first simplifier pass, because
    152 
    +                      -- there may be some INLINE knots still tied, which is tiresomely noisy
    153 
    +                      CoreDoSimplify cfg
    154 
    +                        | InitialPhase <- sm_phase (so_mode cfg)
    155 
    +                        -> False
    150 156 
                           _              -> True
    151 157
    152 158 
         -- See Note [Checking StaticPtrs]

  • compiler/GHC/Hs/Doc.hs
    ... ... @@ -50,6 +50,7 @@ import qualified GHC.Utils.Outputable as O
    50 50 
     import GHC.Hs.Extension
    51 51 
     import GHC.Types.Unique.Map
    52 52 
     import Data.List (sortBy)
    53 
    +import Data.Function
    53 54
    54 55 
     import GHC.Hs.DocString
    55 56
    ... ... @@ -88,7 +89,7 @@ instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where
    88 89 
     instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where
    89 90 
       put_ bh (WithHsDocIdentifiers s ids) = do
    90 91 
         put_ bh s
    91 
    -    put_ bh $ BinLocated <$> ids
    92 
    +    put_ bh $ BinLocated <$> (sortBy  (stableNameCmp `on` getName) ids)
    92 93 
       get bh =
    93 94 
         liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh)
    94 95

  • compiler/GHC/Types/Id/Info.hs
    ... ... @@ -568,7 +568,12 @@ hasInlineUnfolding :: IdInfo -> Bool
    568 568 
     -- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is
    569 569 
     --   (a) always inlined; that is, with an `UnfWhen` guidance, or
    570 570 
     --   (b) a DFunUnfolding which never needs to be inlined
    571 
    -hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info)
    571 
    +--
    572 
    +-- Very important that this work with `realUnfoldingInfo` and so returns
    573 
    +-- True even for a loop-breaker that has an INLINE pragma.
    574 
    +-- See (CWW4) in Note [Cast worker/wrapper] in GHC.Core.Opt.Simplify.Iteration
    575 
    +-- for discussion, and #26903 for the dire consequences of getting this wrong.
    576 
    +hasInlineUnfolding info = isInlineUnfolding (realUnfoldingInfo info)
    572 577
    573 578 
     setArityInfo :: IdInfo -> ArityInfo -> IdInfo
    574 579 
     setArityInfo info ar =

  • libraries/text
    1 
    -Subproject commit 5f343f668f421bfb30cead594e52d0ac6206ff67
    1 
    +Subproject commit 423fd981e576bd17a8b5fa48d0ad6b9a0c370e77

  • libraries/transformers
    1 
    -Subproject commit cee47cca7705edafe0a5839439e679edbd61890a
    1 
    +Subproject commit 0d615bc2457d5d2c695dcfdb902d88c1225beff3

  • testsuite/tests/ghc-api/TypeMapStringLiteral.hs
    1 
    +{-# LANGUAGE OverloadedStrings #-}
    2 
    +module Main (main) where
    3 
    +
    4 
    +import Control.Monad (unless)
    5 
    +import qualified Data.ByteString.Char8 as BSC
    6 
    +import qualified Data.ByteString.Short as SBS
    7 
    +import Data.Char (ord)
    8 
    +import Data.List (foldl')
    9 
    +import GHC.Core.Map.Type (TypeMap, emptyTypeMap, extendTypeMap, foldTypeMap)
    10 
    +import GHC.Core.Type (Type, mkStrLitTy)
    11 
    +import GHC.Data.FastString (FastString (..), FastZString (..))
    12 
    +import GHC.Utils.Encoding (zEncodeString)
    13 
    +
    14 
    +main :: IO ()
    15 
    +main = do
    16 
    +  let logicalEntries =
    17 
    +        [ ("alpha", "payload-alpha")
    18 
    +        , ("beta",  "payload-beta")
    19 
    +        , ("gamma", "payload-gamma")
    20 
    +        ]
    21 
    +      uniquesOne = [1, 2, 3]
    22 
    +      uniquesTwo = [200, 100, 500]
    23 
    +
    24 
    +      tmOne = buildMap logicalEntries uniquesOne
    25 
    +      tmTwo = buildMap logicalEntries uniquesTwo
    26 
    +
    27 
    +      foldedOne = foldValues tmOne
    28 
    +      foldedTwo = foldValues tmTwo
    29 
    +
    30 
    +  assert "foldTypeMap order independent of FastString uniques" $
    31 
    +    foldedOne == foldedTwo
    32 
    +
    33 
    +
    34 
    +buildMap :: [(String, a)] -> [Int] -> TypeMap a
    35 
    +buildMap entries uniques =
    36 
    +  foldl' insertEntry emptyTypeMap (zip uniques entries)
    37 
    +  where
    38 
    +    insertEntry :: TypeMap a -> (Int, (String, a)) -> TypeMap a
    39 
    +    insertEntry tm (u, (txt, payload)) =
    40 
    +      extendTypeMap tm (strLiteralWithUnique u txt) payload
    41 
    +
    42 
    +foldValues :: TypeMap a -> [a]
    43 
    +foldValues tm = foldTypeMap (:) [] tm
    44 
    +
    45 
    +strLiteralWithUnique :: Int -> String -> Type
    46 
    +strLiteralWithUnique u = mkStrLitTy . fakeFastString u
    47 
    +
    48 
    +fakeFastString :: Int -> String -> FastString
    49 
    +fakeFastString u s = FastString
    50 
    +  { uniq = u
    51 
    +  , n_chars = length s
    52 
    +  , fs_sbs = SBS.pack (map (fromIntegral . ord) s)
    53 
    +  , fs_zenc = error "unused"
    54 
    +  }
    55 
    +
    56 
    +assert :: String -> Bool -> IO ()
    57 
    +assert label condition = unless condition $
    58 
    +  error ("TypeMap string literal test failed: " ++ label)

  • testsuite/tests/ghc-api/all.T
    ... ... @@ -43,3 +43,4 @@ test('T20757', [unless(opsys('mingw32'), skip), exit_code(1), normalise_version(
    43 43 
                    ['-package ghc'])
    44 44 
     test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc'])
    45 45 
     test('T26120', [], compile_and_run, ['-package ghc'])
    46 
    +test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc'])

  • testsuite/tests/showIface/DocsInHiFile1.stdout
    ... ... @@ -6,14 +6,14 @@ docs:
    6 6 
     '<>', ':=:', 'Bool'
    7 7 
     -}
    8 8 
                   identifiers:
    9 
    +                {DocsInHiFile.hs:4:2-3}
    10 
    +                GHC.Internal.Base.<>
    9 11 
                     {DocsInHiFile.hs:2:6-9}
    10 12 
                     GHC.Internal.Data.Foldable.elem
    11 
    -                {DocsInHiFile.hs:2:6-9}
    12 
    -                elem
    13 13 
                     {DocsInHiFile.hs:2:14-18}
    14 14 
                     GHC.Internal.System.IO.print
    15 
    -                {DocsInHiFile.hs:4:2-3}
    16 
    -                GHC.Internal.Base.<>
    15 
    +                {DocsInHiFile.hs:2:6-9}
    16 
    +                elem
    17 17 
                     {DocsInHiFile.hs:4:15-18}
    18 18 
                     GHC.Types.Bool
    19 19 
            export docs:

  • testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
    ... ... @@ -6,14 +6,14 @@ docs:
    6 6 
     '<>', ':=:', 'Bool'
    7 7 
     -}
    8 8 
                   identifiers:
    9 
    +                {HaddockSpanIssueT24378.hs:3:2-3}
    10 
    +                GHC.Internal.Base.<>
    9 11 
                     {HaddockSpanIssueT24378.hs:1:6-9}
    10 12 
                     GHC.Internal.Data.Foldable.elem
    11 
    -                {HaddockSpanIssueT24378.hs:1:6-9}
    12 
    -                elem
    13 13 
                     {HaddockSpanIssueT24378.hs:1:14-18}
    14 14 
                     GHC.Internal.System.IO.print
    15 
    -                {HaddockSpanIssueT24378.hs:3:2-3}
    16 
    -                GHC.Internal.Base.<>
    15 
    +                {HaddockSpanIssueT24378.hs:1:6-9}
    16 
    +                elem
    17 17 
                     {HaddockSpanIssueT24378.hs:3:15-18}
    18 18 
                     GHC.Types.Bool
    19 19 
            export docs:

  • testsuite/tests/showIface/MagicHashInHaddocks.stdout
    ... ... @@ -3,10 +3,10 @@ docs:
    3 3 
              Just text:
    4 4 
                     -- | 'foo#' `Bar##` `*##`
    5 5 
                   identifiers:
    6 
    -                {MagicHashInHaddocks.hs:3:7-10}
    7 
    -                foo#
    8 6 
                     {MagicHashInHaddocks.hs:3:14-18}
    9 7 
                     Bar##
    8 
    +                {MagicHashInHaddocks.hs:3:7-10}
    9 
    +                foo#
    10 10 
            export docs:
    11 11 
              []
    12 12 
            declaration docs:

  • testsuite/tests/simplCore/should_compile/T26903.hs
    1 
    +{-# LANGUAGE DefaultSignatures #-}
    2 
    +module T26903 where
    3 
    +
    4 
    +newtype T a = MkT [a]
    5 
    +
    6 
    +class C a where
    7 
    +  op :: [a] -> [a] -> T a
    8 
    +
    9 
    +  -- This default method
    10 
    +  --  * Has an INLINE pragma
    11 
    +  --  * Is too big to inline without a pragma
    12 
    +  --  * Has arity zero
    13 
    +  {-# INLINE[1] op #-}
    14 
    +  default op :: Ord a => [a] -> [a] -> T a
    15 
    +  op = \xs ys -> MkT $ if xs>ys then reverse (reverse (reverse (reverse xs)))
    16 
    +                                else reverse (reverse (reverse (reverse (xs ++ ys))))
    17 
    +
    18 
    +instance C Int where {}
    19 
    +
    20 
    +test :: [Int] -> T Int
    21 
    +test xs = op [] xs
    22 
    +  -- We expect to see `op` inlined into the RHS of `test`
    23 
    +

  • testsuite/tests/simplCore/should_compile/T26903.stderr
    1 
    +
    2 
    +==================== Tidy Core ====================
    3 
    +Result size of Tidy Core
    4 
    +  = {terms: 127, types: 130, coercions: 48, joins: 0/0}
    5 
    +
    6 
    +$dmop
    7 
    +  = (\ @a _ $dOrd xs ys ->
    8 
    +       case $fOrdList_$ccompare $dOrd xs ys of {
    9 
    +         __DEFAULT ->
    10 
    +           reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) [];
    11 
    +         GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) []
    12 
    +       })
    13 
    +    `cast` <Co:20> :: ...
    14 
    +
    15 
    +$fCInt_$cop
    16 
    +  = (\ xs ys ->
    17 
    +       case $fOrdList_$s$ccompare xs ys of {
    18 
    +         __DEFAULT ->
    19 
    +           reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) [];
    20 
    +         GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) []
    21 
    +       })
    22 
    +    `cast` <Co:11> :: ...
    23 
    +
    24 
    +$fCInt1
    25 
    +  = \ xs ys ->
    26 
    +      case $fOrdList_$s$ccompare xs ys of {
    27 
    +        __DEFAULT ->
    28 
    +          reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) [];
    29 
    +        GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) []
    30 
    +      }
    31 
    +
    32 
    +$fCInt = C:C ($fCInt1 `cast` <Co:11> :: ...)
    33 
    +
    34 
    +test4 = reverse1 [] []
    35 
    +
    36 
    +test3 = reverse1 test4 []
    37 
    +
    38 
    +test2 = reverse1 test3 []
    39 
    +
    40 
    +test1 = reverse1 test2 []
    41 
    +
    42 
    +test
    43 
    +  = \ xs ->
    44 
    +      case $fOrdList_$s$ccompare [] xs of {
    45 
    +        __DEFAULT ->
    46 
    +          (reverse1 (reverse1 (reverse1 (reverse1 (++ [] xs) []) []) []) [])
    47 
    +          `cast` <Co:3> :: ...;
    48 
    +        GT -> test1 `cast` <Co:3> :: ...
    49 
    +      }
    50 
    +
    51 
    +
    52 
    +

  • testsuite/tests/simplCore/should_compile/all.T
    ... ... @@ -537,3 +537,4 @@ test('T25883b', normal, compile_grep_core, [''])
    537 537 
     test('T25883c', normal, compile_grep_core, [''])
    538 538 
     test('T25883d', [extra_files(['T25883d_import.hs'])], multimod_compile_filter, ['T25883d', '-O -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques', r'grep -e "y ="'])
    539 539 
     test('T26681',  normal, compile, ['-O'])
    540 
    +test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all'])

  • utils/jsffi/dyld.mjs
    ... ... @@ -850,7 +850,7 @@ class DyLD {
    850 850 
     }
    851 851
    852 852 
     function isMain() {
    853 
    -  return import.meta.filename === process.argv[1];
    853 
    +  return import.meta.main;
    854 854 
     }
    855 855
    856 856 
     if (isMain()) {

  • utils/jsffi/post-link.mjs
    ... ... @@ -75,7 +75,7 @@ export async function postLink(mod) {
    75 75 
     }
    76 76
    77 77 
     function isMain() {
    78 
    -  return import.meta.filename === process.argv[1];
    78 
    +  return import.meta.main;
    79 79 
     }
    80 80
    81 81 
     async function main() {

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