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

Commits:

18 changed files:

Changes:

  • compiler/GHC/Iface/Ext/Types.hs
    ... ... @@ -96,10 +96,6 @@ data HieFile = HieFile
    96 96
    97 97 
     type NameEntityInfo = M.Map Name (S.Set EntityInfo)
    98 98
    99 
    -instance Binary NameEntityInfo where
    100 
    -  put_ bh m = put_ bh $ M.toList m
    101 
    -  get bh = fmap M.fromList (get bh)
    102 
    -
    103 99 
     instance Binary HieFile where
    104 100 
       put_ bh hf = do
    105 101 
         put_ bh $ hie_hs_file hf

  • compiler/GHC/Parser.y
    ... ... @@ -1078,11 +1078,11 @@ qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec }
    1078 1078 
             |  '..'                     { sL1a $1 (ImpExpQcWildcard (epTok $1) NoEpTok)  }
    1079 1079
    1080 1080 
     qcname_ext :: { LocatedA ImpExpQcSpec }
    1081 
    -        :  qcname                   { sL1a $1 (ImpExpQcName $1) }
    1082 
    -        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2
    1083 
    -                                          ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }}
    1084 
    -        |  'data' qvarcon           {% do { n <- mkDataImpExp $2
    1085 
    -                                          ; return $ sLLa $1 $> (ImpExpQcData (epTok $1) n) }}
    1081 
    +        :  qcname                   { sL1a $1 (mkPlainImpExp $1) }
    1082 
    +        |  'type' oqtycon           {% do { imp_exp <- mkTypeImpExp (epTok $1) $2
    1083 
    +                                          ; return $ sLLa $1 $> imp_exp }}
    1084 
    +        |  'data' qvarcon           {% do { imp_exp <- mkDataImpExp (epTok $1) $2
    1085 
    +                                          ; return $ sLLa $1 $> imp_exp }}
    1086 1086
    1087 1087 
     qcname  :: { LocatedN RdrName }  -- Variable or type constructor
    1088 1088 
             :  qvar                 { $1 } -- Things which look like functions

  • compiler/GHC/Parser/Errors/Ppr.hs
    ... ... @@ -273,9 +273,14 @@ instance Diagnostic PsMessage where
    273 273 
                       2 (pprWithCommas ppr vs)
    274 274 
                     , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
    275 275 
                     ]
    276 
    -    PsErrIllegalExplicitNamespace
    276 
    +    PsErrIllegalExplicitNamespace kw
    277 277 
           -> mkSimpleDecorated $
    278 
    -           text "Illegal keyword 'type'"
    278 
    +           text "Illegal keyword" <+> quotes kw_doc
    279 
    +         where
    280 
    +           kw_doc = case kw of
    281 
    +             ExplicitTypeNamespace{} -> text "type"
    282 
    +             ExplicitDataNamespace{} -> text "data"
    283 
    +
    279 284
    280 285 
         PsErrUnallowedPragma prag
    281 286 
           -> mkSimpleDecorated $
    ... ... @@ -619,7 +624,7 @@ instance Diagnostic PsMessage where
    619 624 
         PsErrNoSingleWhereBindInPatSynDecl{}          -> ErrorWithoutFlag
    620 625 
         PsErrDeclSpliceNotAtTopLevel{}                -> ErrorWithoutFlag
    621 626 
         PsErrMultipleNamesInStandaloneKindSignature{} -> ErrorWithoutFlag
    622 
    -    PsErrIllegalExplicitNamespace                 -> ErrorWithoutFlag
    627 
    +    PsErrIllegalExplicitNamespace{}               -> ErrorWithoutFlag
    623 628 
         PsErrUnallowedPragma{}                        -> ErrorWithoutFlag
    624 629 
         PsErrImportPostQualified                      -> ErrorWithoutFlag
    625 630 
         PsErrImportQualifiedTwice                     -> ErrorWithoutFlag
    ... ... @@ -759,7 +764,7 @@ instance Diagnostic PsMessage where
    759 764 
         PsErrNoSingleWhereBindInPatSynDecl{}          -> noHints
    760 765 
         PsErrDeclSpliceNotAtTopLevel{}                -> noHints
    761 766 
         PsErrMultipleNamesInStandaloneKindSignature{} -> noHints
    762 
    -    PsErrIllegalExplicitNamespace                 -> [suggestExtension LangExt.ExplicitNamespaces]
    767 
    +    PsErrIllegalExplicitNamespace{}               -> [suggestExtension LangExt.ExplicitNamespaces]
    763 768 
         PsErrUnallowedPragma{}                        -> noHints
    764 769 
         PsErrImportPostQualified                      -> [suggestExtension LangExt.ImportQualifiedPost]
    765 770 
         PsErrImportQualifiedTwice                     -> noHints

  • compiler/GHC/Parser/Errors/Types.hs
    ... ... @@ -214,7 +214,7 @@ data PsMessage
    214 214 
        | PsErrImportPostQualified
    215 215
    216 216 
        -- | Explicit namespace keyword without 'ExplicitNamespaces'
    217 
    -   | PsErrIllegalExplicitNamespace
    217 
    +   | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword
    218 218
    219 219 
        -- | Expecting a type constructor but found a variable
    220 220 
        | PsErrVarForTyCon !RdrName

  • compiler/GHC/Parser/PostProcess.hs
    ... ... @@ -79,6 +79,7 @@ module GHC.Parser.PostProcess (
    79 79 
             ImpExpSubSpec(..),
    80 80 
             ImpExpQcSpec(..),
    81 81 
             mkModuleImpExp,
    82 
    +        mkPlainImpExp,
    82 83 
             mkTypeImpExp,
    83 84 
             mkDataImpExp,
    84 85 
             mkImpExpSubSpec,
    ... ... @@ -3241,9 +3242,7 @@ data ImpExpSubSpec = ImpExpAbs
    3241 3242 
                        | ImpExpList [LocatedA ImpExpQcSpec]
    3242 3243 
                        | ImpExpAllWith [LocatedA ImpExpQcSpec]
    3243 3244
    3244 
    -data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
    3245 
    -                  | ImpExpQcType (EpToken "type") (LocatedN RdrName)
    3246 
    -                  | ImpExpQcData (EpToken "data") (LocatedN RdrName)
    3245 
    +data ImpExpQcSpec = ImpExpQcName (Maybe ExplicitNamespaceKeyword) (LocatedN RdrName)
    3247 3246 
                       | ImpExpQcWildcard (EpToken "..") (EpToken ",")
    3248 3247
    3249 3248 
     mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec
    ... ... @@ -3287,30 +3286,37 @@ mkModuleImpExp warning (top, tcp) (L l specname) subs = do
    3287 3286 
                    (PsErrVarForTyCon name)
    3288 3287 
             else return $ ieNameFromSpec specname
    3289 3288
    3290 
    -    ieNameVal (ImpExpQcName ln)   = unLoc ln
    3291 
    -    ieNameVal (ImpExpQcType _ ln) = unLoc ln
    3292 
    -    ieNameVal (ImpExpQcData _ ln) = unLoc ln
    3289 
    +    ieNameVal (ImpExpQcName _ ln) = unLoc ln
    3293 3290 
         ieNameVal ImpExpQcWildcard{}  = panic "ieNameVal got wildcard"
    3294 3291
    3295 3292 
         ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs
    3296 
    -    ieNameFromSpec (ImpExpQcName   (L l n)) = IEName noExtField (L l n)
    3297 
    -    ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n)
    3298 
    -    ieNameFromSpec (ImpExpQcData r (L l n)) = IEData r (L l n)
    3299 
    -    ieNameFromSpec ImpExpQcWildcard{}       = panic "ieName got wildcard"
    3293 
    +    ieNameFromSpec (ImpExpQcName m_kw name) = case m_kw of
    3294 
    +        Nothing                          -> IEName noExtField name
    3295 
    +        Just (ExplicitTypeNamespace tok) -> IEType tok name
    3296 
    +        Just (ExplicitDataNamespace tok) -> IEData tok name
    3297 
    +    ieNameFromSpec ImpExpQcWildcard{} = panic "ieNameFromSpec got wildcard"
    3300 3298
    3301 3299 
         wrapped = map (fmap ieNameFromSpec)
    3302 3300
    3303 
    -mkTypeImpExp :: LocatedN RdrName   -- TcCls or Var name space
    3304 
    -             -> P (LocatedN RdrName)
    3305 
    -mkTypeImpExp name =
    3306 
    -  do requireExplicitNamespaces (getLocA name)
    3307 
    -     return (fmap (`setRdrNameSpace` tcClsName) name)
    3301 
    +mkPlainImpExp :: LocatedN RdrName -> ImpExpQcSpec
    3302 
    +mkPlainImpExp name = ImpExpQcName Nothing name
    3308 3303
    3309 
    -mkDataImpExp :: LocatedN RdrName
    3310 
    -             -> P (LocatedN RdrName)
    3311 
    -mkDataImpExp name =
    3312 
    -  do requireExplicitNamespaces (getLocA name)
    3313 
    -     return name
    3304 
    +mkTypeImpExp :: EpToken "type"
    3305 
    +             -> LocatedN RdrName   -- TcCls or Var name space
    3306 
    +             -> P ImpExpQcSpec
    3307 
    +mkTypeImpExp tok name = do
    3308 
    +  let name' = fmap (`setRdrNameSpace` tcClsName) name
    3309 
    +      ns_kw = ExplicitTypeNamespace tok
    3310 
    +  requireExplicitNamespaces ns_kw
    3311 
    +  return (ImpExpQcName (Just ns_kw) name')
    3312 
    +
    3313 
    +mkDataImpExp :: EpToken "data"
    3314 
    +             -> LocatedN RdrName
    3315 
    +             -> P ImpExpQcSpec
    3316 
    +mkDataImpExp tok name = do
    3317 
    +  let ns_kw = ExplicitDataNamespace tok
    3318 
    +  requireExplicitNamespaces ns_kw
    3319 
    +  return (ImpExpQcName (Just ns_kw) name)
    3314 3320
    3315 3321 
     checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs])
    3316 3322 
     checkImportSpec ie@(L _ specs) =
    ... ... @@ -3368,11 +3374,15 @@ failOpFewArgs (L loc op) =
    3368 3374 
          ; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
    3369 3375 
              (PsErrOpFewArgs is_star_type op) }
    3370 3376
    3371 
    -requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
    3372 
    -requireExplicitNamespaces l = do
    3377 
    +requireExplicitNamespaces :: MonadP m => ExplicitNamespaceKeyword -> m ()
    3378 
    +requireExplicitNamespaces kw = do
    3373 3379 
       allowed <- getBit ExplicitNamespacesBit
    3374 3380 
       unless allowed $
    3375 
    -    addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace
    3381 
    +    addError $ mkPlainErrorMsgEnvelope loc $ PsErrIllegalExplicitNamespace kw
    3382 
    +  where
    3383 
    +    loc = case kw of
    3384 
    +      ExplicitTypeNamespace tok -> getEpTokenSrcSpan tok
    3385 
    +      ExplicitDataNamespace tok -> getEpTokenSrcSpan tok
    3376 3386
    3377 3387 
     warnPatternNamespaceSpecifier :: MonadP m => SrcSpan -> m ()
    3378 3388 
     warnPatternNamespaceSpecifier l = do

  • compiler/GHC/Parser/Types.hs
    ... ... @@ -8,6 +8,7 @@ module GHC.Parser.Types
    8 8 
        , pprSumOrTuple
    9 9 
        , PatBuilder(..)
    10 10 
        , DataConBuilder(..)
    11 
    +   , ExplicitNamespaceKeyword(..)
    11 12 
        )
    12 13 
     where
    13 14
    ... ... @@ -111,3 +112,7 @@ instance Outputable DataConBuilder where
    111 112 
         ppr lhs <+> ppr data_con <+> ppr rhs
    112 113
    113 114 
     type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW
    115 
    +
    116 
    +data ExplicitNamespaceKeyword
    117 
    +  = ExplicitTypeNamespace !(EpToken "type")
    118 
    +  | ExplicitDataNamespace !(EpToken "data")
    \ No newline at end of file

  • compiler/GHC/Utils/Binary.hs
    ... ... @@ -1965,6 +1965,13 @@ instance (Binary v) => Binary (IntMap v) where
    1965 1965 
       put_ bh m = put_ bh (IntMap.toAscList m)
    1966 1966 
       get bh = IntMap.fromAscList <$> get bh
    1967 1967
    1968 
    +instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
    1969 
    +  put_ bh m = put_ bh $ Map.toList m
    1970 
    +  -- Unfortunately, we can't use fromAscList, since k is often
    1971 
    +  -- instantiated to Name which has a non-deterministic Ord instance
    1972 
    +  -- that only compares the Uniques, and the Uniques are likely
    1973 
    +  -- changed when deserializing!
    1974 
    +  get bh = Map.fromList <$> get bh
    1968 1975
    1969 1976 
     {- Note [FingerprintWithValue]
    1970 1977 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  • testsuite/tests/ghci-wasm/Makefile
    1 
    +TOP=../..
    2 
    +include $(TOP)/mk/boilerplate.mk
    3 
    +include $(TOP)/mk/test.mk
    4 
    +
    5 
    +T26430_setup :
    6 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -shared T26430A.c -o libT26430A.so
    7 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -shared -L. -lT26430A T26430B.c -o libT26430B.so

  • testsuite/tests/ghci-wasm/T26430.hs
    1 
    +foreign import ccall unsafe "baz" main :: IO ()

  • testsuite/tests/ghci-wasm/T26430A.c
    1 
    +void foo(void);
    2 
    +
    3 
    +void bar(void (*)(void));
    4 
    +
    5 
    +__attribute__((export_name("baz"))) void baz(void) { bar(foo); }

  • testsuite/tests/ghci-wasm/T26430B.c
    1 
    +__attribute__((export_name("foo"))) void foo(void) {}
    2 
    +
    3 
    +__attribute__((export_name("bar"))) void bar(void (*f)(void)) { f(); }

  • testsuite/tests/ghci-wasm/all.T
    1 
    +setTestOpts([
    2 
    +  unless(arch('wasm32'), skip),
    3 
    +  only_ways(['ghci', 'ghci-opt']),
    4 
    +  extra_ways(['ghci', 'ghci-opt'])
    5 
    +])
    6 
    +
    7 
    +test('T26430', [
    8 
    +  extra_files(['T26430A.c', 'T26430B.c']),
    9 
    +  pre_cmd('$MAKE -s --no-print-directory T26430_setup ghciWayFlags=' + config.ghci_way_flags),
    10 
    +  extra_hc_opts('-L. -lT26430B')]
    11 
    +, compile_and_run, ['']
    12 
    +)

  • testsuite/tests/parser/should_fail/T16270h.stderr
    1 
    -
    2 
    -T16270h.hs:8:22: error: [GHC-47007]
    3 
    -    Illegal keyword 'type'
    1 
    +T16270h.hs:8:17: error: [GHC-47007]
    2 
    +    Illegal keyword ‘type’
    4 3 
         Suggested fix:
    5 4 
           Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
    6 5
    ... ... @@ -11,3 +10,4 @@ T16270h.hs:10:8: error: [GHC-21926]
    11 10 
     T16270h.hs:11:8: error: [GHC-21926]
    12 11 
         Parse error: ‘pkg!’
    13 12 
         Version number or non-alphanumeric character in package name
    13 
    +

  • testsuite/tests/parser/should_fail/T26418.hs
    1 
    +{-# LANGUAGE PatternSynonyms #-}
    2 
    +{-# LANGUAGE NoExplicitNamespaces #-}
    3 
    +
    4 
    +module T26418 (data HeadC) where
    5 
    +
    6 
    +pattern HeadC :: forall a. a -> [a]
    7 
    +pattern HeadC x <- x:_xs where
    8 
    +  HeadC x = [x]
    9 
    +

  • testsuite/tests/parser/should_fail/T26418.stderr
    1 
    +T26418.hs:4:16: error: [GHC-47007]
    2 
    +    Illegal keyword ‘data’
    3 
    +    Suggested fix:
    4 
    +      Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
    5 
    +

  • testsuite/tests/parser/should_fail/all.T
    ... ... @@ -241,3 +241,4 @@ test('T25258a', normal, compile_fail, [''])
    241 241 
     test('T25258b', normal, compile_fail, [''])
    242 242 
     test('T25258c', normal, compile_fail, [''])
    243 243 
     test('T25530', normal, compile_fail, [''])
    244 
    +test('T26418', normal, compile_fail, [''])

  • utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
    ... ... @@ -40,7 +40,6 @@ import Data.Coerce (coerce)
    40 40 
     import Data.Function ((&))
    41 41 
     import Data.IORef
    42 42 
     import Data.Map (Map)
    43 
    -import qualified Data.Map as Map
    44 43 
     import Data.Version
    45 44 
     import Data.Word
    46 45 
     import GHC hiding (NoLink)
    ... ... @@ -316,10 +315,6 @@ data BinDictionary = BinDictionary
    316 315
    317 316 
     -------------------------------------------------------------------------------
    318 317
    319 
    -instance (Ord k, Binary k, Binary v) => Binary (Map k v) where
    320 
    -  put_ bh m = put_ bh (Map.toList m)
    321 
    -  get bh = fmap (Map.fromList) (get bh)
    322 
    -
    323 318 
     instance Binary PackageInfo where
    324 319 
       put_ bh PackageInfo{piPackageName, piPackageVersion} = do
    325 320 
         put_ bh (unPackageName piPackageName)

  • utils/jsffi/dyld.mjs
    ... ... @@ -1013,10 +1013,13 @@ class DyLD {
    1013 1013 
               // anything, if it's required later a GOT.func entry will be
    1014 1014 
               // created on demand.
    1015 1015 
               if (this.#gotFunc[k]) {
    1016 
    -            // ghc-prim/ghc-internal may export functions imported by
    1017 
    -            // rts
    1018 
    -            console.assert(this.#gotFunc[k].value === DyLD.#poison);
    1019 
    -            this.#table.set(this.#gotFunc[k].value, v);
    1016 
    +            const got = this.#gotFunc[k];
    1017 
    +            if (got.value === DyLD.#poison) {
    1018 
    +              const idx = this.#table.grow(1, v);
    1019 
    +              got.value = idx;
    1020 
    +            } else {
    1021 
    +              this.#table.set(got.value, v);
    1022 
    +            }
    1020 1023 
               }
    1021 1024 
               continue;
    1022 1025 
             }

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