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

Commits:

18 changed files:

Changes:

  • changelog.d/so_inline_is_a_predicate
    1 
    +section: ghc-lib
    2 
    +synopsis: Generalize the ``so_inline`` option of the simple optimizer to a predicate
    3 
    +          that selects the bindings to preserve.
    4 
    +
    5 
    +issues: #24386
    6 
    +mrs: !15988
    7 
    +
    8 
    +description: {
    9 
    +  The ``so_inline`` option of the simple optimizer was a boolean and now it is a
    10 
    +  predicate taking a binding ``Id`` and returning a boolean. ``const b`` has the
    11 
    +  same effect as formerly setting ``b``.
    12 
    +}

  • compiler/GHC/Core/SimpleOpt.hs
    ... ... @@ -108,6 +108,93 @@ unfolding-info to the scrutinee's Id.)
    108 108 
     * Bad bad bad: then the x in  case x of ... may be replaced with a version that has an unfolding.
    109 109
    110 110 
     See ticket #25790
    111 
    +
    112 
    +Note [Controlling inlining in the simple optimiser]
    113 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    114 
    +Sometimes, plugins that analyse Core programs may want to prevent the
    115 
    +inlining of certain bindings. While they could avoid running the simple
    116 
    +optimiser at all, that would leave plenty of generated bindings that do not
    117 
    +have a direct correspondence to the source code.
    118 
    +
    119 
    +For example, consider the following Haskell code:
    120 
    +
    121 
    +    foo = z
    122 
    +      where
    123 
    +        z  = z1 + z2
    124 
    +        z1 = 42
    125 
    +        z2 = 1
    126 
    +
    127 
    +Before the simple optimizer runs, the Core programs is roughly:
    128 
    +
    129 
    +    foo =
    130 
    +      let
    131 
    +        foo_aIb =
    132 
    +          let
    133 
    +            z2
    134 
    +              = let
    135 
    +                  z2_aHG = 1
    136 
    +                 in
    137 
    +                  z2_aHG
    138 
    +           in
    139 
    +            let
    140 
    +              z1 =
    141 
    +                let
    142 
    +                  z1_aHR = 42
    143 
    +                 in
    144 
    +                  z1_aHR
    145 
    +             in
    146 
    +              let
    147 
    +                z =
    148 
    +                  let
    149 
    +                    z_aI5 = z1 + z2
    150 
    +                   in
    151 
    +                    z_aI5
    152 
    +               in
    153 
    +                z
    154 
    +      in
    155 
    +        foo_aIb
    156 
    +
    157 
    +After the simple optimizer runs, the Core program is:
    158 
    +
    159 
    +    foo = 42 + 1
    160 
    +
    161 
    +And the bindings for `z`, `z1`, and `z2` are all gone. If a plugin wanted to
    162 
    +analyse those bindings, it would have to deal with the unsimplified Core, but
    163 
    +cope with the generated bindings `z2_aHG`, `z1_aHR`, `z_aI5`, and `foo_aIb`,
    164 
    +all of which have no direct correspondence to the source code.
    165 
    +
    166 
    +Fortunately, a plugin can still improve the output by using the `so_inline`
    167 
    +field of `SimpleOpts`. The `so_inline` field is a /function/ of type
    168 
    +`(Id -> Bool)` that tells the simple optimiser whether or not to inline the `Id`.
    169 
    +The client of the GHC can thereby control precisely which bindings are inlined
    170 
    +and which are not. For instance,
    171 
    +
    172 
    +    simplOptPgm
    173 
    +      (defaultSimpleOpts { so_inline = (`notElem` ["z", "z1", "z2"]) })
    174 
    +      ...
    175 
    +
    176 
    +produces the following Core program:
    177 
    +
    178 
    +    foo =
    179 
    +      let
    180 
    +        z2 = 1
    181 
    +       in
    182 
    +        let
    183 
    +          z1 = 42
    184 
    +         in
    185 
    +          let
    186 
    +            z = z1 + z2
    187 
    +           in
    188 
    +            z
    189 
    +
    190 
    +which contains the bindings of interest and little else.
    191 
    +
    192 
    +For the specifics of how this affects a concrete plugin (Liquid Haskell), see
    193 
    +the discussion in https://gitlab.haskell.org/ghc/ghc/-/issues/24386
    194 
    +
    195 
    +In addition to supporting clients of the GHC API, there is another use of
    196 
    +`so_inline` mentioned in 'simpleOptExprNoInline'.
    197 
    +
    111 198 
     -}
    112 199
    113 200 
     -- | Simple optimiser options
    ... ... @@ -115,8 +202,11 @@ data SimpleOpts = SimpleOpts
    115 202 
        { so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options
    116 203 
        , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
    117 204 
        , so_eta_red :: !Bool            -- ^ Eta reduction on?
    118 
    -   , so_inline :: !Bool             -- ^ False <=> do no inlining whatsoever,
    119 
    -                                    --    even for trivial or used-once things
    205 
    +   , so_inline :: !(Var -> Bool)    -- ^ False <=> do no inline the given
    206 
    +                                    --   binding whatsoever, even for trivial or
    207 
    +                                    --   used-once things
    208 
    +                                    --
    209 
    +                                    --   See Note [Controlling inlining in the simple optimiser]
    120 210 
        }
    121 211
    122 212 
     -- | Default options for the Simple optimiser.
    ... ... @@ -125,7 +215,7 @@ defaultSimpleOpts = SimpleOpts
    125 215 
        { so_uf_opts = defaultUnfoldingOpts
    126 216 
        , so_co_opts = OptCoercionOpts { optCoercionEnabled = False }
    127 217 
        , so_eta_red = False
    128 
    -   , so_inline  = True
    218 
    +   , so_inline  = const True
    129 219 
        }
    130 220
    131 221 
     simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    ... ... @@ -170,7 +260,7 @@ simpleOptExprNoInline :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
    170 260 
     simpleOptExprNoInline opts expr
    171 261 
       = simple_opt_expr init_env expr
    172 262 
       where
    173 
    -    init_opts  = opts { so_inline = False }
    263 
    +    init_opts  = opts { so_inline = const False }
    174 264 
         init_env   = (emptyEnv init_opts) { soe_subst = init_subst }
    175 265 
         init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
    176 266
    ... ... @@ -639,12 +729,12 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst, soe_opts = opt
    639 729
    640 730 
         pre_inline_unconditionally :: Bool
    641 731 
         pre_inline_unconditionally
    642 
    -       | not (so_inline opts)     = False    -- Not if so_inline is False
    643 
    -       | isExportedId in_bndr     = False
    644 
    -       | stable_unf               = False
    645 
    -       | not active               = False    -- Note [Inline prag in simplOpt]
    646 
    -       | not (safe_to_inline occ) = False
    647 
    -       | otherwise                = True
    732 
    +       | not (so_inline opts in_bndr) = False    -- Not if so_inline is False
    733 
    +       | isExportedId in_bndr         = False
    734 
    +       | stable_unf                   = False
    735 
    +       | not active                   = False    -- Note [Inline prag in simplOpt]
    736 
    +       | not (safe_to_inline occ)     = False
    737 
    +       | otherwise                    = True
    648 738
    649 739 
             -- Unconditionally safe to inline
    650 740 
     safe_to_inline :: OccInfo -> Bool
    ... ... @@ -711,15 +801,15 @@ simple_out_bind_pair env@(SOE { soe_subst = subst, soe_opts = opts })
    711 801
    712 802 
         post_inline_unconditionally :: Bool
    713 803 
         post_inline_unconditionally
    714 
    -       | not (so_inline opts)  = False -- Not if so_inline is False
    715 
    -       | isExportedId in_bndr  = False -- Note [Exported Ids and trivial RHSs]
    716 
    -       | stable_unf            = False -- Note [Stable unfoldings and postInlineUnconditionally]
    717 
    -       | not active            = False --     in GHC.Core.Opt.Simplify.Utils
    718 
    -       | is_loop_breaker       = False -- If it's a loop-breaker of any kind, don't inline
    719 
    -                                       -- because it might be referred to "earlier"
    720 
    -       | exprIsTrivial out_rhs = True
    721 
    -       | coercible_hack        = True
    722 
    -       | otherwise             = False
    804 
    +       | not (so_inline opts in_bndr) = False -- Not if so_inline is False
    805 
    +       | isExportedId in_bndr         = False -- Note [Exported Ids and trivial RHSs]
    806 
    +       | stable_unf                   = False -- Note [Stable unfoldings and postInlineUnconditionally]
    807 
    +       | not active                   = False --     in GHC.Core.Opt.Simplify.Utils
    808 
    +       | is_loop_breaker              = False -- If it's a loop-breaker of any kind, don't inline
    809 
    +                                              -- because it might be referred to "earlier"
    810 
    +       | exprIsTrivial out_rhs        = True
    811 
    +       | coercible_hack               = True
    812 
    +       | otherwise                    = False
    723 813
    724 814 
         is_loop_breaker = isWeakLoopBreaker occ_info
    725 815

  • compiler/GHC/Driver/Config.hs
    ... ... @@ -26,7 +26,7 @@ initSimpleOpts dflags = SimpleOpts
    26 26 
        { so_uf_opts = unfoldingOpts dflags
    27 27 
        , so_co_opts = initOptCoercionOpts dflags
    28 28 
        , so_eta_red = gopt Opt_DoEtaReduction dflags
    29 
    -   , so_inline  = True
    29 
    +   , so_inline  = const True
    30 30 
        }
    31 31
    32 32 
     -- | Instruct the interpreter evaluation to break...

  • libraries/base/src/Data/Functor/Classes.hs
    ... ... @@ -85,7 +85,7 @@ import GHC.Internal.Read (expectP, list, paren, readField)
    85 85 
     import GHC.Internal.Show (appPrec)
    86 86
    87 87 
     import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
    88 
    -import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
    88 
    +import Text.Read (Read(..), parens, prec, step, reset)
    89 89 
     import GHC.Internal.Text.Read.Lex (Lexeme(..))
    90 90 
     import GHC.Internal.Text.Show (showListWith)
    91 91 
     import Prelude

  • libraries/base/src/Data/Functor/Compose.hs
    ... ... @@ -35,7 +35,7 @@ import GHC.Internal.Data.Foldable (Foldable(..))
    35 35 
     import GHC.Internal.Data.Monoid (Sum(..), All(..), Any(..), Product(..))
    36 36 
     import GHC.Internal.Data.Type.Equality (TestEquality(..), (:~:)(..))
    37 37 
     import GHC.Generics (Generic, Generic1)
    38 
    -import GHC.Internal.Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
    38 
    +import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
    39 39 
     import Prelude
    40 40
    41 41 
     infixr 9 `Compose`

  • libraries/base/src/Prelude.hs
    ... ... @@ -179,7 +179,7 @@ import GHC.Internal.Data.Tuple
    179 179 
     import GHC.Internal.Base hiding ( foldr, mapM, sequence )
    180 180 
     import GHC.Internal.Classes
    181 181 
     import GHC.Internal.Err
    182 
    -import GHC.Internal.Text.Read
    182 
    +import Text.Read
    183 183 
     import GHC.Internal.Enum
    184 184 
     import GHC.Internal.Num
    185 185 
     import GHC.Internal.Prim (seq)

  • libraries/base/src/Text/Read.hs
    ... ... @@ -39,5 +39,84 @@ module Text.Read
    39 39 
          readMaybe
    40 40 
          ) where
    41 41
    42 
    -import GHC.Internal.Text.Read
    42 
    +import GHC.Err (errorWithoutStackTrace)
    43 
    +import GHC.Read
    44 
    +       (
    45 
    +           ReadS,
    46 
    +           Read (readsPrec, readList, readPrec, readListPrec),
    47 
    +           lex,
    48 
    +           readParen,
    49 
    +           readListDefault,
    50 
    +           lexP,
    51 
    +           parens,
    52 
    +           readListPrecDefault
    53 
    +       )
    54 
    +import Control.Monad (return)
    55 
    +import Data.Function (id)
    56 
    +import Data.Maybe (Maybe (Nothing, Just))
    57 
    +import Data.Either (Either (Left, Right), either)
    58 
    +import Data.String (String)
    59 
    +import Text.Read.Lex (Lexeme (Char, String, Punc, Ident, Symbol, Number, EOF))
    60 
    +import Text.ParserCombinators.ReadP (skipSpaces)
    43 61 
     import Text.ParserCombinators.ReadPrec
    62 
    +
    63 
    +-- $setup
    64 
    +-- >>> import Prelude
    65 
    +
    66 
    +------------------------------------------------------------------------
    67 
    +-- utility functions
    68 
    +
    69 
    +-- | equivalent to 'readsPrec' with a precedence of 0.
    70 
    +reads :: Read a => ReadS a
    71 
    +reads = readsPrec minPrec
    72 
    +
    73 
    +-- | Parse a string using the 'Read' instance.
    74 
    +-- Succeeds if there is exactly one valid result.
    75 
    +-- A 'Left' value indicates a parse error.
    76 
    +--
    77 
    +-- >>> readEither "123" :: Either String Int
    78 
    +-- Right 123
    79 
    +--
    80 
    +-- >>> readEither "hello" :: Either String Int
    81 
    +-- Left "Prelude.read: no parse"
    82 
    +--
    83 
    +-- @since base-4.6.0.0
    84 
    +readEither :: Read a => String -> Either String a
    85 
    +readEither s =
    86 
    +  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
    87 
    +    [x] -> Right x
    88 
    +    []  -> Left "Prelude.read: no parse"
    89 
    +    _   -> Left "Prelude.read: ambiguous parse"
    90 
    + where
    91 
    +  read' =
    92 
    +    do x <- readPrec
    93 
    +       lift skipSpaces
    94 
    +       return x
    95 
    +
    96 
    +-- | Parse a string using the 'Read' instance.
    97 
    +-- Succeeds if there is exactly one valid result.
    98 
    +--
    99 
    +-- >>> readMaybe "123" :: Maybe Int
    100 
    +-- Just 123
    101 
    +--
    102 
    +-- >>> readMaybe "hello" :: Maybe Int
    103 
    +-- Nothing
    104 
    +--
    105 
    +-- @since base-4.6.0.0
    106 
    +readMaybe :: Read a => String -> Maybe a
    107 
    +readMaybe s = case readEither s of
    108 
    +                Left _  -> Nothing
    109 
    +                Right a -> Just a
    110 
    +
    111 
    +-- | The 'read' function reads input from a string, which must be
    112 
    +-- completely consumed by the input process. 'read' fails with an 'error' if the
    113 
    +-- parse is unsuccessful, and it is therefore discouraged from being used in
    114 
    +-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
    115 
    +--
    116 
    +-- >>> read "123" :: Int
    117 
    +-- 123
    118 
    +--
    119 
    +-- >>> read "hello" :: Int
    120 
    +-- *** Exception: Prelude.read: no parse
    121 
    +read :: Read a => String -> a
    122 
    +read s = either errorWithoutStackTrace id (readEither s)

  • libraries/ghc-internal/ghc-internal.cabal.in
    ... ... @@ -329,7 +329,6 @@ Library
    329 329 
             GHC.Internal.System.Posix.Types
    330 330 
             GHC.Internal.Text.ParserCombinators.ReadP
    331 331 
             GHC.Internal.Text.ParserCombinators.ReadPrec
    332 
    -        GHC.Internal.Text.Read
    333 332 
             GHC.Internal.Text.Read.Lex
    334 333 
             GHC.Internal.Text.Show
    335 334 
             GHC.Internal.Type.Reflection

  • libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
    ... ... @@ -46,7 +46,7 @@ import GHC.Internal.IO.Encoding.Types
    46 46 
     import qualified GHC.Internal.IO.Encoding.Iconv as Iconv
    47 47 
     #else
    48 48 
     import qualified GHC.Internal.IO.Encoding.CodePage as CodePage
    49 
    -import GHC.Internal.Text.Read (reads)
    49 
    +import GHC.Internal.Read (readsPrec)
    50 50 
     #endif
    51 51 
     import qualified GHC.Internal.IO.Encoding.Latin1 as Latin1
    52 52 
     import qualified GHC.Internal.IO.Encoding.UTF8   as UTF8
    ... ... @@ -319,7 +319,8 @@ mkTextEncoding' cfm enc =
    319 319 
         _ | isAscii -> return (Latin1.mkAscii cfm)
    320 320 
         _ | isLatin1 -> return (Latin1.mkLatin1_checked cfm)
    321 321 
     #if defined(mingw32_HOST_OS)
    322 
    -    'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp
    322 
    +    'C':'P':n | [(cp,"")] <- readsPrec 0 n -> return $ CodePage.mkCodePageEncoding cfm cp
    323 
    +        -- 'readsPrec 0' is the same as 'reads', but 'reads' is only defined in @base@.
    323 324 
         _ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)
    324 325 
     #else
    325 326 
         -- Otherwise, handle other encoding needs via iconv.

  • libraries/ghc-internal/src/GHC/Internal/Text/Read.hs deleted
    1 
    -{-# LANGUAGE Trustworthy #-}
    2 
    -{-# LANGUAGE NoImplicitPrelude #-}
    3 
    -
    4 
    ------------------------------------------------------------------------------
    5 
    --- |
    6 
    --- Module      :  GHC.Internal.Text.Read
    7 
    --- Copyright   :  (c) The University of Glasgow 2001
    8 
    --- License     :  BSD-style (see the file libraries/base/LICENSE)
    9 
    ---
    10 
    --- Maintainer  :  libraries@haskell.org
    11 
    --- Stability   :  provisional
    12 
    --- Portability :  non-portable (uses Text.ParserCombinators.ReadP)
    13 
    ---
    14 
    --- Converting strings to values.
    15 
    ---
    16 
    --- The "Text.Read" library is the canonical library to import for
    17 
    --- 'Read'-class facilities.  For GHC only, it offers an extended and much
    18 
    --- improved 'Read' class, which constitutes a proposed alternative to the
    19 
    --- Haskell 2010 'Read'.  In particular, writing parsers is easier, and
    20 
    --- the parsers are much more efficient.
    21 
    ---
    22 
    ------------------------------------------------------------------------------
    23 
    -
    24 
    -module GHC.Internal.Text.Read (
    25 
    -   -- * The 'Read' class
    26 
    -   Read(..),
    27 
    -   ReadS,
    28 
    -
    29 
    -   -- * Haskell 2010 functions
    30 
    -   reads,
    31 
    -   read,
    32 
    -   readParen,
    33 
    -   lex,
    34 
    -
    35 
    -   -- * New parsing functions
    36 
    -   module GHC.Internal.Text.ParserCombinators.ReadPrec,
    37 
    -   L.Lexeme(..),
    38 
    -   lexP,
    39 
    -   parens,
    40 
    -   readListDefault,
    41 
    -   readListPrecDefault,
    42 
    -   readEither,
    43 
    -   readMaybe
    44 
    -
    45 
    - ) where
    46 
    -
    47 
    -import GHC.Internal.Base (String, id, return)
    48 
    -import GHC.Internal.Err (errorWithoutStackTrace)
    49 
    -import GHC.Internal.Maybe (Maybe(..))
    50 
    -import GHC.Internal.Read
    51 
    -import GHC.Internal.Data.Either
    52 
    -import GHC.Internal.Text.ParserCombinators.ReadP as P
    53 
    -import GHC.Internal.Text.ParserCombinators.ReadPrec
    54 
    -import qualified GHC.Internal.Text.Read.Lex as L
    55 
    -
    56 
    --- $setup
    57 
    --- >>> import Prelude
    58 
    -
    59 
    -------------------------------------------------------------------------
    60 
    --- utility functions
    61 
    -
    62 
    --- | equivalent to 'readsPrec' with a precedence of 0.
    63 
    -reads :: Read a => ReadS a
    64 
    -reads = readsPrec minPrec
    65 
    -
    66 
    --- | Parse a string using the 'Read' instance.
    67 
    --- Succeeds if there is exactly one valid result.
    68 
    --- A 'Left' value indicates a parse error.
    69 
    ---
    70 
    --- >>> readEither "123" :: Either String Int
    71 
    --- Right 123
    72 
    ---
    73 
    --- >>> readEither "hello" :: Either String Int
    74 
    --- Left "Prelude.read: no parse"
    75 
    ---
    76 
    --- @since base-4.6.0.0
    77 
    -readEither :: Read a => String -> Either String a
    78 
    -readEither s =
    79 
    -  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
    80 
    -    [x] -> Right x
    81 
    -    []  -> Left "Prelude.read: no parse"
    82 
    -    _   -> Left "Prelude.read: ambiguous parse"
    83 
    - where
    84 
    -  read' =
    85 
    -    do x <- readPrec
    86 
    -       lift P.skipSpaces
    87 
    -       return x
    88 
    -
    89 
    --- | Parse a string using the 'Read' instance.
    90 
    --- Succeeds if there is exactly one valid result.
    91 
    ---
    92 
    --- >>> readMaybe "123" :: Maybe Int
    93 
    --- Just 123
    94 
    ---
    95 
    --- >>> readMaybe "hello" :: Maybe Int
    96 
    --- Nothing
    97 
    ---
    98 
    --- @since base-4.6.0.0
    99 
    -readMaybe :: Read a => String -> Maybe a
    100 
    -readMaybe s = case readEither s of
    101 
    -                Left _  -> Nothing
    102 
    -                Right a -> Just a
    103 
    -
    104 
    --- | The 'read' function reads input from a string, which must be
    105 
    --- completely consumed by the input process. 'read' fails with an 'error' if the
    106 
    --- parse is unsuccessful, and it is therefore discouraged from being used in
    107 
    --- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
    108 
    ---
    109 
    --- >>> read "123" :: Int
    110 
    --- 123
    111 
    ---
    112 
    --- >>> read "hello" :: Int
    113 
    --- *** Exception: Prelude.read: no parse
    114 
    -read :: Read a => String -> a
    115 
    -read s = either errorWithoutStackTrace id (readEither s)

  • testsuite/tests/ghc-api/T24386.hs
    1 
    +
    2 
    +-- This test checks that bindings are preserved when configuring the simple
    3 
    +-- optimizer to not inline bindings with names selected by a predicate.
    4 
    +--
    5 
    +-- This feature is important for the LiquidHaskell plugin, which relies on the
    6 
    +-- simple optimizer to make core programs easier to read, but needs to preserve
    7 
    +-- bindings that are relevant for verification.
    8 
    +--
    9 
    +-- See https://gitlab.haskell.org/ghc/ghc/-/issues/24386 for the full discussion.
    10 
    +--
    11 
    +
    12 
    +import           Control.Monad
    13 
    +import           Data.List (find)
    14 
    +import           Data.Time (getCurrentTime)
    15 
    +import GHC
    16 
    +import GHC.Core
    17 
    +import GHC.Core.SimpleOpt
    18 
    +import GHC.Data.StringBuffer
    19 
    +import GHC.Driver.Config
    20 
    +import GHC.Driver.DynFlags
    21 
    +import GHC.Driver.Env.Types
    22 
    +import GHC.Types.Name
    23 
    +import GHC.Unit.Module.ModGuts
    24 
    +import GHC.Unit.Types
    25 
    +import GHC.Utils.Error
    26 
    +import GHC.Utils.Outputable
    27 
    +
    28 
    +import System.Environment (getArgs)
    29 
    +
    30 
    +
    31 
    +main :: IO ()
    32 
    +main =
    33 
    +  testLocalBindingsDesugaring
    34 
    +
    35 
    +testLocalBindingsDesugaring :: IO ()
    36 
    +testLocalBindingsDesugaring = do
    37 
    +    let inputSource = unlines
    38 
    +          [ "module LocalBindingsDesugaring where"
    39 
    +          , "f :: ()"
    40 
    +          , "f = z"
    41 
    +          , "  where"
    42 
    +          , "    z = ()"
    43 
    +          ]
    44 
    +
    45 
    +        isExpectedDesugaring p = case findExpr "f" p of
    46 
    +          Just (Let (NonRec b _) _)
    47 
    +            -> isIdNamed "z" b
    48 
    +          _ -> False
    49 
    +
    50 
    +        isIdNamed name v = occNameString (occName v) == name
    51 
    +
    52 
    +    coreProgram <-
    53 
    +       compileToCore
    54 
    +         (not . isIdNamed "z")
    55 
    +         "LocalBindingsDesugaring"
    56 
    +         inputSource
    57 
    +    unless (isExpectedDesugaring coreProgram) $
    58 
    +      fail $ unlines $
    59 
    +        "Unexpected desugaring: No local binding for `z` found in the Core program."
    60 
    +        : map showPprQualified coreProgram
    61 
    +
    62 
    +-- | Find the Core expression bound to the given name.
    63 
    +findExpr :: String -> CoreProgram -> Maybe CoreExpr
    64 
    +findExpr _ [] =
    65 
    +  Nothing
    66 
    +findExpr name (p:ps) = case p of
    67 
    +  NonRec b e
    68 
    +    | occNameString (occName b) == name
    69 
    +    -> Just e
    70 
    +  Rec binds
    71 
    +    | Just (_, e) <- find (\(b, _e) -> occNameString (occName b) == name) binds
    72 
    +    -> Just e
    73 
    +  _ -> findExpr name ps
    74 
    +
    75 
    +showPprQualified :: Outputable a => a -> String
    76 
    +showPprQualified = showSDocQualified . ppr
    77 
    +
    78 
    +showSDocQualified :: SDoc -> String
    79 
    +showSDocQualified = renderWithContext ctx
    80 
    +  where
    81 
    +    ctx = defaultSDocContext { sdocStyle = cmdlineParserStyle }
    82 
    +
    83 
    +
    84 
    +
    85 
    +compileToCore :: (Id -> Bool) -> String -> String -> IO [CoreBind]
    86 
    +compileToCore keepBindings modName inputSource = do
    87 
    +    [libdir] <- getArgs
    88 
    +    now <- getCurrentTime
    89 
    +    runGhc (Just libdir) $ do
    90 
    +      df1 <- getSessionDynFlags
    91 
    +      GHC.setSessionDynFlags $ df1 { GHC.backend = GHC.bytecodeBackend }
    92 
    +      let target = Target {
    93 
    +                   targetId           = TargetFile (modName ++ ".hs") Nothing
    94 
    +                 , targetUnitId       = homeUnitId_ df1
    95 
    +                 , targetAllowObjCode = False
    96 
    +                 , targetContents     = Just (stringToStringBuffer inputSource, now)
    97 
    +                 }
    98 
    +      setTargets [target]
    99 
    +      void $ GHC.depanal [] False
    100 
    +
    101 
    +      dsMod <- getModSummary
    102 
    +                 (mkModule mainUnit (mkModuleName modName))
    103 
    +             >>= parseModule
    104 
    +             >>= typecheckModule NoTcMPlugins
    105 
    +             >>= desugarModule
    106 
    +      hsc_env <- getSession
    107 
    +      return $ mg_binds $ simpleOptimize keepBindings hsc_env $ dm_core_module dsMod
    108 
    +
    109 
    +-- Run the simple optimizer
    110 
    +simpleOptimize :: (Id -> Bool) -> GHC.HscEnv -> ModGuts -> ModGuts
    111 
    +simpleOptimize keepBindings hsc_env guts@(ModGuts
    112 
    +                               { mg_module  = mgmod
    113 
    +                               , mg_binds   = binds
    114 
    +                               , mg_rules   = rules
    115 
    +                               }) =
    116 
    +    let dflags = hsc_dflags hsc_env
    117 
    +        simpl_opts = (initSimpleOpts dflags) { so_inline = keepBindings }
    118 
    +        (binds2, rules2, _occ_anald_binds) =
    119 
    +          simpleOptPgm simpl_opts mgmod binds rules
    120 
    +      in guts
    121 
    +          { mg_binds = binds2
    122 
    +          , mg_rules = rules2
    123 
    +          }

  • testsuite/tests/ghc-api/all.T
    ... ... @@ -81,3 +81,4 @@ test('T26910', [ extra_run_opts(f'"{config.libdir}"')
    81 81 
     test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc'])
    82 82
    83 83 
     test('T25121_status', normal, compile_and_run, ['-package ghc'])
    84 
    +test('T24386', [extra_run_opts(f'"{config.libdir}"')], compile_and_run, ['-package ghc'])

  • testsuite/tests/interface-stability/.gitignore
    1 
    +download-base-exports

  • testsuite/tests/interface-stability/README.mkd
    1 1 
     # Interface stability testing
    2 2
    3 
    -The tests in this directory verify that the interfaces of exposed by GHC's
    3 
    +The tests in this directory verify that the interfaces exposed by GHC's
    4 4 
     core libraries do not inadvertently change. They use the `utils/dump-decls`
    5 5 
     utility to dump all exported declarations of all exposed modules for the
    6 6 
     following packages:
    ... ... @@ -27,7 +27,9 @@ The `base-exports` test in particular has rather platform-dependent output.
    27 27 
     Consequently, updating its output can be a bit tricky. There are two ways by
    28 28 
     which one can do this:
    29 29
    30 
    - * Extrapolation: The various platforms' `base-exports.stdout` files are
    30 
    +#### Extrapolation
    31 
    +
    32 
    +The various platforms' `base-exports.stdout` files are
    31 33 
        similar enough that one can often apply the same patch of one file to the
    32 34 
        others.  For instance:
    33 35 
        ```
    ... ... @@ -40,8 +42,44 @@ which one can do this:
    40 42 
        In the case of conflicts, increasing the fuzz factor (using `-F`) can be
    41 43 
        quite effective.
    42 44
    43 
    - * Using CI: Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
    45 
    +#### Using CI
    46 
    +
    47 
    +Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
    44 48 
        which contains the output produced by the job's failing tests. Simply
    45 
    -   download this tarball and extracting the appropriate `base-exports.stdout-*`
    49 
    +   download this tarball and extract the appropriate `base-exports.stdout-*`
    46 50 
        files into this directory.
    47 51
    52 
    +Doing this by hand is of course very annoying. To make things faster, use the script in this folder called `download.base-exports.sh` :
    53 
    +
    54 
    +* Running for the first time
    55 
    +    1. Find the URL for downloading unexpected-test-output.tar.gz. To do so
    56 
    +        * Go to the CI job page you want to download
    57 
    +        * Click on "Browse"
    58 
    +        * Find unexpected-test-output.tar.gz
    59 
    +        * Right-click the download link then "Copy link" (Firefox)
    60 
    +    2. The URL should look like this :
    61 
    +        `https://gitlab.haskell.org/ghc/ghc/-/jobs/2503744/artifacts/file/unexpected-test-output.tar.gz`
    62 
    +        * the prefix is   : `https://gitlab.haskell.org/ghc/ghc/-/jobs/`
    63 
    +        * the job ID is   : `2503744`
    64 
    +        * and the suffix  : `/artifacts/file/unexpected-test-output.tar.gz`
    65 
    +    3. The script prompts you with URL prefix and suffix.
    66 
    +    4. It will save a file to remember this, so you only need to do this once.
    67 
    +    5. If you need to change the URL, just edit the file `download-base-exports/url-unexpected-test-output` directly.
    68 
    +
    69 
    +* Downloading the artifacts
    70 
    +    1. Find all the job IDs you want to download. For this, just go to the jobs
    71 
    +       page `https://gitlab.haskell.org/<YOUR-FORK>/ghc/-/jobs`
    72 
    +    2. Make sure you get all the artifacts. You need 3 of them.
    73 
    +       To get all 3 CI jobs, the label `javascript` must be on the MR.
    74 
    +       If you don't have the rights for adding these labels, ask.
    75 
    +          1. The `x86` CI job for darwin or linux : `base-exports.stdout`
    76 
    +          2. The `windows` job : `base-exports.stdout-mingw32`
    77 
    +          3. The `javascript` CI job :
    78 
    +                          `base-exports.stdout-javascript-unknown-ghcjs`
    79 
    +    3. Run the script with all the job IDs :
    80 
    +       `./download-base-exports.sh 2502789 2502792 2502793`
    81 
    +
    82 
    +       Using a range downloads more artifacts than necessary, but is a
    83 
    +       no-brainer:
    84 
    +
    85 
    +       `./download-base-exports.sh {2502789..2502795}`

  • testsuite/tests/interface-stability/download-base-exports.sh
    1 
    +#!/usr/bin/env bash
    2 
    +
    3 
    +# See the README file in this folder for usage
    4 
    +
    5 
    +jobIDs=("$@")
    6 
    +
    7 
    +BASE_DIR_NAME=download-base-exports
    8 
    +DL_DIR_NAME=dl
    9 
    +BASE_DIR="$(dirname "$0")/$BASE_DIR_NAME"
    10 
    +DL_DIR=$BASE_DIR/$DL_DIR_NAME
    11 
    +URL_FILE="$BASE_DIR/url-unexpected-test-output"
    12 
    +
    13 
    +DEFAULT_PREFIX="https://gitlab.haskell.org/ghc/ghc/-/jobs/"
    14 
    +DEFAULT_POSTFIX="/artifacts/raw/unexpected-test-output.tar.gz"
    15 
    +
    16 
    +mkdir -p "$BASE_DIR"
    17 
    +
    18 
    +# URL configuration for finding unexpected-test-output.tar.gz
    19 
    +
    20 
    +if [[ ! -f "$URL_FILE" ]]; then
    21 
    +    echo "No URL for unexpected-test-output.tar.gz was found"
    22 
    +
    23 
    +    read -p "Enter job URL prefix [${DEFAULT_PREFIX}]: " inputPrefix
    24 
    +    read -p "Enter job URL postfix [${DEFAULT_POSTFIX}]: " inputPostfix
    25 
    +
    26 
    +    urlPrefix="${inputPrefix:-$DEFAULT_PREFIX}"
    27 
    +    urlPostfix="${inputPostfix:-$DEFAULT_POSTFIX}"
    28 
    +
    29 
    +    {
    30 
    +        echo "urlPrefix=$urlPrefix"
    31 
    +        echo "urlPostfix=$urlPostfix"
    32 
    +    } > "$URL_FILE"
    33 
    +else
    34 
    +    source "$URL_FILE"
    35 
    +fi
    36 
    +
    37 
    +mkdir -p $DL_DIR
    38 
    +
    39 
    +echo "urlPrefix: $urlPrefix"
    40 
    +echo "jobIDs: $jobIDs"
    41 
    +echo "urlPostfix: $urlPostfix"
    42 
    +echo ""
    43 
    +echo "Downloading unexpected-test-output.tar.gz for each job ..."
    44 
    +
    45 
    +# Download and copy base-exports*  files
    46 
    +
    47 
    +for jobID  in "${jobIDs[@]}"; do
    48 
    +  unexpectedOutputUrl="$urlPrefix$jobID$urlPostfix"
    49 
    +
    50 
    +  wget -O "$DL_DIR/job$jobID.tar.gz" $unexpectedOutputUrl
    51 
    +
    52 
    +  mkdir -p "$DL_DIR/job$jobID"
    53 
    +  tar -xzf "$DL_DIR/job$jobID.tar.gz" -C "$DL_DIR/job$jobID"
    54 
    +  cp "$DL_DIR/job$jobID"/unexpected-test-output/testsuite/tests/interface-stability/base-exports* "$BASE_DIR/.."
    55 
    +done

  • testsuite/tests/th/T24111.stdout
    ... ... @@ -3,6 +3,6 @@ pattern (:+_0) :: GHC.Internal.Types.Int ->
    3 3 
                       (GHC.Internal.Types.Int, GHC.Internal.Types.Int)
    4 4 
     pattern x_1 :+_0 y_2 = (x_1, y_2)
    5 5 
     pattern A_0 :: GHC.Internal.Types.Int -> GHC.Internal.Base.String
    6 
    -pattern A_0 n_1 <- (GHC.Internal.Text.Read.read -> n_1) where
    6 
    +pattern A_0 n_1 <- (Text.Read.read -> n_1) where
    7 7 
                            A_0 0 = "hi"
    8 8 
                            A_0 1 = "bye"

  • testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
    ... ... @@ -11,14 +11,13 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef
    11 11 
             words :: String -> [String]
    12 12 
               (imported from ‘Prelude’
    13 13 
                (and originally defined in ‘GHC.Internal.Data.OldList’))
    14 
    -        read :: forall a. Read a => String -> a
    15 
    -          with read @[String]
    16 
    -          (imported from ‘Prelude’
    17 
    -           (and originally defined in ‘GHC.Internal.Text.Read’))
    18 14 
             repeat :: forall a. a -> [a]
    19 15 
               with repeat @String
    20 16 
               (imported from ‘Prelude’
    21 17 
                (and originally defined in ‘GHC.Internal.List’))
    18 
    +        read :: forall a. Read a => String -> a
    19 
    +          with read @[String]
    20 
    +          (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
    22 21 
             mempty :: forall a. Monoid a => a
    23 22 
               with mempty @(String -> [String])
    24 23 
               (imported from ‘Prelude’

  • testsuite/tests/typecheck/should_fail/T21130.stderr
    ... ... @@ -6,6 +6,9 @@ T21130.hs:10:6: error: [GHC-88464]
    6 6 
           In an equation for ‘x’: x = (_ f) :: Int
    7 7 
         • Relevant bindings include x :: Int (bound at T21130.hs:10:1)
    8 8 
           Valid hole fits include
    9 
    +        read :: forall a. Read a => String -> a
    10 
    +          with read @Int
    11 
    +          (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
    9 12 
             head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
    10 13 
               with head @Int
    11 14 
               (imported from ‘Prelude’
    ... ... @@ -14,10 +17,6 @@ T21130.hs:10:6: error: [GHC-88464]
    14 17 
               with last @Int
    15 18 
               (imported from ‘Prelude’
    16 19 
                (and originally defined in ‘GHC.Internal.List’))
    17 
    -        read :: forall a. Read a => String -> a
    18 
    -          with read @Int
    19 
    -          (imported from ‘Prelude’
    20 
    -           (and originally defined in ‘GHC.Internal.Text.Read’))
    21 20
    22 21 
     T21130.hs:10:8: error: [GHC-39999]
    23 22 
         • Ambiguous type variable ‘t0’ arising from a use of ‘f’

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