Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

25 changed files:

Changes:

  • changelog.d/T27182.md
    1 
    +section: compiler
    2 
    +issues: #27182
    3 
    +mrs: !16003
    4 
    +synopsis:
    5 
    +  Fix `getStgArgFromTrivialArg` panic in CoreToStg
    6 
    +description:
    7 
    +  Avoid a `getStgArgFromTrivialArg` panic in CoreToStg due to a call to `mkTick`
    8 
    +  in Core Prep which invalidated ANF.

  • compiler/GHC/Builtin/primops.txt.pp
    ... ... @@ -2149,7 +2149,7 @@ primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    2149 2149
    2150 2150 
     primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
    2151 2151 
        MutableByteArray# s -> State# s -> (# State# s, Int# #)
    2152 
    -   {Return the number of elements in the array, correctly accounting for
    2152 
    +   {Return the number of bytes in the array, correctly accounting for
    2153 2153 
        the effect of 'shrinkMutableByteArray#' and 'resizeMutableByteArray#'.
    2154 2154
    2155 2155 
        @since 0.5.0.0}

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -11,6 +11,7 @@ module GHC.Core.Utils (
    11 11 
             -- * Constructing expressions
    12 12 
             mkCast, mkCastMCo, mkPiMCo,
    13 13 
             mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
    14 
    +        mkTickCpe,
    14 15 
             bindNonRec, needsCaseBinding, needsCaseBindingL,
    15 16 
             mkAltExpr, mkDefaultCase, mkSingleAltCase,
    16 17
    ... ... @@ -319,7 +320,18 @@ mkCast expr co
    319 320 
     --   * Split profiling ticks into counting/scoping parts so that the two parts
    320 321 
     --     can be placed independently into the AST.
    321 322 
     mkTick :: CoreTickish -> CoreExpr -> CoreExpr
    322 
    -mkTick t orig_expr = mkTick' orig_expr
    323 
    +mkTick = mk_tick False
    324 
    +
    325 
    +-- | A version of 'mkTick' that preserves ANF, for use in Core Prep.
    326 
    +--
    327 
    +-- See Note [mkTick breaks ANF] in GHC.CoreToStg.Prep.
    328 
    +mkTickCpe :: CoreTickish -> CoreExpr -> CoreExpr
    329 
    +mkTickCpe = mk_tick True
    330 
    +
    331 
    +-- | Internal function used to define both 'mkTick' and 'mkTickCpe'
    332 
    +-- without duplication.
    333 
    +mk_tick :: Bool -> CoreTickish -> CoreExpr -> CoreExpr
    334 
    +mk_tick preserve_anf t orig_expr = mkTick' orig_expr
    323 335 
      where
    324 336 
       -- Some ticks (cost-centres) can be split in two, with the
    325 337 
       -- non-counting part having laxer placement properties.
    ... ... @@ -343,7 +355,7 @@ mkTick t orig_expr = mkTick' orig_expr
    343 355 
           -- Push SCCs into lambdas.
    344 356 
           -- See (PSCC2) in Note [Pushing SCCs inwards].
    345 357 
           | can_split
    346 
    -      -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
    358 
    +      -> Tick (mkNoScope t) $ Lam x $ mk_tick preserve_anf (mkNoCount t) e
    347 359
    348 360 
         App f arg
    349 361 
           -- All ticks float inwards through non-runtime arguments, as per
    ... ... @@ -353,7 +365,9 @@ mkTick t orig_expr = mkTick' orig_expr
    353 365
    354 366 
           -- Push SCCs into saturated constructor applications.
    355 367 
           -- See (PSCC3) in Note [Pushing SCCs inwards].
    356 
    -      | isSaturatedConApp expr
    368 
    +      | not preserve_anf -- this optimisation breaks ANF;
    369 
    +                         -- see Note [mkTick breaks ANF] in GHC.CoreToStg.Prep
    370 
    +      , isSaturatedConApp expr
    357 371 
           , tickishPlace t == PlaceCostCentre || can_split
    358 372 
           -> if tickishPlace t == PlaceCostCentre
    359 373 
              then tickHNFArgs t expr

  • compiler/GHC/CoreToStg/Prep.hs
    ... ... @@ -801,7 +801,9 @@ cpeBodyF env (Tick tickish expr)
    801 801 
            ; return (FloatTick tickish `consFloat` floats, body) }
    802 802 
       | otherwise
    803 803 
       = do { body <- cpeBody env expr
    804 
    -       ; return (emptyFloats, mkTick tickish' body) }
    804 
    +       ; return (emptyFloats, mkTickCpe tickish' body) }
    805 
    +    -- Use mkTickCpe and not mkTick, as the latter may break ANF (#27182).
    806 
    +    -- See (TickANF2) in Note [mkTick breaks ANF].
    805 807 
       where
    806 808 
         tickish' | Breakpoint ext bid fvs <- tickish
    807 809 
                  -- See also 'substTickish'
    ... ... @@ -905,6 +907,28 @@ cpeBodyF env (Case scrut bndr ty alts)
    905 907 
                 ; rhs' <- cpeBody env2 rhs
    906 908 
                 ; return (Alt con bs' rhs') }
    907 909
    910 
    +{- Note [mkTick breaks ANF]
    911 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~
    912 
    +mkTick does not preserve the ANF property as required by Core Prep (see
    913 
    +Note [CorePrep invariants]), as seen in #27182. Given:
    914 
    +
    915 
    +  mkTick scc<foo> (\ (eta :: Char -> Bool) -> BindP (p :: Int) eta)
    916 
    +
    917 
    +mkTick will push the SCC into the constructor application, resulting in:
    918 
    +
    919 
    +  \ (eta :: Char -> Bool) -> BindP (p :: Int) (scc<oneM> eta)
    920 
    +
    921 
    +To avoid this problem (at least until 'mkTick' is more thoroughly reworked to
    922 
    +avoid this infelicity, see #27141), we define a variant of 'mkTick', called
    923 
    +'mkTickCpe', which does not push ticks into constructor applications (this is
    924 
    +the only optimisation done by 'mkTick' that can break ANF).
    925 
    +
    926 
    +We prefer using a small variant of 'mkTick' rather than using the 'Tick'
    927 
    +constructor, as the latter can slightly degrade profiling reports by failing to
    928 
    +combine ticks (can result in spurious cost centres with 0 entries appearing in
    929 
    +profiling reports).
    930 
    +-}
    931 
    +
    908 932 
     -- ---------------------------------------------------------------------------
    909 933 
     --              CpeBody: produces a result satisfying CpeBody
    910 934 
     -- ---------------------------------------------------------------------------
    ... ... @@ -1207,7 +1231,7 @@ cpeApp top_env expr
    1207 1231 
         rebuild_app' env (a : as) fun' floats ss rt_ticks req_depth = case a of
    1208 1232 
           -- See Note [Ticks and mandatory eta expansion]
    1209 1233 
           _ | not (null rt_ticks), req_depth <= 0
    1210 
    -        -> let tick_fun = foldr mkTick fun' rt_ticks
    1234 
    +        -> let tick_fun = foldr mkTickCpe fun' rt_ticks
    1211 1235 
                in rebuild_app' env (a : as) tick_fun floats ss rt_ticks req_depth
    1212 1236
    1213 1237 
           AIApp (Type arg_ty)
    ... ... @@ -2307,7 +2331,7 @@ wrapBinds floats body
    2307 2331 
         mk_bind (UnsafeEqualityCase scrut b con bs) body
    2308 2332 
           = mkSingleAltCase scrut b con bs body
    2309 2333 
         mk_bind (FloatTick tickish) body
    2310 
    -      = mkTick tickish body
    2334 
    +      = mkTickCpe tickish body
    2311 2335
    2312 2336 
     -- | Put floats at top-level
    2313 2337 
     deFloatTop :: Floats -> [CoreBind]
    ... ... @@ -2735,7 +2759,7 @@ newVar env ty
    2735 2759 
     wrapTicks :: Floats -> CoreExpr -> (Floats, CoreExpr)
    2736 2760 
     wrapTicks floats expr
    2737 2761 
       | (floats1, ticks1) <- fold_fun go floats
    2738 
    -  = (floats1, foldrOL mkTick expr ticks1)
    2762 
    +  = (floats1, foldrOL mkTickCpe expr ticks1)
    2739 2763 
       where fold_fun f floats =
    2740 2764 
                let (binds, ticks) = foldlOL f (nilOL,nilOL) (fs_binds floats)
    2741 2765 
                in (floats { fs_binds = binds }, ticks)
    ... ... @@ -2755,8 +2779,8 @@ wrapTicks floats expr
    2755 2779
    2756 2780 
             wrap t (Float bind bound info) = Float (wrapBind t bind) bound info
    2757 2781 
             wrap _ f                 = pprPanic "Unexpected FloatingBind" (ppr f)
    2758 
    -        wrapBind t (NonRec binder rhs) = NonRec binder (mkTick t rhs)
    2759 
    -        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTick t) pairs)
    2782 
    +        wrapBind t (NonRec binder rhs) = NonRec binder (mkTickCpe t rhs)
    2783 
    +        wrapBind t (Rec pairs)         = Rec (mapSnd (mkTickCpe t) pairs)
    2760 2784
    2761 2785 
     ------------------------------------------------------------------------------
    2762 2786 
     -- Numeric literals

  • libraries/base/src/Control/Applicative.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Trustworthy #-}
    2 3 
     {-# LANGUAGE DeriveGeneric #-}
    3 4 
     {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    ... ... @@ -64,8 +65,13 @@ import GHC.Internal.Data.Data (Data)
    64 65
    65 66 
     import GHC.Internal.Base (
    66 67 
         Alternative(..), Applicative(..), Functor(..), Monad(..), MonadPlus(..),
    67 
    -    ap, const, liftA, liftA3, liftM, liftM2, thenA, (.), (<**>),
    68 
    +    ap, const, liftA, liftA3, liftM, liftM2, (.), (<**>),
    68 69 
       )
    70 
    +#if __GLASGOW_HASKELL__ < 1000
    71 
    +import GHC.Internal.Base (id)
    72 
    +#else
    73 
    +import GHC.Internal.Base (thenA)
    74 
    +#endif
    69 75 
     import GHC.Internal.Functor.ZipList (ZipList(..))
    70 76 
     import GHC.Internal.Types
    71 77 
     import GHC.Generics
    ... ... @@ -148,3 +154,19 @@ deriving instance (Typeable (a :: Type -> Type -> Type), Typeable b, Typeable c,
    148 154
    149 155 
     optional :: Alternative f => f a -> f (Maybe a)
    150 156 
     optional v = Just <$> v <|> pure Nothing
    157 
    +
    158 
    +#if __GLASGOW_HASKELL__ < 1000
    159 
    +
    160 
    +-- | Sequence two `Applicative` actions, discarding the result of the first one.
    161 
    +--
    162 
    +-- Defined as `thenA fa fb = (id <$ fa) <*> fb`.
    163 
    +--
    164 
    +-- This can be used to explicitly define `(*>) = thenA`, which is the default
    165 
    +-- definition.
    166 
    +--
    167 
    +-- @since 4.23.0.0
    168 
    +thenA :: Applicative f => f a -> f b -> f b
    169 
    +thenA fa fb = (id <$ fa) <*> fb
    170 
    +{-# INLINEABLE thenA #-}
    171 
    +
    172 
    +#endif

  • libraries/base/src/Control/Arrow.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     -- |
    ... ... @@ -50,4 +51,6 @@ module Control.Arrow
    50 51 
          ) where
    51 52
    52 53 
     import GHC.Internal.Control.Arrow
    54 
    +#if __GLASGOW_HASKELL__ >= 1000
    53 55 
     import GHC.Internal.Control.Monad.Fix (ArrowLoop(..))
    56 
    +#endif

  • libraries/base/src/Control/Monad.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     -- |
    ... ... @@ -63,6 +64,9 @@ module Control.Monad
    63 64 
          ) where
    64 65
    65 66 
     import GHC.Internal.Control.Monad
    67 
    +#if __GLASGOW_HASKELL__ < 1000
    68 
    +import Data.Function (const)
    69 
    +#endif
    66 70
    67 71 
     {- $naming
    68 72
    ... ... @@ -88,3 +92,18 @@ The functions in this module use the following naming conventions:
    88 92 
     > mfilter :: MonadPlus m => (a -> Bool) -> m a -> m a
    89 93
    90 94 
     -}
    95 
    +
    96 
    +#if __GLASGOW_HASKELL__ < 1000
    97 
    +
    98 
    +-- | Sequence two monadic actions, discarding the result of the first one.
    99 
    +--
    100 
    +-- Defined as `thenM ma mb = ma >>= const mb`.
    101 
    +--
    102 
    +-- This can be used to define `(*>) = thenM`.
    103 
    +--
    104 
    +-- @since 4.23.0.0
    105 
    +thenM :: (Monad m) => m a -> m b -> m b
    106 
    +thenM ma mb = ma >>= const mb
    107 
    +{-# INLINEABLE thenM #-}
    108 
    +
    109 
    +#endif

  • libraries/base/src/Data/Array/Byte.hs
    ... ... @@ -8,6 +8,7 @@
    8 8 
     --
    9 9 
     -- Derived from @primitive@ package.
    10 10
    11 
    +{-# LANGUAGE CPP #-}
    11 12 
     {-# LANGUAGE BangPatterns #-}
    12 13 
     {-# LANGUAGE MagicHash #-}
    13 14 
     {-# LANGUAGE TypeFamilies #-}
    ... ... @@ -32,7 +33,9 @@ import GHC.Internal.Show (intToDigit)
    32 33 
     import GHC.Internal.ST (ST(..), runST)
    33 34 
     import GHC.Internal.Word (Word8(..))
    34 35 
     import GHC.Internal.TH.Syntax
    35 
    -import GHC.Internal.TH.Monad
    36 
    +#if __GLASGOW_HASKELL__ >= 1000
    37 
    +import GHC.Internal.TH.Monad (unsafeCodeCoerce)
    38 
    +#endif
    36 39 
     import GHC.Internal.TH.Lift
    37 40 
     import GHC.Internal.ForeignPtr
    38 41 
     import Prelude

  • libraries/base/src/Data/Fixed.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3 
     {-# LANGUAGE ScopedTypeVariables #-}
    3 4 
     {-# LANGUAGE PolyKinds #-}
    ... ... @@ -91,7 +92,11 @@ import GHC.Internal.TypeLits (KnownNat, natVal)
    91 92 
     import GHC.Internal.Read
    92 93 
     import GHC.Internal.Text.ParserCombinators.ReadPrec
    93 94 
     import GHC.Internal.Text.Read.Lex
    94 
    -import qualified GHC.Internal.TH.Monad as TH
    95 
    +#if __GLASGOW_HASKELL__ < 1000
    96 
    +import GHC.Internal.TH.Syntax (unsafeCodeCoerce)
    97 
    +#else
    98 
    +import GHC.Internal.TH.Monad (unsafeCodeCoerce)
    99 
    +#endif
    95 100 
     import qualified GHC.Internal.TH.Lift as TH
    96 101 
     import Data.Typeable
    97 102 
     import Prelude
    ... ... @@ -147,7 +152,7 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
    147 152 
     -- @since template-haskell-2.19.0.0
    148 153 
     -- @since base-4.21.0.0
    149 154 
     instance TH.Lift (Fixed a) where
    150 
    -  liftTyped x = TH.unsafeCodeCoerce (TH.lift x)
    155 
    +  liftTyped x = unsafeCodeCoerce (TH.lift x)
    151 156 
       lift (MkFixed x) = [| MkFixed x |]
    152 157
    153 158 
     -- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution'  typeclass.

  • libraries/base/src/GHC/Base.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -139,10 +140,12 @@ module GHC.Base
    139 140 
         ) where
    140 141
    141 142 
     import GHC.Internal.Base hiding ( NonEmpty(..) )
    143 
    +import GHC.Internal.Data.NonEmpty ( NonEmpty(..) )
    144 
    +#if __GLASGOW_HASKELL__ >= 1000
    142 145 
     import GHC.Internal.Classes
    143 146 
     import GHC.Internal.CString
    144 
    -import GHC.Internal.Data.NonEmpty ( NonEmpty(..) )
    145 147 
     import GHC.Internal.Magic.Dict ( WithDict(..) )
    148 
    +#endif
    146 149 
     import GHC.Prim hiding
    147 150 
       (
    148 151 
       -- Hide dataToTag# ops because they are expected to break for
    ... ... @@ -273,6 +276,7 @@ import GHC.Prim hiding
    273 276 
       , minWord8X16#
    274 277 
       , minWord8X32#
    275 278 
       , minWord8X64#
    279 
    +#if __GLASGOW_HASKELL__ >= 1000
    276 280 
       -- Don't re-export vector logical primops
    277 281 
       , andDoubleX2#
    278 282 
       , andDoubleX4#
    ... ... @@ -389,13 +393,16 @@ import GHC.Prim hiding
    389 393 
       , sqrtDoubleX4#
    390 394 
       , sqrtFloatX16#
    391 395 
       , sqrtDoubleX8#
    396 
    +#endif
    392 397 
       )
    393 398
    394 399 
     import GHC.Prim.Ext
    395 400 
     import GHC.Prim.PtrEq
    396 401 
     import GHC.Internal.Err
    397 402 
     import GHC.Internal.IO (seq#)
    403 
    +#if __GLASGOW_HASKELL__ >= 1000
    398 404 
     import GHC.Internal.Magic
    405 
    +#endif
    399 406 
     import GHC.Internal.Maybe
    400 407 
     import GHC.Types hiding (
    401 408 
       Unit#,

  • libraries/base/src/GHC/Conc.hs
    ... ... @@ -119,7 +119,9 @@ module GHC.Conc
    119 119
    120 120 
     import GHC.Internal.Conc.IO
    121 121 
     import GHC.Internal.Conc.Sync
    122 
    +#if __GLASGOW_HASKELL__ >= 1000
    122 123 
     import GHC.Internal.STM
    124 
    +#endif
    123 125
    124 126 
     #if !defined(mingw32_HOST_OS)
    125 127 
     import GHC.Internal.Conc.Signal

  • libraries/base/src/GHC/Conc/Sync.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -89,4 +90,6 @@ module GHC.Conc.Sync
    89 90 
             ) where
    90 91
    91 92 
     import GHC.Internal.Conc.Sync
    93 
    +#if __GLASGOW_HASKELL__ >= 1000
    92 94 
     import GHC.Internal.STM
    95 
    +#endif

  • libraries/base/src/GHC/Exts.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE MagicHash #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -246,6 +247,7 @@ import GHC.Prim hiding
    246 247 
       , minWord8X16#
    247 248 
       , minWord8X32#
    248 249 
       , minWord8X64#
    250 
    +#if __GLASGOW_HASKELL__ >= 1000
    249 251 
       -- Don't re-export vector logical primops
    250 252 
       , andDoubleX2#
    251 253 
       , andDoubleX4#
    ... ... @@ -362,6 +364,7 @@ import GHC.Prim hiding
    362 364 
       , sqrtDoubleX4#
    363 365 
       , sqrtFloatX16#
    364 366 
       , sqrtDoubleX8#
    367 
    +#endif
    365 368 
       )
    366 369
    367 370 
     import GHC.Prim.Ext

  • libraries/base/src/GHC/Fingerprint.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3
    3 4 
     module GHC.Fingerprint (
    ... ... @@ -10,6 +11,8 @@ module GHC.Fingerprint (
    10 11
    11 12 
     import GHC.Internal.Fingerprint
    12 13
    14 
    +#if __GLASGOW_HASKELL__ >= 1000
    15 
    +
    13 16 
     import Data.Function (($))
    14 17 
     import Control.Monad (return, when)
    15 18 
     import Data.Bool (not, (&&))
    ... ... @@ -51,3 +54,5 @@ getFileHash path = withBinaryFile path ReadMode $ \ hdl ->
    51 54 
                      )
    52 55 
                 return (if isFinished then Just chunkSize else Nothing)
    53 56 
         in fingerprintBufferedStream readChunk
    57 
    +
    58 
    +#endif

  • libraries/base/src/GHC/IO/Handle.hs
    1 
    +{-# LANGUAGE CPP #-}
    2 
    +#if __GLASGOW_HASKELL__ < 1000
    3 
    +{-# LANGUAGE Trustworthy #-}
    4 
    +#else
    1 5 
     {-# LANGUAGE Safe #-}
    6 
    +#endif
    7 
    +{-# LANGUAGE RecordWildCards #-}
    2 8
    3 9 
     -- |
    4 10 
     --
    ... ... @@ -75,3 +81,19 @@ module GHC.IO.Handle
    75 81 
          ) where
    76 82
    77 83 
     import GHC.Internal.IO.Handle
    84 
    +
    85 
    +#if __GLASGOW_HASKELL__ < 1000
    86 
    +
    87 
    +import GHC.Internal.Base (($), IO, return)
    88 
    +import GHC.Internal.IO.Handle.Types (Handle__ (..))
    89 
    +import GHC.Internal.IO.Handle.Internals (withHandle_)
    90 
    +
    91 
    +-- | Return the current 'NewlineMode' for the specified 'Handle'.
    92 
    +--
    93 
    +-- @since 4.23.0.0
    94 
    +hGetNewlineMode :: Handle -> IO NewlineMode
    95 
    +hGetNewlineMode hdl =
    96 
    +  withHandle_ "hGetNewlineMode" hdl $ \Handle__{..} ->
    97 
    +    return NewlineMode{ inputNL = haInputNL, outputNL = haOutputNL }
    98 
    +
    99 
    +#endif

  • libraries/base/src/GHC/RTS/Flags.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE RecordWildCards #-}
    2 3 
     {-# LANGUAGE DeriveGeneric #-}
    3 4
    ... ... @@ -388,11 +389,13 @@ internal_to_base_MiscFlags i@Internal.MiscFlags{..} =
    388 389 
         internal_to_base_ioManager :: Internal.IoManagerFlag -> IoManagerFlag
    389 390 
         internal_to_base_ioManager Internal.IoManagerFlagAuto        = IoManagerFlagAuto
    390 391 
         internal_to_base_ioManager Internal.IoManagerFlagSelect      = IoManagerFlagSelect
    392 
    +#if __GLASGOW_HASKELL__ >= 1000
    391 393 
         internal_to_base_ioManager Internal.IoManagerFlagPoll        = IoManagerFlagAuto
    392 394 
           -- This is a lie, we cannot translate poll. We cannot translate
    393 395 
           -- accurately because want to freeze the API of the the compat RTS flags
    394 396 
           -- here. Using "auto" is the least bad translation.
    395 397 
           -- https://github.com/haskell/core-libraries-committee/issues/362
    398 
    +#endif
    396 399 
         internal_to_base_ioManager Internal.IoManagerFlagMIO         = IoManagerFlagMIO
    397 400 
         internal_to_base_ioManager Internal.IoManagerFlagWinIO       = IoManagerFlagWinIO
    398 401 
         internal_to_base_ioManager Internal.IoManagerFlagWin32Legacy = IoManagerFlagWin32Legacy

  • libraries/base/src/GHC/Unicode.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Safe #-}
    2 3 
     {-# OPTIONS_HADDOCK not-home #-}
    3 4
    ... ... @@ -44,4 +45,6 @@ module GHC.Unicode
    44 45 
          ) where
    45 46
    46 47 
     import GHC.Internal.Unicode
    48 
    +#if __GLASGOW_HASKELL__ >= 1000
    47 49 
     import GHC.Internal.Unicode.Version
    50 
    +#endif

  • libraries/base/src/GHC/Weak.hs
    ... ... @@ -25,9 +25,8 @@ module GHC.Weak
    25 25 
          -- this handler will be ignored.
    26 26 
          setFinalizerExceptionHandler,
    27 27 
          getFinalizerExceptionHandler,
    28 
    -     printToHandleFinalizerExceptionHandler
    28 
    +     GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler
    29 29 
          ) where
    30 30
    31 31 
     import GHC.Internal.Weak
    32 
    -import GHC.Internal.Weak.Finalize
    33 32 
     import GHC.Weak.Finalize

  • libraries/base/src/GHC/Weak/Finalize.hs
    ... ... @@ -7,7 +7,7 @@ module GHC.Weak.Finalize
    7 7 
           -- this handler will be ignored.
    8 8 
           setFinalizerExceptionHandler
    9 9 
         , getFinalizerExceptionHandler
    10 
    -    , printToHandleFinalizerExceptionHandler
    10 
    +    , GHC.Weak.Finalize.printToHandleFinalizerExceptionHandler
    11 11 
           -- * Internal
    12 12 
         , GHC.Weak.Finalize.runFinalizerBatch
    13 13 
         ) where

  • libraries/base/src/Prelude.hs
    1 
    +{-# LANGUAGE CPP #-}
    1 2 
     {-# LANGUAGE Trustworthy #-}
    2 3 
     {-# LANGUAGE NoImplicitPrelude #-}
    3 4 
     {-# LANGUAGE ExplicitNamespaces #-}
    ... ... @@ -176,14 +177,16 @@ import GHC.Internal.Data.Maybe
    176 177 
     import GHC.Internal.Data.Traversable ( Traversable(..) )
    177 178 
     import GHC.Internal.Data.Tuple
    178 179
    179 
    -import GHC.Internal.Base hiding ( foldr, mapM, sequence )
    180 
    +#if __GLASGOW_HASKELL__ >= 1000
    180 181 
     import GHC.Internal.Classes
    181 182 
     import GHC.Internal.Err
    183 
    +import GHC.Internal.Prim (seq)
    184 
    +import GHC.Internal.Types
    185 
    +#endif
    186 
    +import GHC.Internal.Base hiding ( foldr, mapM, sequence )
    182 187 
     import Text.Read
    183 188 
     import GHC.Internal.Enum
    184 189 
     import GHC.Internal.Num
    185 
    -import GHC.Internal.Prim (seq)
    186 190 
     import GHC.Internal.Real
    187 191 
     import GHC.Internal.Float
    188 192 
     import GHC.Internal.Show
    189 
    -import GHC.Internal.Types

  • libraries/base/src/System/IO.hs
    ... ... @@ -279,7 +279,11 @@ import GHC.IO.StdHandles
    279 279 
                stdout,
    280 280 
                stderr
    281 281 
            )
    282 
    +#if __GLASGOW_HASKELL__ < 1000
    283 
    +import GHC.Internal.System.IO (fixIO)
    284 
    +#else
    282 285 
     import GHC.Internal.Control.Monad.Fix (fixIO)
    286 
    +#endif
    283 287 
     import Control.Monad (return, (>>=))
    284 288 
     import Control.Exception (ioError)
    285 289 
     import Data.Eq ((==))

  • libraries/base/src/System/Mem/Weak.hs
    ... ... @@ -78,7 +78,7 @@ module System.Mem.Weak (
    78 78 
             -- this handler will be ignored.
    79 79 
             setFinalizerExceptionHandler,
    80 80 
             getFinalizerExceptionHandler,
    81 
    -        printToHandleFinalizerExceptionHandler,
    81 
    +        GHC.Weak.printToHandleFinalizerExceptionHandler,
    82 82
    83 83 
             -- * A precise semantics
    84 84

  • libraries/ghc-internal/src/GHC/Internal/Natural.hs
    ... ... @@ -93,7 +93,7 @@ plusNatural = N.naturalAdd
    93 93 
     minusNatural :: Natural -> Natural -> Natural
    94 94 
     minusNatural = N.naturalSubThrow
    95 95
    96 
    --- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
    96 
    +-- | 'Natural' subtraction. Returns 'Nothing's for negative results.
    97 97 
     --
    98 98 
     -- @since base-4.8.0.0
    99 99 
     minusNaturalMaybe :: Natural -> Natural -> Maybe Natural

  • testsuite/tests/profiling/should_compile/T27182.hs
    1 
    +module T27182 ( oneM ) where
    2 
    +
    3 
    +data Parser = BindP Int ( Char -> Bool )
    4 
    +
    5 
    +oneM :: Int -> ( Char -> Bool ) -> Parser
    6 
    +oneM p = BindP p

  • testsuite/tests/profiling/should_compile/all.T
    ... ... @@ -22,3 +22,4 @@ test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main',
    22 22 
     test('T20938', [test_opts], compile, ['-O -prof'])
    23 23 
     test('T26056', [test_opts], compile, ['-O -prof'])
    24 24 
     test('T27121', [test_opts, extra_files(['T27121_aux.hs'])], multimod_compile, ['T27121', '-v0 -O -prof -fprof-auto'])
    25 
    +test('T27182', [test_opts], compile, ['-O -prof -fprof-late'])

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