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

Commits:

10 changed files:

Changes:

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

  • docs/users_guide/exts/multiway_if.rst
    ... ... @@ -10,7 +10,7 @@ Multi-way if-expressions
    10 10
    11 11 
         Allow the use of multi-way-``if`` syntax.
    12 12
    13 
    -With :extension:`MultiWayIf` extension GHC accepts conditional expressions with
    13 
    +With the :extension:`MultiWayIf` extension GHC accepts conditional expressions with
    14 14 
     multiple branches: ::
    15 15
    16 16 
           if | guard1 -> expr1
    ... ... @@ -24,12 +24,12 @@ which is roughly equivalent to ::
    24 24 
             ...
    25 25 
             _ | guardN -> exprN
    26 26
    27 
    -Multi-way if expressions introduce a new layout context. So the example
    27 
    +Multi-way if expressions introduce a new kind of layout context that does not generate semicolons. The example
    28 28 
     above is equivalent to: ::
    29 29
    30 30 
           if { | guard1 -> expr1
    31 
    -         ; | ...
    32 
    -         ; | guardN -> exprN
    31 
    +           | ...
    32 
    +           | guardN -> exprN
    33 33 
              }
    34 34
    35 35 
     The following behaves as expected: ::
    ... ... @@ -41,14 +41,14 @@ The following behaves as expected: ::
    41 41 
     because layout translates it as ::
    42 42
    43 43 
           if { | guard1 -> if { | guard2 -> expr2
    44 
    -                          ; | guard3 -> expr3
    44 
    +                            | guard3 -> expr3
    45 45 
                               }
    46 
    -         ; | guard4 -> expr4
    46 
    +           | guard4 -> expr4
    47 47 
              }
    48 48
    49 49 
     Layout with multi-way if works in the same way as other layout contexts,
    50 
    -except that the semi-colons between guards in a multi-way if are
    51 
    -optional. So it is not necessary to line up all the guards at the same
    50 
    +except that desugaring does not insert semicolons.
    51 
    +So it is not necessary to line up all the guards at the same
    52 52 
     column; this is consistent with the way guards work in function
    53 53 
     definitions and case expressions.
    54 54

  • hadrian/src/Builder.hs
    ... ... @@ -49,7 +49,7 @@ import GHC.Toolchain.Program
    49 49 
     -- * Compile or preprocess a source file.
    50 50 
     -- * Extract source dependencies by passing @-MM@ command line argument.
    51 51 
     data CcMode = CompileC | FindCDependencies DependencyType deriving (Eq, Generic, Show)
    52 
    -data DependencyType = CDep | CxxDep deriving (Eq, Generic, Show)
    52 
    +data DependencyType = CDep | CxxDep | AsmDep deriving (Eq, Generic, Show)
    53 53
    54 54 
     instance Binary   CcMode
    55 55 
     instance Hashable CcMode

  • hadrian/src/Rules/Compile.hs
    ... ... @@ -282,8 +282,11 @@ needDependencies lang context@Context {..} src depFile = do
    282 282 
                 discover   -- Continue the discovery process
    283 283
    284 284 
         -- We need to pass different flags to cc depending on whether the
    285 
    -    -- file to compile is a .c or a .cpp file
    286 
    -    depType = if lang == Cxx then CxxDep else CDep
    285 
    +    -- file to compile is a .c or a .cpp or a .S file
    286 
    +    depType = case lang of
    287 
    +                Cxx -> CxxDep
    288 
    +                Asm -> AsmDep
    289 
    +                _   -> CDep
    287 290
    288 291 
         parseFile :: FilePath -> Action [String]
    289 292 
         parseFile file = do

  • hadrian/src/Settings/Builders/Cc.hs
    ... ... @@ -18,6 +18,7 @@ ccBuilderArgs = do
    18 18 
                 , arg "-o", arg =<< getOutput ]
    19 19 
             , builder (Cc (FindCDependencies CDep)) ? findCDepExpr CDep
    20 20 
             , builder (Cc (FindCDependencies CxxDep)) ? findCDepExpr CxxDep
    21 
    +        , builder (Cc (FindCDependencies AsmDep)) ? findCDepExpr AsmDep
    21 22 
             ]
    22 23 
         where
    23 24 
             findCDepExpr depType = do
    ... ... @@ -26,10 +27,10 @@ ccBuilderArgs = do
    26 27 
                         , arg "-MM", arg "-MG"
    27 28 
                         , arg "-MF", arg output
    28 29 
                         , arg "-MT", arg $ dropExtension output -<.> "o"
    29 
    -                    , case depType of CDep -> mempty; CxxDep -> arg "-std=c++11"
    30 
    +                    , case depType of CDep -> mempty; CxxDep -> arg "-std=c++11"; AsmDep -> mempty
    30 31 
                         , cIncludeArgs
    31 
    -                    , arg "-x", arg (case depType of CDep -> "c"; CxxDep -> "c++")
    32 
    -                    , case depType of CDep -> mempty; CxxDep -> getContextData cxxOpts
    32 
    +                    , arg "-x", arg (case depType of CDep -> "c"; CxxDep -> "c++"; AsmDep -> "assembler-with-cpp")
    33 
    +                    , case depType of CDep -> mempty; CxxDep -> getContextData cxxOpts; AsmDep -> mempty
    33 34 
                         -- Pass 'ghcversion.h' to give sources access to the
    34 35 
                         -- `MIN_VERSION_GLASGOW_HASKELL` macro.
    35 36 
                         , notStage0 ? arg "-include" <> arg "rts/include/ghcversion.h"

  • hadrian/src/Settings/Packages.hs
    ... ... @@ -428,6 +428,7 @@ rtsPackageArgs = package rts ? do
    428 428 
                   ]
    429 429 
             , builder (Cc (FindCDependencies CDep)) ? cArgs
    430 430 
             , builder (Cc (FindCDependencies  CxxDep)) ? cArgs
    431 
    +        , builder (Cc (FindCDependencies AsmDep)) ? cArgs
    431 432 
             , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs
    432 433 
             , builder (Ghc CompileCppWithGhc) ? map ("-optcxx" ++) <$> cArgs
    433 434 
             , builder Ghc ? ghcArgs

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

  • 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
    ... ... @@ -74,3 +74,4 @@ test('T25577', [ extra_run_opts(f'"{config.libdir}"')
    74 74 
     test('T26120', [], compile_and_run, ['-package ghc'])
    75 75
    76 76 
     test('T26264', normal, compile_and_run, ['-package ghc'])
    77 
    +test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc'])

  • testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
    ... ... @@ -30,7 +30,13 @@ RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999]
    30 30 
         • No instance for ‘HasField "quux3" Quux r0’
    31 31 
             arising from selecting the field ‘quux3’
    32 32 
           NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
    33 
    -    • In the expression: ....bar.baz.quux3
    34 
    -      In the second argument of ‘($)’, namely ‘....baz.quux3.wob’
    33 
    +    • In the second argument of ‘($)’, namely ‘....baz.quux3.wob’
    35 34 
           In a stmt of a 'do' block: print @Bool $ ....quux3.wob
    35 
    +      In the expression:
    36 
    +        do let a = Foo {foo = ...}
    37 
    +           print @Quux $ ....quux1
    38 
    +           let b = myQuux
    39 
    +           print @Quux $ b.quux2
    40 
    +           let c = Foo {foo = ...}
    41 
    +           ...
    36 42

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