Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 51eef642 by Cheng Shao at 2025-09-20T00:07:29-04:00 compiler: move Binary instance of Map to GHC.Utils.Binary This patch moves `Binary` instance of `Map` from `haddock-api` to `GHC.Utils.Binary`. This also allows us to remove a redundant instance defined for `NameEntityInfo`, which is a type synonym for `Map`. - - - - - 347d2364 by Vladislav Zavialov at 2025-09-20T00:07:31-04:00 Fix keyword in ExplicitNamespaces error message (#26418) Consider this module header and the resulting error: {-# LANGUAGE NoExplicitNamespaces #-} module T26418 (data HeadC) where -- error: [GHC-47007] -- Illegal keyword 'type' Previously, the error message would mention 'type' (as shown above), even though the user wrote 'data'. This has now been fixed. The error location has also been corrected: it is now reported at the keyword position rather than at the position of the associated import/export item. - - - - - b5acbab6 by Cheng Shao at 2025-09-20T00:07:31-04:00 wasm: fix dyld handling for forward declared GOT.func items This patch fixes wasm shared linker's handling of forward declared GOT.func items, see linked issue for details. Also adds T26430 test to witness the fix. Fixes #26430. Co-authored-by: Codex - - - - - 18 changed files: - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Utils/Binary.hs - + testsuite/tests/ghci-wasm/Makefile - + testsuite/tests/ghci-wasm/T26430.hs - + testsuite/tests/ghci-wasm/T26430A.c - + testsuite/tests/ghci-wasm/T26430B.c - + testsuite/tests/ghci-wasm/all.T - testsuite/tests/parser/should_fail/T16270h.stderr - + testsuite/tests/parser/should_fail/T26418.hs - + testsuite/tests/parser/should_fail/T26418.stderr - testsuite/tests/parser/should_fail/all.T - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/jsffi/dyld.mjs Changes: ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -96,10 +96,6 @@ data HieFile = HieFile type NameEntityInfo = M.Map Name (S.Set EntityInfo) -instance Binary NameEntityInfo where - put_ bh m = put_ bh $ M.toList m - get bh = fmap M.fromList (get bh) - instance Binary HieFile where put_ bh hf = do put_ bh $ hie_hs_file hf ===================================== compiler/GHC/Parser.y ===================================== @@ -1078,11 +1078,11 @@ qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec } | '..' { sL1a $1 (ImpExpQcWildcard (epTok $1) NoEpTok) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { sL1a $1 (ImpExpQcName $1) } - | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }} - | 'data' qvarcon {% do { n <- mkDataImpExp $2 - ; return $ sLLa $1 $> (ImpExpQcData (epTok $1) n) }} + : qcname { sL1a $1 (mkPlainImpExp $1) } + | 'type' oqtycon {% do { imp_exp <- mkTypeImpExp (epTok $1) $2 + ; return $ sLLa $1 $> imp_exp }} + | 'data' qvarcon {% do { imp_exp <- mkDataImpExp (epTok $1) $2 + ; return $ sLLa $1 $> imp_exp }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions ===================================== compiler/GHC/Parser/Errors/Ppr.hs ===================================== @@ -273,9 +273,14 @@ instance Diagnostic PsMessage where 2 (pprWithCommas ppr vs) , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details." ] - PsErrIllegalExplicitNamespace + PsErrIllegalExplicitNamespace kw -> mkSimpleDecorated $ - text "Illegal keyword 'type'" + text "Illegal keyword" <+> quotes kw_doc + where + kw_doc = case kw of + ExplicitTypeNamespace{} -> text "type" + ExplicitDataNamespace{} -> text "data" + PsErrUnallowedPragma prag -> mkSimpleDecorated $ @@ -619,7 +624,7 @@ instance Diagnostic PsMessage where PsErrNoSingleWhereBindInPatSynDecl{} -> ErrorWithoutFlag PsErrDeclSpliceNotAtTopLevel{} -> ErrorWithoutFlag PsErrMultipleNamesInStandaloneKindSignature{} -> ErrorWithoutFlag - PsErrIllegalExplicitNamespace -> ErrorWithoutFlag + PsErrIllegalExplicitNamespace{} -> ErrorWithoutFlag PsErrUnallowedPragma{} -> ErrorWithoutFlag PsErrImportPostQualified -> ErrorWithoutFlag PsErrImportQualifiedTwice -> ErrorWithoutFlag @@ -759,7 +764,7 @@ instance Diagnostic PsMessage where PsErrNoSingleWhereBindInPatSynDecl{} -> noHints PsErrDeclSpliceNotAtTopLevel{} -> noHints PsErrMultipleNamesInStandaloneKindSignature{} -> noHints - PsErrIllegalExplicitNamespace -> [suggestExtension LangExt.ExplicitNamespaces] + PsErrIllegalExplicitNamespace{} -> [suggestExtension LangExt.ExplicitNamespaces] PsErrUnallowedPragma{} -> noHints PsErrImportPostQualified -> [suggestExtension LangExt.ImportQualifiedPost] PsErrImportQualifiedTwice -> noHints ===================================== compiler/GHC/Parser/Errors/Types.hs ===================================== @@ -214,7 +214,7 @@ data PsMessage | PsErrImportPostQualified -- | Explicit namespace keyword without 'ExplicitNamespaces' - | PsErrIllegalExplicitNamespace + | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword -- | Expecting a type constructor but found a variable | PsErrVarForTyCon !RdrName ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -79,6 +79,7 @@ module GHC.Parser.PostProcess ( ImpExpSubSpec(..), ImpExpQcSpec(..), mkModuleImpExp, + mkPlainImpExp, mkTypeImpExp, mkDataImpExp, mkImpExpSubSpec, @@ -3241,9 +3242,7 @@ data ImpExpSubSpec = ImpExpAbs | ImpExpList [LocatedA ImpExpQcSpec] | ImpExpAllWith [LocatedA ImpExpQcSpec] -data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName) - | ImpExpQcType (EpToken "type") (LocatedN RdrName) - | ImpExpQcData (EpToken "data") (LocatedN RdrName) +data ImpExpQcSpec = ImpExpQcName (Maybe ExplicitNamespaceKeyword) (LocatedN RdrName) | ImpExpQcWildcard (EpToken "..") (EpToken ",") mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec @@ -3287,30 +3286,37 @@ mkModuleImpExp warning (top, tcp) (L l specname) subs = do (PsErrVarForTyCon name) else return $ ieNameFromSpec specname - ieNameVal (ImpExpQcName ln) = unLoc ln - ieNameVal (ImpExpQcType _ ln) = unLoc ln - ieNameVal (ImpExpQcData _ ln) = unLoc ln + ieNameVal (ImpExpQcName _ ln) = unLoc ln ieNameVal ImpExpQcWildcard{} = panic "ieNameVal got wildcard" ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs - ieNameFromSpec (ImpExpQcName (L l n)) = IEName noExtField (L l n) - ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n) - ieNameFromSpec (ImpExpQcData r (L l n)) = IEData r (L l n) - ieNameFromSpec ImpExpQcWildcard{} = panic "ieName got wildcard" + ieNameFromSpec (ImpExpQcName m_kw name) = case m_kw of + Nothing -> IEName noExtField name + Just (ExplicitTypeNamespace tok) -> IEType tok name + Just (ExplicitDataNamespace tok) -> IEData tok name + ieNameFromSpec ImpExpQcWildcard{} = panic "ieNameFromSpec got wildcard" wrapped = map (fmap ieNameFromSpec) -mkTypeImpExp :: LocatedN RdrName -- TcCls or Var name space - -> P (LocatedN RdrName) -mkTypeImpExp name = - do requireExplicitNamespaces (getLocA name) - return (fmap (`setRdrNameSpace` tcClsName) name) +mkPlainImpExp :: LocatedN RdrName -> ImpExpQcSpec +mkPlainImpExp name = ImpExpQcName Nothing name -mkDataImpExp :: LocatedN RdrName - -> P (LocatedN RdrName) -mkDataImpExp name = - do requireExplicitNamespaces (getLocA name) - return name +mkTypeImpExp :: EpToken "type" + -> LocatedN RdrName -- TcCls or Var name space + -> P ImpExpQcSpec +mkTypeImpExp tok name = do + let name' = fmap (`setRdrNameSpace` tcClsName) name + ns_kw = ExplicitTypeNamespace tok + requireExplicitNamespaces ns_kw + return (ImpExpQcName (Just ns_kw) name') + +mkDataImpExp :: EpToken "data" + -> LocatedN RdrName + -> P ImpExpQcSpec +mkDataImpExp tok name = do + let ns_kw = ExplicitDataNamespace tok + requireExplicitNamespaces ns_kw + return (ImpExpQcName (Just ns_kw) name) checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs]) checkImportSpec ie@(L _ specs) = @@ -3368,11 +3374,15 @@ failOpFewArgs (L loc op) = ; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrOpFewArgs is_star_type op) } -requireExplicitNamespaces :: MonadP m => SrcSpan -> m () -requireExplicitNamespaces l = do +requireExplicitNamespaces :: MonadP m => ExplicitNamespaceKeyword -> m () +requireExplicitNamespaces kw = do allowed <- getBit ExplicitNamespacesBit unless allowed $ - addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace + addError $ mkPlainErrorMsgEnvelope loc $ PsErrIllegalExplicitNamespace kw + where + loc = case kw of + ExplicitTypeNamespace tok -> getEpTokenSrcSpan tok + ExplicitDataNamespace tok -> getEpTokenSrcSpan tok warnPatternNamespaceSpecifier :: MonadP m => SrcSpan -> m () warnPatternNamespaceSpecifier l = do ===================================== compiler/GHC/Parser/Types.hs ===================================== @@ -8,6 +8,7 @@ module GHC.Parser.Types , pprSumOrTuple , PatBuilder(..) , DataConBuilder(..) + , ExplicitNamespaceKeyword(..) ) where @@ -111,3 +112,7 @@ instance Outputable DataConBuilder where ppr lhs <+> ppr data_con <+> ppr rhs type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW + +data ExplicitNamespaceKeyword + = ExplicitTypeNamespace !(EpToken "type") + | 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 put_ bh m = put_ bh (IntMap.toAscList m) get bh = IntMap.fromAscList <$> get bh +instance (Ord k, Binary k, Binary v) => Binary (Map k v) where + put_ bh m = put_ bh $ Map.toList m + -- Unfortunately, we can't use fromAscList, since k is often + -- instantiated to Name which has a non-deterministic Ord instance + -- that only compares the Uniques, and the Uniques are likely + -- changed when deserializing! + get bh = Map.fromList <$> get bh {- Note [FingerprintWithValue] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/ghci-wasm/Makefile ===================================== @@ -0,0 +1,7 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T26430_setup : + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -shared T26430A.c -o libT26430A.so + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -shared -L. -lT26430A T26430B.c -o libT26430B.so ===================================== testsuite/tests/ghci-wasm/T26430.hs ===================================== @@ -0,0 +1 @@ +foreign import ccall unsafe "baz" main :: IO () ===================================== testsuite/tests/ghci-wasm/T26430A.c ===================================== @@ -0,0 +1,5 @@ +void foo(void); + +void bar(void (*)(void)); + +__attribute__((export_name("baz"))) void baz(void) { bar(foo); } ===================================== testsuite/tests/ghci-wasm/T26430B.c ===================================== @@ -0,0 +1,3 @@ +__attribute__((export_name("foo"))) void foo(void) {} + +__attribute__((export_name("bar"))) void bar(void (*f)(void)) { f(); } ===================================== testsuite/tests/ghci-wasm/all.T ===================================== @@ -0,0 +1,12 @@ +setTestOpts([ + unless(arch('wasm32'), skip), + only_ways(['ghci', 'ghci-opt']), + extra_ways(['ghci', 'ghci-opt']) +]) + +test('T26430', [ + extra_files(['T26430A.c', 'T26430B.c']), + pre_cmd('$MAKE -s --no-print-directory T26430_setup ghciWayFlags=' + config.ghci_way_flags), + extra_hc_opts('-L. -lT26430B')] +, compile_and_run, [''] +) ===================================== testsuite/tests/parser/should_fail/T16270h.stderr ===================================== @@ -1,6 +1,5 @@ - -T16270h.hs:8:22: error: [GHC-47007] - Illegal keyword 'type' +T16270h.hs:8:17: error: [GHC-47007] + Illegal keyword ‘type’ Suggested fix: Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’) @@ -11,3 +10,4 @@ T16270h.hs:10:8: error: [GHC-21926] T16270h.hs:11:8: error: [GHC-21926] Parse error: ‘pkg!’ Version number or non-alphanumeric character in package name + ===================================== testsuite/tests/parser/should_fail/T26418.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE NoExplicitNamespaces #-} + +module T26418 (data HeadC) where + +pattern HeadC :: forall a. a -> [a] +pattern HeadC x <- x:_xs where + HeadC x = [x] + ===================================== testsuite/tests/parser/should_fail/T26418.stderr ===================================== @@ -0,0 +1,5 @@ +T26418.hs:4:16: error: [GHC-47007] + Illegal keyword ‘data’ + Suggested fix: + Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’) + ===================================== testsuite/tests/parser/should_fail/all.T ===================================== @@ -241,3 +241,4 @@ test('T25258a', normal, compile_fail, ['']) test('T25258b', normal, compile_fail, ['']) test('T25258c', normal, compile_fail, ['']) test('T25530', normal, compile_fail, ['']) +test('T26418', normal, compile_fail, ['']) ===================================== utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs ===================================== @@ -40,7 +40,6 @@ import Data.Coerce (coerce) import Data.Function ((&)) import Data.IORef import Data.Map (Map) -import qualified Data.Map as Map import Data.Version import Data.Word import GHC hiding (NoLink) @@ -316,10 +315,6 @@ data BinDictionary = BinDictionary ------------------------------------------------------------------------------- -instance (Ord k, Binary k, Binary v) => Binary (Map k v) where - put_ bh m = put_ bh (Map.toList m) - get bh = fmap (Map.fromList) (get bh) - instance Binary PackageInfo where put_ bh PackageInfo{piPackageName, piPackageVersion} = do put_ bh (unPackageName piPackageName) ===================================== utils/jsffi/dyld.mjs ===================================== @@ -1013,10 +1013,13 @@ class DyLD { // anything, if it's required later a GOT.func entry will be // created on demand. if (this.#gotFunc[k]) { - // ghc-prim/ghc-internal may export functions imported by - // rts - console.assert(this.#gotFunc[k].value === DyLD.#poison); - this.#table.set(this.#gotFunc[k].value, v); + const got = this.#gotFunc[k]; + if (got.value === DyLD.#poison) { + const idx = this.#table.grow(1, v); + got.value = idx; + } else { + this.#table.set(got.value, v); + } } continue; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88f159e2cc4d4703dd89561bd95dd84... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88f159e2cc4d4703dd89561bd95dd84... You're receiving this email because of your account on gitlab.haskell.org.