March 2026 - ghc-commits

[Git][ghc/ghc] Pushed new branch wip/fix-head
by Cheng Shao (＠TerrorJack) 02 Mar '26

02 Mar '26

Cheng Shao pushed new branch wip/fix-head at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-head You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/andreask/div_test
by Andreas Klebinger (＠AndreasK) 02 Mar '26

02 Mar '26

Andreas Klebinger pushed new branch wip/andreask/div_test at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/div_test You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fix-26971] Adding WIP decoupling of L.H.S and GHC.Hs.Doc
by recursion-ninja (＠recursion-ninja) 02 Mar '26

02 Mar '26

recursion-ninja pushed to branch wip/fix-26971 at Glasgow Haskell Compiler / GHC Commits: 273fba40 by Recursion Ninja at 2026-03-02T09:19:17-05:00 Adding WIP decoupling of L.H.S and GHC.Hs.Doc - - - - - 19 changed files: - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Doc.hs - − compiler/GHC/Hs/Doc.hs-boot - compiler/GHC/Hs/DocString.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Doc.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - + compiler/Language/Haskell/Syntax/UTF8.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Hs/Basic.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Prelude import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Types.Name -import GHC.Parser.Annotation +--import GHC.Parser.Annotation import GHC.Utils.Misc ((<||>)) import Data.Data (Data) @@ -86,8 +86,8 @@ instance Binary FixityDirection where -- @ data NamespaceSpecifier = NoNamespaceSpecifier - | TypeNamespaceSpecifier (EpToken "type") - | DataNamespaceSpecifier (EpToken "data") + | TypeNamespaceSpecifier () -- (EpToken "type") + | DataNamespaceSpecifier () --(EpToken "data") deriving (Eq, Data) -- | Check if namespace specifiers overlap, i.e. if they are equal or ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -32,6 +32,7 @@ import GHC.Data.EnumSet (EnumSet) import GHC.Types.Avail import GHC.Types.Name.Set import GHC.Driver.Flags +import GHC.Parser.Annotation import Control.DeepSeq import Data.Data @@ -49,29 +50,15 @@ import Data.Function import GHC.Hs.DocString +import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name --- | A docstring with the (probable) identifiers found in it. -type HsDoc = WithHsDocIdentifiers HsDocString +deriving instance Eq a => Eq (WithHsDocIdentifiers a GhcPs) +deriving instance Eq a => Eq (WithHsDocIdentifiers a GhcRn) +deriving instance Eq a => Eq (WithHsDocIdentifiers a GhcTc) --- | Annotate a value with the probable identifiers found in it --- These will be used by haddock to generate links. --- --- The identifiers are bundled along with their location in the source file. --- This is useful for tooling to know exactly where they originate. --- --- This type is currently used in two places - for regular documentation comments, --- with 'a' set to 'HsDocString', and for adding identifier information to --- warnings, where 'a' is 'StringLiteral' -data WithHsDocIdentifiers a pass = WithHsDocIdentifiers - { hsDocString :: !a - , hsDocIdentifiers :: ![Located (IdP pass)] - } - -deriving instance (Data pass, Data (IdP pass), Data a) => Data (WithHsDocIdentifiers a pass) -deriving instance (Eq (IdP pass), Eq a) => Eq (WithHsDocIdentifiers a pass) -instance (NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where +instance (NFData (LIdP (GhcPass pass)), NFData a) => NFData (WithHsDocIdentifiers a (GhcPass pass)) where rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf i -- | For compatibility with the existing @-ddump-parsed' output, we only show @@ -81,12 +68,26 @@ instance (NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) w instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where ppr (WithHsDocIdentifiers s _ids) = ppr s -instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where +{- +instance forall a . (Binary a, Binary (Anno Name)) => Binary (WithHsDocIdentifiers a (GhcRn)) where put_ bh (WithHsDocIdentifiers s ids) = do put_ bh s - put_ bh $ BinLocated <$> (sortBy (stableNameCmp `on` getName) ids) + put_ bh $ BinGenLocated <$> ids +-- put_ bh ids get bh = - liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh) + liftA2 (WithHsDocIdentifiers :: a -> [LIdP (GhcPass p)] -> WithHsDocIdentifiers a (GhcPass p)) (get bh) (fmap unBinGenLocated <$> get bh) +-} +{- +ids = [GenLocated (Anno Name) Name] + = [GenLocated (SrcSpanAnnN) Name] + = [GenLocated (EpAnn NameAnn) Name] + + +[LIdP GhcRn] = [XRec GhcRn (IdP GhcRn)] + = [XRec GhcRn (IdGhcP 'Renamed)] + = [XRec GhcRn Name] +-} + -- | Extract a mapping from the lexed identifiers to the names they may -- correspond to. @@ -98,22 +99,21 @@ hsDocIds (WithHsDocIdentifiers _ ids) = mkNameSet $ map unLoc ids -- and will come either before or after depending on how it was written -- i.e it will come after the thing if it is a '-- ^' or '{-^' and before -- otherwise. -pprWithDoc :: LHsDoc name -> SDoc -> SDoc +pprWithDoc :: LHsDoc (GhcPass name) -> SDoc -> SDoc pprWithDoc doc = pprWithDocString (hsDocString $ unLoc doc) -- | See 'pprWithHsDoc' -pprMaybeWithDoc :: Maybe (LHsDoc name) -> SDoc -> SDoc +pprMaybeWithDoc :: Maybe (LHsDoc (GhcPass name)) -> SDoc -> SDoc pprMaybeWithDoc Nothing = id pprMaybeWithDoc (Just doc) = pprWithDoc doc -- | Print a doc with its identifiers, useful for debugging -pprHsDocDebug :: (Outputable (IdP name)) => HsDoc name -> SDoc +pprHsDocDebug :: HsDoc (GhcPass name) -> SDoc pprHsDocDebug (WithHsDocIdentifiers s ids) = vcat [ text "text:" $$ nest 2 (pprHsDocString s) - , text "identifiers:" $$ nest 2 (vcat (map pprLocatedAlways ids)) +-- , text "identifiers:" $$ nest 2 (vcat (map pprLocatedAlways ids)) ] - -type LHsDoc pass = Located (HsDoc pass) +-- XRec p (IdP p) -- | A simplified version of 'HsImpExp.IE'. data DocStructureItem @@ -136,6 +136,7 @@ data DocStructureItem -- ^ Invariant: This list of Avails must be sorted -- to guarantee interface file determinism. +{- instance Binary DocStructureItem where put_ bh = \case DsiSectionHeading level doc -> do @@ -165,6 +166,7 @@ instance Binary DocStructureItem where 3 -> DsiExports <$> get bh 4 -> DsiModExport <$> get bh <*> get bh _ -> fail "instance Binary DocStructureItem: Invalid tag" +-} instance Outputable DocStructureItem where ppr = \case @@ -185,8 +187,8 @@ instance Outputable DocStructureItem where instance NFData DocStructureItem where rnf = \case - DsiSectionHeading level doc -> rnf level `seq` rnf doc - DsiDocChunk doc -> rnf doc + DsiSectionHeading level !doc -> rnf level -- `seq` rnf doc + DsiDocChunk !doc -> () -- rnf doc DsiNamedChunkRef name -> rnf name DsiExports avails -> rnf avails DsiModExport mod_names avails -> rnf mod_names `seq` rnf avails @@ -220,10 +222,16 @@ data Docs = Docs instance NFData Docs where rnf (Docs mod_hdr exps decls args structure named_chunks haddock_opts language extentions) +{- = rnf mod_hdr `seq` rnf exps `seq` rnf decls `seq` rnf args `seq` rnf structure `seq` rnf named_chunks `seq` rnf haddock_opts `seq` rnf language `seq` rnf extentions `seq` () +-} + = rnf structure + `seq` rnf haddock_opts `seq` rnf language `seq` rnf extentions + `seq` () +{- instance Binary Docs where put_ bh docs = do put_ bh (docs_mod_hdr docs) @@ -255,6 +263,7 @@ instance Binary Docs where , docs_language = language , docs_extensions = exts } +-} instance Outputable Docs where ppr docs = ===================================== compiler/GHC/Hs/Doc.hs-boot deleted ===================================== @@ -1,18 +0,0 @@ -module GHC.Hs.Doc where - --- See #21592 for progress on removing this boot file. - -import GHC.Types.SrcLoc -import GHC.Hs.DocString -import Data.Kind - -type role WithHsDocIdentifiers representational nominal -type WithHsDocIdentifiers :: Type -> Type -> Type -data WithHsDocIdentifiers a pass - -type HsDoc :: Type -> Type -type HsDoc = WithHsDocIdentifiers HsDocString - -type LHsDoc :: Type -> Type -type LHsDoc pass = Located (HsDoc pass) - ===================================== compiler/GHC/Hs/DocString.hs ===================================== @@ -1,8 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + -- | An exactprintable structure for docstrings module GHC.Hs.DocString ( LHsDocString , HsDocString(..) + , HsDocStringGhc , HsDocStringDecorator(..) , HsDocStringChunk(..) , LHsDocStringChunk @@ -23,6 +26,8 @@ module GHC.Hs.DocString import GHC.Prelude +import GHC.Hs.Extension + import GHC.Utils.Binary import GHC.Utils.Encoding import GHC.Utils.Outputable as Outputable hiding ((<>)) @@ -34,9 +39,16 @@ import qualified Data.ByteString as BS import Data.Data import Data.List.NonEmpty (NonEmpty(..)) import Data.List (intercalate) +import Data.Void + +import Language.Haskell.Syntax.Doc +import Language.Haskell.Syntax.Extension + +type LHsDocString pass = Located (HsDocString pass) -type LHsDocString = Located HsDocString +type HsDocStringGhc = HsDocString Void +{- -- | Haskell Documentation String -- -- Rich structure to support exact printing @@ -56,62 +68,81 @@ data HsDocString -- This is because it may contain unbalanced pairs of '{-' and '-}' and -- not form a valid 'NestedDocString' deriving (Eq, Data, Show) +-} -instance Outputable HsDocString where - ppr = text . renderHsDocString +type instance XMultiLineDocString (GhcPass p) = NoExtField +type instance XNestedDocString (GhcPass p) = NoExtField +type instance XGeneratedDocString (GhcPass p) = NoExtField +type instance XXHsDocString (GhcPass p) = DataConCantHappen +{- instance NFData HsDocString where rnf (MultiLineDocString a b) = rnf a `seq` rnf b rnf (NestedDocString a b) = rnf a `seq` rnf b rnf (GeneratedDocString a) = rnf a +-} +deriving stock instance Eq (HsDocString (GhcPass pass)) +-- deriving stock instance Show (HsDocString (GhcPass pass)) --- | Annotate a pretty printed thing with its doc --- The docstring comes after if is 'HsDocStringPrevious' --- Otherwise it comes before. --- Note - we convert MultiLineDocString HsDocStringPrevious to HsDocStringNext --- because we can't control if something else will be pretty printed on the same line -pprWithDocString :: HsDocString -> SDoc -> SDoc -pprWithDocString (MultiLineDocString HsDocStringPrevious ds) sd = pprWithDocString (MultiLineDocString HsDocStringNext ds) sd -pprWithDocString doc@(NestedDocString HsDocStringPrevious _) sd = sd <+> pprHsDocString doc -pprWithDocString doc sd = pprHsDocString doc $+$ sd - - -instance Binary HsDocString where +instance Binary (HsDocString (GhcPass p)) where put_ bh x = case x of - MultiLineDocString dec xs -> do + MultiLineDocString _ dec xs -> do putByte bh 0 put_ bh dec put_ bh $ BinLocated <$> xs - NestedDocString dec x -> do + NestedDocString _ dec x -> do putByte bh 1 put_ bh dec put_ bh $ BinLocated x - GeneratedDocString x -> do + GeneratedDocString _ x -> do putByte bh 2 put_ bh x get bh = do tag <- getByte bh case tag of - 0 -> MultiLineDocString <$> get bh <*> (fmap unBinLocated <$> get bh) - 1 -> NestedDocString <$> get bh <*> (unBinLocated <$> get bh) - 2 -> GeneratedDocString <$> get bh + 0 -> MultiLineDocString NoExtField <$> get bh <*> (fmap unBinLocated <$> get bh) + 1 -> NestedDocString NoExtField <$> get bh <*> (unBinLocated <$> get bh) + 2 -> GeneratedDocString NoExtField <$> get bh t -> fail $ "HsDocString: invalid tag " ++ show t +instance NFData (HsDocString (GhcPass pass)) where + rnf = \case + MultiLineDocString NoExtField a b -> rnf a `seq` rnf b + NestedDocString NoExtField a b -> rnf a `seq` rnf b + GeneratedDocString NoExtField a -> rnf a + +instance Outputable (HsDocString (GhcPass p)) where + ppr = text . renderHsDocString + +-- | Annotate a pretty printed thing with its doc +-- The docstring comes after if is 'HsDocStringPrevious' +-- Otherwise it comes before. +-- Note - we convert MultiLineDocString HsDocStringPrevious to HsDocStringNext +-- because we can't control if something else will be pretty printed on the same line +pprWithDocString :: HsDocString (GhcPass p) -> SDoc -> SDoc +pprWithDocString (MultiLineDocString x HsDocStringPrevious ds) sd = pprWithDocString (MultiLineDocString x HsDocStringNext ds) sd +pprWithDocString doc@(NestedDocString _ HsDocStringPrevious _) sd = sd <+> pprHsDocString doc +pprWithDocString doc sd = pprHsDocString doc $+$ sd + +{- data HsDocStringDecorator = HsDocStringNext -- ^ '|' is the decorator | HsDocStringPrevious -- ^ '^' is the decorator | HsDocStringNamed !String -- ^ '$<string>' is the decorator | HsDocStringGroup !Int -- ^ The decorator is the given number of '*'s deriving (Eq, Ord, Show, Data) +-} instance Outputable HsDocStringDecorator where ppr = text . printDecorator +{- instance NFData HsDocStringDecorator where rnf HsDocStringNext = () rnf HsDocStringPrevious = () rnf (HsDocStringNamed x) = rnf x rnf (HsDocStringGroup x) = rnf x +-} printDecorator :: HsDocStringDecorator -> String printDecorator HsDocStringNext = "|" @@ -134,20 +165,26 @@ instance Binary HsDocStringDecorator where 3 -> HsDocStringGroup <$> get bh t -> fail $ "HsDocStringDecorator: invalid tag " ++ show t +{- type LHsDocStringChunk = Located HsDocStringChunk -- | A contiguous chunk of documentation newtype HsDocStringChunk = HsDocStringChunk ByteString deriving stock (Eq,Ord,Data, Show) deriving newtype (NFData) +-} + +type instance Anno HsDocStringChunk = SrcSpan instance Binary HsDocStringChunk where put_ bh (HsDocStringChunk bs) = put_ bh bs get bh = HsDocStringChunk <$> get bh + instance Outputable HsDocStringChunk where ppr = text . unpackHDSC +{- mkHsDocStringChunk :: String -> HsDocStringChunk mkHsDocStringChunk s = HsDocStringChunk (utf8EncodeByteString s) @@ -163,41 +200,42 @@ nullHDSC (HsDocStringChunk bs) = BS.null bs mkGeneratedHsDocString :: String -> HsDocString mkGeneratedHsDocString = GeneratedDocString . mkHsDocStringChunk +-} -isEmptyDocString :: HsDocString -> Bool -isEmptyDocString (MultiLineDocString _ xs) = all (nullHDSC . unLoc) xs -isEmptyDocString (NestedDocString _ s) = nullHDSC $ unLoc s -isEmptyDocString (GeneratedDocString x) = nullHDSC x +isEmptyDocString :: HsDocString (GhcPass p) -> Bool +isEmptyDocString (MultiLineDocString _ _ xs) = all (nullHDSC . unLoc) xs +isEmptyDocString (NestedDocString _ _ s) = nullHDSC $ unLoc s +isEmptyDocString (GeneratedDocString _ x) = nullHDSC x -docStringChunks :: HsDocString -> [LHsDocStringChunk] -docStringChunks (MultiLineDocString _ (x:|xs)) = x:xs -docStringChunks (NestedDocString _ x) = [x] -docStringChunks (GeneratedDocString x) = [L (UnhelpfulSpan UnhelpfulGenerated) x] +docStringChunks :: HsDocString (GhcPass p) -> [LHsDocStringChunk (GhcPass p)] +docStringChunks (MultiLineDocString _ _ (x:|xs)) = x:xs +docStringChunks (NestedDocString _ _ x) = [x] +docStringChunks (GeneratedDocString _ x) = [L (UnhelpfulSpan UnhelpfulGenerated) x] -- | Pretty print with decorators, exactly as the user wrote it -pprHsDocString :: HsDocString -> SDoc +pprHsDocString :: HsDocString (GhcPass p) -> SDoc pprHsDocString = text . exactPrintHsDocString -pprHsDocStrings :: [HsDocString] -> SDoc +pprHsDocStrings :: [HsDocString (GhcPass p)] -> SDoc pprHsDocStrings = text . intercalate "\n\n" . map exactPrintHsDocString -- | Pretty print with decorators, exactly as the user wrote it -exactPrintHsDocString :: HsDocString -> String -exactPrintHsDocString (MultiLineDocString dec (x :| xs)) +exactPrintHsDocString :: HsDocString (GhcPass p) -> String +exactPrintHsDocString (MultiLineDocString _ dec (x :| xs)) = unlines' $ ("-- " ++ printDecorator dec ++ unpackHDSC (unLoc x)) : map (\x -> "--" ++ unpackHDSC (unLoc x)) xs -exactPrintHsDocString (NestedDocString dec (L _ s)) +exactPrintHsDocString (NestedDocString _ dec (L _ s)) = "{-" ++ printDecorator dec ++ unpackHDSC s ++ "-}" -exactPrintHsDocString (GeneratedDocString x) = case lines (unpackHDSC x) of +exactPrintHsDocString (GeneratedDocString _ x) = case lines (unpackHDSC x) of [] -> "" (x:xs) -> unlines' $ ( "-- |" ++ x) : map (\y -> "--"++y) xs -- | Just get the docstring, without any decorators -renderHsDocString :: HsDocString -> String -renderHsDocString (MultiLineDocString _ (x :| xs)) = unlines' $ map (unpackHDSC . unLoc) (x:xs) -renderHsDocString (NestedDocString _ ds) = unpackHDSC $ unLoc ds -renderHsDocString (GeneratedDocString x) = unpackHDSC x +renderHsDocString :: HsDocString (GhcPass p) -> String +renderHsDocString (MultiLineDocString _ _ (x :| xs)) = unlines' $ map (unpackHDSC . unLoc) (x:xs) +renderHsDocString (NestedDocString _ _ ds) = unpackHDSC $ unLoc ds +renderHsDocString (GeneratedDocString _ x) = unpackHDSC x -- | Don't add a newline to a single string unlines' :: [String] -> String @@ -205,5 +243,5 @@ unlines' = intercalate "\n" -- | Just get the docstring, without any decorators -- Separates docstrings using "\n\n", which is how haddock likes to render them -renderHsDocStrings :: [HsDocString] -> String +renderHsDocStrings :: [HsDocString (GhcPass p)] -> String renderHsDocStrings = intercalate "\n\n" . map renderHsDocString ===================================== compiler/GHC/Hs/Extension.hs ===================================== @@ -21,7 +21,7 @@ import GHC.Types.Var import GHC.Utils.Outputable hiding ((<>)) import GHC.Types.SrcLoc (GenLocated(..), unLoc) import GHC.Utils.Panic -import GHC.Parser.Annotation +--import GHC.Parser.Annotation {- Note [IsPass] @@ -92,16 +92,18 @@ type instance XRec (GhcPass p) a = XRecGhc a -- but pass-independent, source location type XRecGhc a = GenLocated (Anno a) a -type instance Anno RdrName = SrcSpanAnnN -type instance Anno Name = SrcSpanAnnN -type instance Anno Id = SrcSpanAnnN +--type instance Anno RdrName = SrcSpanAnnN +--type instance Anno Name = SrcSpanAnnN +--type instance Anno Id = SrcSpanAnnN type instance Anno (WithUserRdr a) = Anno a +{- type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ EpAnn a, Anno (IdOccGhcP p) ~ EpAnn a, NoAnn a, IsPass p) +-} instance UnXRec (GhcPass p) where unXRec = unLoc ===================================== compiler/GHC/Hs/ImpExp.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Hs.ImpExp , module GHC.Hs.ImpExp ) where +import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name import Language.Haskell.Syntax.ImpExp @@ -39,7 +40,6 @@ import GHC.Unit.Module.Warnings import Data.Data import Data.Maybe -import GHC.Hs.Doc (LHsDoc) {- @@ -144,6 +144,10 @@ simpleImportDecl mn = ImportDecl { } instance (OutputableBndrId p + , Outputable + (GenLocated + (Anno (WithHsDocIdentifiers (HsDocString (GhcPass p)) (GhcPass p))) + (WithHsDocIdentifiers (HsDocString (GhcPass p)) (GhcPass p))) , Outputable (Anno (IE (GhcPass p))) , Outputable (ImportDeclPkgQual (GhcPass p))) => Outputable (ImportDecl (GhcPass p)) where @@ -353,10 +357,10 @@ replaceWrappedName (IEData r (L l _)) n = IEData r (L l n) replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n') -exportDocstring :: LHsDoc pass -> SDoc +exportDocstring :: Outputable (LHsDoc (GhcPass p)) => LHsDoc (GhcPass p) -> SDoc exportDocstring doc = braces (text "docstring: " <> ppr doc) -instance OutputableBndrId p => Outputable (IE (GhcPass p)) where +instance (OutputableBndrId p, Outputable (LHsDoc (GhcPass p))) => Outputable (IE (GhcPass p)) where ppr ie@(IEVar _ var doc) = sep $ catMaybes [ ppr <$> ieDeprecation ie , Just $ ppr (unLoc var) ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Data.BooleanFormula (BooleanFormula(..)) import Language.Haskell.Syntax.Decls import Language.Haskell.Syntax.Decls.Foreign (CType(..), Header(..)) import Language.Haskell.Syntax.Decls.Overlap (OverlapMode(..)) +import Language.Haskell.Syntax.Doc (HsDocString(..), WithHsDocIdentifiers(..)) import Language.Haskell.Syntax.Extension (Anno) import Language.Haskell.Syntax.Binds.InlinePragma (ActivationX(..), InlinePragma(..)) @@ -629,9 +630,9 @@ deriving instance Eq (IEWholeNamespaceExt GhcRn) deriving instance Eq (IEWholeNamespaceExt GhcTc) -- deriving instance (DataId name) => Data (IE name) -deriving instance Data (IE GhcPs) -deriving instance Data (IE GhcRn) -deriving instance Data (IE GhcTc) +deriving instance Data (Anno (WithHsDocIdentifiers (HsDocString GhcPs) GhcPs)) => Data (IE GhcPs) +deriving instance Data (Anno (WithHsDocIdentifiers (HsDocString GhcRn) GhcRn)) => Data (IE GhcRn) +deriving instance Data (Anno (WithHsDocIdentifiers (HsDocString GhcTc) GhcTc)) => Data (IE GhcTc) -- deriving instance (Eq name, Eq (IdP name)) => Eq (IE name) deriving instance Eq (IE GhcPs) @@ -669,3 +670,13 @@ deriving instance Data (InlinePragma GhcTc) deriving instance Data (OverlapMode GhcPs) deriving instance Data (OverlapMode GhcRn) deriving instance Data (OverlapMode GhcTc) + + +-- deriving instance Data (HsDocString p) +deriving instance Data (HsDocString GhcPs) +deriving instance Data (HsDocString GhcRn) +deriving instance Data (HsDocString GhcTc) + +deriving instance Data a => Data (WithHsDocIdentifiers a GhcPs) +deriving instance Data a => Data (WithHsDocIdentifiers a GhcRn) +deriving instance Data a => Data (WithHsDocIdentifiers a GhcTc) ===================================== compiler/GHC/Hs/Lit.hs ===================================== @@ -26,6 +26,7 @@ import GHC.Types.Basic (PprPrec(..), topPrec ) import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} ) import GHC.Types.SourceText import GHC.Core.Type +import GHC.Parser.Annotation ( {- type instance Anno Id -} ) import GHC.Utils.Misc (split) import GHC.Utils.Outputable import GHC.Utils.Panic (panic) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -668,7 +668,7 @@ fromIfaceWarningTxt = \case IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs) fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn -fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLocA names) fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} + module GHC.Parser.Annotation ( -- * Core Exact Print Annotation types EpToken(..), EpUniToken(..), @@ -32,6 +34,7 @@ module GHC.Parser.Annotation ( SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN, SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS, SrcSpanAnnLI, LocatedE, + IsSrcSpanAnn, -- ** Annotation data types used in 'GenLocated' @@ -94,17 +97,34 @@ import Data.Data import Data.Function (on) import Data.List (sortBy) import Data.Semigroup +import Data.Void import GHC.Data.FastString import GHC.TypeLits (Symbol, KnownSymbol, symbolVal) import GHC.Types.Name +import GHC.Types.Name.Reader (RdrName) import GHC.Types.SrcLoc -import GHC.Hs.DocString +--import GHC.Hs.DocString +import GHC.Types.Var (Id) import GHC.Utils.Misc import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict import GHC.Types.SourceText (SourceText (NoSourceText)) +import GHC.Hs.Extension + +import Language.Haskell.Syntax.Doc +import Language.Haskell.Syntax.Extension (Anno) + +type instance Anno Id = SrcSpanAnnN +type instance Anno Name = SrcSpanAnnN +type instance Anno RdrName = SrcSpanAnnN + +type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ EpAnn a, + Anno (IdOccGhcP p) ~ EpAnn a, + NoAnn a, + IsPass p) + {- Note [exact print annotations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -308,18 +328,46 @@ data EpaComment = -- and the start of this location is used for the spacing when -- exact printing the comment. } - deriving (Eq, Data, Show) + deriving (Eq, Show) + +instance Data EpaComment where + gunfold _ _ _ = undefined + toConstr = undefined + dataTypeOf = undefined data EpaCommentTok = -- Documentation annotations - EpaDocComment HsDocString -- ^ a docstring that can be pretty printed using pprHsDocString + EpaDocComment (HsDocString Void) -- ^ a docstring that can be pretty printed using pprHsDocString | EpaDocOptions String -- ^ doc options (prune, ignore-exports, etc) | EpaLineComment String -- ^ comment starting by "--" | EpaBlockComment String -- ^ comment in {- -} - deriving (Eq, Data, Show) + deriving (Eq, Show) + -- TODO: add back the Data and Show instance -- Note: these are based on the Token versions, but the Token type is -- defined in GHC.Parser.Lexer and bringing it in here would create a loop +instance {-# OVERLAPPING #-} Eq (HsDocString Void) where + (==) = \case + MultiLineDocString _ a1 b1 -> \case + MultiLineDocString _ a2 b2 -> a1 == a2 && length b1 == length b2 + _ -> False + NestedDocString _ a1 b1 -> \case + NestedDocString _ a2 b2 -> a1 == a2 + _ -> False + GeneratedDocString _ a1 -> \case + GeneratedDocString _ a2 -> a1 == a2 + _ -> False + XHsDocString _ -> \case + XHsDocString _ -> True + _ -> False + +instance {-# OVERLAPPING #-} Show (HsDocString Void) where + show = \case + MultiLineDocString _ a b -> unwords ["MultiLineDocString", show a ] + NestedDocString _ a b -> unwords ["NestedDocString" , show a ] + GeneratedDocString _ a -> unwords ["GeneratedDocString", show a ] + XHsDocString _ -> "XHsDocString" + instance Outputable EpaComment where ppr x = text (show x) @@ -390,7 +438,6 @@ data EpAnn ann deriving (Data, Eq, Functor) -- See Note [XRec and Anno in the AST] - spanAsAnchor :: SrcSpan -> (EpaLocation' a) spanAsAnchor ss = EpaSpan ss @@ -537,7 +584,7 @@ data AnnList a al_trailing :: ![TrailingAnn] -- ^ items appearing after the -- list, such as '=>' for a -- context - } deriving (Data,Eq) + } deriving (Data, Eq) data AnnListBrackets = ListParens (EpToken "(") (EpToken ")") @@ -570,7 +617,6 @@ data AnnContext ac_close :: [EpToken ")"] -- ^ zero or more closing parentheses. } deriving (Data) - -- --------------------------------------------------------------------- -- Annotations for names -- --------------------------------------------------------------------- @@ -648,7 +694,7 @@ data AnnPragma apr_loc2 :: EpaLocation, apr_type :: EpToken "type", apr_module :: EpToken "module" - } deriving (Data,Eq) + } deriving (Data, Eq) -- --------------------------------------------------------------------- ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -150,6 +150,10 @@ import qualified Data.Map.Strict as Map import qualified Data.Semigroup as S import System.IO.Unsafe ( unsafePerformIO ) +import Language.Haskell.Syntax.Extension + + + {- ************************************************************************ * * ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -103,7 +103,7 @@ module GHC.Utils.Binary getGenericSymtab, putGenericSymTab, getGenericSymbolTable, putGenericSymbolTable, -- * Newtype wrappers - BinSpan(..), BinSrcSpan(..), BinLocated(..), + BinSpan(..), BinSrcSpan(..), BinLocated(..), BinGenLocated(..), -- * Newtypes for types that have canonically more than one valid encoding BindingName(..), simpleBindingNameWriter, @@ -121,6 +121,7 @@ import Language.Haskell.Syntax.Basic import Language.Haskell.Syntax.Binds.InlinePragma import Language.Haskell.Syntax.Module.Name (ModuleName(..)) import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..)) +import Language.Haskell.Syntax.UTF8 import {-# SOURCE #-} GHC.Types.Name (Name) import GHC.Data.FastString @@ -1905,6 +1906,18 @@ instance Binary a => Binary (BinLocated a) where x <- get bh return $ BinLocated (L l x) +newtype BinGenLocated l a = BinGenLocated { unBinGenLocated :: GenLocated l a } + +instance (Binary a, Binary l) => Binary (BinGenLocated l a) where + put_ bh (BinGenLocated (L l x)) = do + put_ bh l + put_ bh x + + get bh = do + l <- get bh + x <- get bh + return $ BinGenLocated (L l x) + newtype BinSpan = BinSpan { unBinSpan :: RealSrcSpan } -- See Note [Source Location Wrappers] @@ -2097,3 +2110,8 @@ instance Binary RuleMatchInfo where h <- getByte bh if h == 1 then pure ConLike else pure FunLike + +instance Binary TextUTF8 where + put_ bh = putSBS bh . bytesUTF8 + + get = fmap unsafeFromShortByteString . getSBS ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -116,6 +116,7 @@ import Language.Haskell.Syntax.Basic import Language.Haskell.Syntax.Binds.InlinePragma import Language.Haskell.Syntax.Decls.Overlap ( OverlapMode(..) ) import Language.Haskell.Syntax.Module.Name ( ModuleName(..) ) +import Language.Haskell.Syntax.UTF8 import GHC.Prelude.Basic @@ -2036,3 +2037,6 @@ instance Outputable (OverlapMode p) where ppr (Incoherent _) = text "[incoherent]" ppr (NonCanonical _) = text "[noncanonical]" ppr (XOverlapMode _) = text "[user TTG extension]" + +instance Outputable TextUTF8 where + ppr = text . decodeUTF8 ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -1410,7 +1410,7 @@ data DocDecl pass | DocCommentNamed String (LHsDoc pass) | DocGroup Int (LHsDoc pass) -deriving instance (Data pass, Data (IdP pass)) => Data (DocDecl pass) +--deriving instance (Data pass, Data (IdP pass)) => Data (DocDecl pass) docDeclDoc :: DocDecl pass -> LHsDoc pass docDeclDoc (DocCommentNext d) = d ===================================== compiler/Language/Haskell/Syntax/Doc.hs ===================================== @@ -0,0 +1,172 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- Eq XOverlapMode, NFData OverlapMode + +{- +## Migrate and restructure `LHsDoc` + +[X] 1. Create a new **`L.H.S.Doc`** module and move the following into it. +[X] 2. Move `HsDoc` *(no change)* +[X] 3. Move `HsDocStringChunk` *(no change)* +[X] 4. Move `HsDocStringDecorator` *(no change)* +[_] 5. Move `LHsDoc p` as `XRec p (HsDoc p)` +[X] 6. Move `WithHsDocIdentifiers p` as `Located (IdP p) as LIdP p` +[_] 7. Move `HsDocString`, adding TTG parameter and extension point +[X] 8. Move `LHsDocStringChunk = Located HsDocStringChunk` as `type LHsDocStringChunk pass = XRec pass HsDocStringChunk` +[ ] 9. Add `type instance Anno HsDocStringChunk = SrcSpan` +-} + +{- | +Data-types describing the raw and lexical docstrings of +the Haskell programming language. +-} +module Language.Haskell.Syntax.Doc + ( HsDoc + , WithHsDocIdentifiers(..) + + , HsDocString(..) + -- ** Construcction + , mkGeneratedHsDocString + + , HsDocStringChunk(..) + -- ** Construction + , mkHsDocStringChunk + , mkHsDocStringChunkUtf8ByteString + -- ** Deconstruction + , unpackHDSC + -- ** Query + , nullHDSC + + , HsDocStringDecorator(..) + , LHsDoc + , LHsDocStringChunk + ) where + +import Control.DeepSeq +import Data.ByteString (ByteString) +import qualified Data.ByteString.Short as SBS +import Data.Data +import Data.Kind (Type) +import Data.Eq +import Data.List.NonEmpty (NonEmpty(..)) +import Data.Function +import Prelude +import Language.Haskell.Syntax.Extension +import Language.Haskell.Syntax.UTF8 + +-- | A docstring with the (probable) identifiers found in it. +type HsDoc (pass :: Type) = WithHsDocIdentifiers (HsDocString pass) pass + +-- | Haskell Documentation String +-- +-- Rich structure to support exact printing +-- The location around each chunk doesn't include the decorators +data HsDocString pass + = MultiLineDocString + !(XMultiLineDocString pass) + !HsDocStringDecorator + !(NonEmpty (LHsDocStringChunk pass)) + -- ^ The first chunk is preceded by "-- <decorator>" and each following chunk is preceded by "--" + -- Example: -- | This is a docstring for 'foo'. It is the line with the decorator '|' and is always included + -- -- This continues that docstring and is the second element in the NonEmpty list + -- foo :: a -> a + | NestedDocString + !(XNestedDocString pass) + !HsDocStringDecorator + (LHsDocStringChunk pass) + -- ^ The docstring is preceded by "{-<decorator>" and followed by "-}" + -- The chunk contains balanced pairs of '{-' and '-}' + | GeneratedDocString + !(XGeneratedDocString pass) + HsDocStringChunk + -- ^ A docstring generated either internally or via TH + -- Pretty printed with the '-- |' decorator + -- This is because it may contain unbalanced pairs of '{-' and '-}' and + -- not form a valid 'NestedDocString' + | XHsDocString + !(XXHsDocString pass) +{- +deriving stock instance ( + Eq (XMultiLineDocString pass), + Eq (XNestedDocString pass), + Eq (XGeneratedDocString pass), + Eq (XXHsDocString pass), + Eq (XRec pass HsDocStringChunk), + Typeable pass + ) => Eq (HsDocString pass) + +deriving stock instance ( + Show (XMultiLineDocString pass), + Show (XNestedDocString pass), + Show (XGeneratedDocString pass), + Show (XXHsDocString pass), + Show (XRec pass HsDocStringChunk), + Typeable pass + ) => Show (HsDocString pass) + +instance {-# OVERLAPPABLE #-} ( + NFData (XMultiLineDocString pass), + NFData (XNestedDocString pass), + NFData (XGeneratedDocString pass), + NFData (XXHsDocString pass), + NFData (XRec pass HsDocStringChunk) + ) => NFData (HsDocString pass) where + rnf = \case + MultiLineDocString x a b -> rnf x `seq` rnf a `seq` rnf b + NestedDocString x a b -> rnf x `seq` rnf a `seq` rnf b + GeneratedDocString x a -> rnf x `seq` rnf a + XHsDocString x -> rnf x +-} +mkGeneratedHsDocString :: XGeneratedDocString p -> String -> HsDocString p +mkGeneratedHsDocString x = GeneratedDocString x . mkHsDocStringChunk + +type LHsDoc pass = XRec pass (HsDoc pass) +--type LHsDoc pass = Located (HsDoc pass) +--type LIdP p = XRec p (IdP p) + +type LHsDocStringChunk pass = XRec pass HsDocStringChunk + +-- | A contiguous chunk of documentation +newtype HsDocStringChunk = HsDocStringChunk TextUTF8 + deriving stock (Eq,Ord,Data, Show) + deriving newtype (NFData) + +mkHsDocStringChunk :: String -> HsDocStringChunk +mkHsDocStringChunk = HsDocStringChunk . encodeUTF8 + +mkHsDocStringChunkUtf8ByteString :: ByteString -> HsDocStringChunk +mkHsDocStringChunkUtf8ByteString = + HsDocStringChunk . unsafeFromShortByteString . SBS.toShort + +unpackHDSC :: HsDocStringChunk -> String +unpackHDSC (HsDocStringChunk bs) = decodeUTF8 bs + +nullHDSC :: HsDocStringChunk -> Bool +nullHDSC (HsDocStringChunk bs) = headUTF8 bs == Nothing + +data HsDocStringDecorator + = HsDocStringNext -- ^ '|' is the decorator + | HsDocStringPrevious -- ^ '^' is the decorator + | HsDocStringNamed !String -- ^ '$<string>' is the decorator + | HsDocStringGroup !Int -- ^ The decorator is the given number of '*'s + deriving (Eq, Ord, Show, Data) + +instance NFData HsDocStringDecorator where + rnf HsDocStringNext = () + rnf HsDocStringPrevious = () + rnf (HsDocStringNamed x) = rnf x + rnf (HsDocStringGroup x) = rnf x + +-- | Annotate a value with the probable identifiers found in it +-- These will be used by haddock to generate links. +-- +-- The identifiers are bundled along with their location in the source file. +-- This is useful for tooling to know exactly where they originate. +-- +-- This type is currently used in two places - for regular documentation comments, +-- with 'a' set to 'HsDocString', and for adding identifier information to +-- warnings, where 'a' is 'StringLiteral' +data WithHsDocIdentifiers a pass = WithHsDocIdentifiers + { hsDocString :: !a + , hsDocIdentifiers :: ![LIdP pass] + } ===================================== compiler/Language/Haskell/Syntax/Extension.hs ===================================== @@ -646,6 +646,13 @@ type family XXLit x type family XOverLit x type family XXOverLit x +-- ------------------------------------- +-- Type families for the HsDocString extension points +type family XMultiLineDocString x +type family XNestedDocString x +type family XGeneratedDocString x +type family XXHsDocString x + -- ===================================================================== -- Type families for the HsPat extension points ===================================== compiler/Language/Haskell/Syntax/ImpExp.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE TypeFamilies #-} module Language.Haskell.Syntax.ImpExp ( module Language.Haskell.Syntax.ImpExp, IsBootInterface(..) ) where +import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name import Language.Haskell.Syntax.ImpExp.IsBoot ( IsBootInterface(..) ) @@ -13,7 +14,7 @@ import Data.String (String) import Data.Int (Int) import Control.DeepSeq -import {-# SOURCE #-} GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +--import {-# SOURCE #-} GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST {- ************************************************************************ ===================================== compiler/Language/Haskell/Syntax/UTF8.hs ===================================== @@ -0,0 +1,130 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | +Represents a small chunk of UTF8 text from a source code file. +-} +module Language.Haskell.Syntax.UTF8 + ( + -- * Data-type + TextUTF8() + -- ** Construction + , encodeUTF8 + , unsafeFromShortByteString + -- ** Deconstruction + , bytesUTF8 + , byteStringUTF8 + , decodeUTF8 + , headUTF8 + -- ** Transformation + , linesUTF8 + , unlinesUTF8 + ) where + + +import Prelude + +import Control.DeepSeq +import Data.ByteString (StrictByteString) +import Data.ByteString.Short (ShortByteString(..)) +import qualified Data.ByteString.Short as SBS +import Data.Data +import Data.Foldable (toList) +import Data.String (IsString(..)) +import Data.Word (Word8) + +-- These is a modules are components of the @base@ package, +-- hence they do not directly couple the library to GHC. +import GHC.Base (Char(C#)) +import GHC.Encoding.UTF8 + +{- | +A UTF8 encoded ShortByteString representing the textual snippet of code +associated with a given element of the abstract syntax tree. +-} +newtype TextUTF8 = TextUTF8 { bytesUTF8 :: ShortByteString } + deriving (Data, Eq, Ord) + +instance IsString TextUTF8 where + fromString = encodeUTF8 + +instance NFData TextUTF8 where + rnf (TextUTF8 !sbs) = rnf sbs + +instance Semigroup TextUTF8 where + (TextUTF8 x) <> (TextUTF8 y) = TextUTF8 $ x <> y + +instance Monoid TextUTF8 where + mempty = TextUTF8 mempty + +instance Show TextUTF8 where + show (TextUTF8 sbs) = utf8DecodeShortByteString sbs + +{- | +Convert the UTF8 chunk of text to a 'ByteString'. + +_Time:_ $\mathcal{O}\left( n \right )$ +-} +byteStringUTF8 :: TextUTF8 -> StrictByteString +byteStringUTF8 (TextUTF8 sbs) = SBS.fromShort sbs + +{- | +Decode a UTF8 chunk of text to a 'String'. +-} +{-# INLINE decodeUTF8 #-} +decodeUTF8 :: TextUTF8 -> String +decodeUTF8 = utf8DecodeShortByteString . bytesUTF8 + +{- | +Encode a 'String' as a UTF8 chunk of text. +-} +{-# INLINE encodeUTF8 #-} +encodeUTF8 :: String -> TextUTF8 +encodeUTF8 = TextUTF8 . utf8EncodeShortByteString + +{- | +Extract the first code point from the UTF8 check of text. + +_Time:_ $\mathcal{O}\left( 1 \right )$ +-} +headUTF8 :: TextUTF8 -> Maybe Char +headUTF8 (TextUTF8 sbs@(SBS ba#)) + | SBS.length sbs == 0 = Nothing + | otherwise = + let !(# c#, _ #) = utf8DecodeCharByteArray# ba# 0# + in Just $ C# c# + +{- | +Split a UTF8 fragment of text on newline characters (@'\n'@). +-} +linesUTF8 :: TextUTF8 -> [TextUTF8] +linesUTF8 = fmap TextUTF8 . SBS.split newlineByte . bytesUTF8 + +{- | +Join a collection of UTF8 text fragments with newline characters (@'\n'@). +-} +unlinesUTF8 :: Foldable f => f TextUTF8 -> TextUTF8 +unlinesUTF8 = + TextUTF8 . SBS.intercalate (SBS.singleton newlineByte) . fmap bytesUTF8 . toList + +{- | +Assumes that the shortByteString is already UTF8 encoded. + +/This precondition is not checked!/ +-} +{-# INLINE unsafeFromShortByteString #-} +unsafeFromShortByteString :: ShortByteString -> TextUTF8 +unsafeFromShortByteString = TextUTF8 + +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- +-- Internal Functionality +-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- + +newlineByte :: Word8 +newlineByte = 0x0A -- 0x0A (10) is the new line character (\n) + +utf8DecodeShortByteString :: ShortByteString -> [Char] +utf8DecodeShortByteString (SBS ba#) = utf8DecodeByteArray# ba# + +utf8EncodeShortByteString :: String -> ShortByteString +utf8EncodeShortByteString str = SBS (utf8EncodeByteArray# str) ===================================== compiler/ghc.cabal.in ===================================== @@ -1028,6 +1028,7 @@ Library Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Decls.Foreign Language.Haskell.Syntax.Decls.Overlap + Language.Haskell.Syntax.Doc Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension Language.Haskell.Syntax.ImpExp @@ -1037,6 +1038,7 @@ Library Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Specificity Language.Haskell.Syntax.Type + Language.Haskell.Syntax.UTF8 autogen-modules: GHC.Platform.Constants GHC.Settings.Config View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/273fba40c02500253e25b1f32da5488… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/273fba40c02500253e25b1f32da5488… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/fix-26971
by recursion-ninja (＠recursion-ninja) 02 Mar '26

02 Mar '26

recursion-ninja pushed new branch wip/fix-26971 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-26971 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/longpath-aware-manifest] 14 commits: ghc-internal: avoid depending on GHC.Internal.Control.Monad.Fix
by Hannes Siebenhandl (＠fendor) 02 Mar '26

02 Mar '26

Hannes Siebenhandl pushed to branch wip/fendor/longpath-aware-manifest at Glasgow Haskell Compiler / GHC Commits: 17839248 by Teo Camarasu at 2026-02-24T08:36:03-05:00 ghc-internal: avoid depending on GHC.Internal.Control.Monad.Fix This module contains the definition of MonadFix, since we want an instance for IO, that instance requires a lot of machinery and we want to avoid an orphan instance, this will naturally be quite high up in the dependency graph. So we want to avoid other modules depending on it as far as possible. On Windows, the IO manager depends on the RTSFlags type, which transtively depends on MonadFix. We refactor things to avoid this dependency, which would have caused a regression. Resolves #26875 Metric Decrease: T12227 - - - - - fa88d09a by Wolfgang Jeltsch at 2026-02-24T08:36:47-05:00 Refine the imports of `System.IO.OS` Commit 68bd08055594b8cbf6148a72d108786deb6c12a1 replaced the `GHC.Internal.Data.Bool` import by a `GHC.Internal.Base` import. However, while the `GHC.Internal.Data.Bool` import was conditional and partial, the `GHC.Internal.Base` import is unconditional and total. As a result, the import list is not tuned to import only the necessary bits anymore, and furthermore GHC emits a lot of warnings about redundant imports. This commit makes the `GHC.Internal.Base` import conditional and partial in the same way that the `GHC.Internal.Data.Bool` import was. - - - - - c951fef1 by Cheng Shao at 2026-02-25T20:58:28+00:00 wasm: add /assets endpoint to serve user-specified assets This patch adds an `/assets` endpoint to the wasm dyld http server, so that users can also fetch assets from the same host with sensible default MIME types, without needing a separate http server for assets that also introduces CORS headaches: - A `-fghci-browser-assets-dir` driver flag is added to specify the assets root directory (defaults to `$PWD`) - The dyld http server fetches `mime-db` on demand and uses it as source of truth for mime types. Closes #26951. - - - - - dde22f97 by Sylvain Henry at 2026-02-26T13:14:03-05:00 Fix -fcheck-prim-bounds for non constant args (#26958) Previously we were only checking bounds for constant (literal) arguments! I've refactored the code to simplify the generation of out-of-line Cmm code for the primop composed of some inline code + some call to an external Cmm function. - - - - - bd3eba86 by Vladislav Zavialov at 2026-02-27T05:48:01-05:00 Check for negative type literals in the type checker (#26861) GHC disallows negative type literals (e.g., -1), as tested by T8306 and T8412. This check is currently performed in the renamer: rnHsTyLit tyLit@(HsNumTy x i) = do when (i < 0) $ addErr $ TcRnNegativeNumTypeLiteral tyLit However, this check can be bypassed using RequiredTypeArguments (see the new test case T26861). Prior to this patch, such programs caused the compiler to hang instead of reporting a proper error. This patch addresses the issue by adding an equivalent check in the type checker, namely in tcHsType. The diff is deliberately minimal to facilitate backporting. A more comprehensive rework of HsTyLit is planned for a separate commit. - - - - - faf14e0c by Vladislav Zavialov at 2026-02-27T05:48:45-05:00 Consistent pretty-printing of HsString, HsIsString, HsStrTy Factor out a helper to pretty-print string literals, thus fixing newline handling for overloaded string literals and type literals. Test cases: T26860ppr T26860ppr_overloaded T26860ppr_tylit Follow up to ddf1434ff9bb08cfef3c93f23de6b83ec698aa27 - - - - - f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-05:00 Make list comprehension completely non-linear Fixes #25081 From the note: The usefulness of list comprehension in conjunction with linear types is dubious. After all, statements are made to be run many times, for instance in ```haskell [u | y <- [0,1], stmts] ``` both `u` and `stmts` are going to be run several times. In principle, though, there are some position in a monad comprehension expression which could be considered linear. We could try and make it so that these positions are considered linear by the typechecker, but in practice the desugarer doesn't take enough care to ensure that these are indeed desugared to linear sites. We tried in the past, and it turned out that we'd miss a desugaring corner case (#25772). Until there's a demand for this very specific improvement, let's instead be conservative, and consider list comprehension to be completely non-linear. - - - - - ae799cab by Simon Jakobi at 2026-02-27T12:53:54-05:00 PmAltConSet: Use Data.Set instead of Data.Map ...to store `PmLit`s. The Map was only used to map keys to themselves. Changing the Map to a Set saves a Word of memory per entry. Resolves #26756. - - - - - dcd7819c by Vladislav Zavialov at 2026-02-27T18:46:03-05:00 Drop HsTyLit in favor of HsLit (#26862, #25121) This patch is a small step towards unification of HsExpr and HsType, taking care of literals (HsLit) and type literals (HsTyLit). Additionally, it improves error messages for unsupported type literals, such as unboxed or fractional literals (test cases: T26862, T26862_th). Changes to the AST: * Use HsLit where HsTyLit was previously used * Use HsChar where HsCharTy was previously used * Use HsString where HsStrTy was previously used * Use HsNatural (NEW) where HsNumTy was previously used * Use HsDouble (NEW) to represent unsupported fractional type literals Changes to logic: * Parse unboxed and fractional type literals (to be rejected later) * Drop the check for negative literals in the renamer (rnHsTyLit) in favor of checking in the type checker (tc_hs_lit_ty) * Check for invalid type literals in TH (repTyLit) and report unrepresentable literals with ThUnsupportedTyLit * Allow negative type literals in TH (numTyLit). This is fine as these will be taken care of at splice time (test case: T8306_th) - - - - - c927954f by Vladislav Zavialov at 2026-02-27T18:46:50-05:00 Increase test coverage of diagnostics Add test cases for the previously untested diagnostics: [GHC-01239] PsErrIfInFunAppExpr [GHC-04807] PsErrProcInFunAppExpr [GHC-08195] PsErrInvalidRecordCon [GHC-16863] PsErrUnsupportedBoxedSumPat [GHC-18910] PsErrSemiColonsInCondCmd [GHC-24737] PsErrInvalidWhereBindInPatSynDecl [GHC-25037] PsErrCaseInFunAppExpr [GHC-25078] PsErrPrecedenceOutOfRange [GHC-28021] PsErrRecordSyntaxInPatSynDecl [GHC-35827] TcRnNonOverloadedSpecialisePragma [GHC-40845] PsErrUnpackDataCon [GHC-45106] PsErrInvalidInfixHole [GHC-50396] PsErrInvalidRuleActivationMarker [GHC-63930] MultiWayIfWithoutAlts [GHC-65536] PsErrNoSingleWhereBindInPatSynDecl [GHC-67630] PsErrMDoInFunAppExpr [GHC-70526] PsErrLetCmdInFunAppCmd [GHC-77808] PsErrDoCmdInFunAppCmd [GHC-86934] ClassPE [GHC-90355] PsErrLetInFunAppExpr [GHC-91745] CasesExprWithoutAlts [GHC-92971] PsErrCaseCmdInFunAppCmd [GHC-95644] PsErrBangPatWithoutSpace [GHC-97005] PsErrIfCmdInFunAppCmd Remove unused error constructors: [GHC-44524] PsErrExpectedHyphen [GHC-91382] TcRnIllegalKindSignature - - - - - 3a9470fd by Torsten Schmits at 2026-02-27T18:47:34-05:00 Avoid expensive computation for debug logging in `mergeDatabases` when log level is low This computed and traversed a set intersection for every single dependency unconditionally. - - - - - ea4c2cbd by Brandon Chinn at 2026-02-27T16:22:38-08:00 Implement QualifiedStrings (#26503) See Note [Implementation of QualifiedStrings] - - - - - 08bc245b by sheaf at 2026-03-01T11:11:54-05:00 Clean up join points, casts & ticks This commit shores up the logic dealing with casts and ticks occurring in between a join point binding and a jump. Fixes #26642 #26929 #26693 Makes progress on #14610 #26157 #26422 Changes: - Remove 'GHC.Types.Tickish.TickishScoping' in favour of simpler predicates 'tickishHasNoScope'/'tickishHasSoftScope', as things were before commit 993975d3. This makes the code easier to read and document (fewer indirections). - Introduce 'canCollectArgsThroughTick' for consistent handling of ticks around PrimOps and other 'Id's that cannot be eta-reduced. See overhauled Note [Ticks and mandatory eta expansion]. - New Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt that explains robustness of JoinId vs fragility of TailCallInfo. - Allow casts/non-soft-scoped ticks to occur in between a join point binder and a jump, but only in Core Prep. See Note [Join points, casts, and ticks] and Note [Join points, casts, and ticks... in Core Prep] in GHC.Core.Opt.Simplify.Iteration. Also update Core Lint to account for this. See Note [Linting join points with casts or ticks] in GHC.Core.Lint. - Update 'GHC.Core.Utils.mergeCaseAlts' to avoid pushing a cast in between a join point binding and its jumps. This fixes #26642. See the new (MC5) and (MC6) in Note [Merge Nested Cases]. - Update float out to properly handle source note ticks. They are now properly floated out instead of being discarded. This increases the number of ticks in certain tests with -g. Test cases: T26642 and TrickyJoins. Metric increase due to more source note ticks with -g: ------------------------- Metric Increase: libdir size_hello_artifact size_hello_unicode ------------------------- - - - - - 0da8a5d0 by Fendor at 2026-03-02T12:31:32+01:00 Add `-fwin-aware-long-paths` to support ling paths on Windows While Windows supports file paths longer than the MAX_PATH restriction, it is opt-in, and not enabled by default. By declaring the binary to be long path aware in the manifest of the windows executable, the binary opts-in to the new behaviour. It is up to the developer to make sure they use UNC paths and Win.h specific functions for filesystem operations to use long paths in their application. See https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-li… and https://learn.microsoft.com/en-us/windows/win32/sbscs/application-manifests for the documentation on the application manifest and long path option. - - - - - 209 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Windows.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - + compiler/GHC/Rename/Lit.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Interpreter/Init.hs - compiler/GHC/Runtime/Interpreter/Types.hs - compiler/GHC/Runtime/Interpreter/Wasm.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Unit/State.hs - compiler/Language/Haskell/Syntax/Expr.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in - docs/users_guide/9.16.1-notes.rst - + docs/users_guide/exts/qualified_strings.rst - docs/users_guide/phases.rst - docs/users_guide/wasm.rst - libraries/base/src/Control/Arrow.hs - libraries/base/src/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs - libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs - libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs - testsuite/tests/codeGen/should_compile/debug.stdout - + testsuite/tests/codeGen/should_fail/T26958.hs - testsuite/tests/codeGen/should_fail/all.T - + testsuite/tests/dependent/should_fail/SelfDepCls.hs - + testsuite/tests/dependent/should_fail/SelfDepCls.stderr - testsuite/tests/dependent/should_fail/all.T - testsuite/tests/diagnostic-codes/codes.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/annotations-literals/literals.stdout - testsuite/tests/ghc-api/annotations-literals/parsed.hs - testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout - testsuite/tests/ghci/scripts/T10963.stderr - testsuite/tests/ghci/scripts/T4175.stdout - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/template-haskell-exports.stdout - − testsuite/tests/linear/should_compile/LinearListComprehension.hs - testsuite/tests/linear/should_compile/all.T - testsuite/tests/linear/should_fail/T25081.hs - testsuite/tests/linear/should_fail/T25081.stderr - testsuite/tests/mdo/should_fail/mdofail006.stderr - testsuite/tests/module/all.T - + testsuite/tests/module/mod70b.hs - + testsuite/tests/module/mod70b.stderr - + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.hs - + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.stderr - testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.hs - testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.stderr - + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.hs - + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.stderr - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs - + testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr - + testsuite/tests/parser/should_fail/T26860ppr_tylit.hs - + testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/parser/should_fail/badRuleMarker.hs - + testsuite/tests/parser/should_fail/badRuleMarker.stderr - + testsuite/tests/parser/should_fail/patFail010.hs - + testsuite/tests/parser/should_fail/patFail010.stderr - + testsuite/tests/parser/should_fail/patFail011.hs - + testsuite/tests/parser/should_fail/patFail011.stderr - + testsuite/tests/parser/should_fail/precOutOfRange.hs - + testsuite/tests/parser/should_fail/precOutOfRange.stderr - + testsuite/tests/parser/should_fail/unpack_data_con.hs - + testsuite/tests/parser/should_fail/unpack_data_con.stderr - testsuite/tests/patsyn/should_fail/T10426.stderr - testsuite/tests/patsyn/should_fail/all.T - + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.stderr - + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.hs - + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.stderr - + testsuite/tests/qualified-strings/Makefile - + testsuite/tests/qualified-strings/should_compile/Example/Length.hs - + testsuite/tests/qualified-strings/should_compile/all.T - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs - + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr - + testsuite/tests/qualified-strings/should_fail/Example/Length.hs - + testsuite/tests/qualified-strings/should_fail/Makefile - + testsuite/tests/qualified-strings/should_fail/all.T - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs - + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr - + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs - + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs - + testsuite/tests/qualified-strings/should_run/Example/Text.hs - + testsuite/tests/qualified-strings/should_run/Makefile - + testsuite/tests/qualified-strings/should_run/all.T - + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs - + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs - + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout - + testsuite/tests/qualified-strings/should_run/qstrings_th.hs - + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout - + testsuite/tests/simplCore/should_compile/T26642.hs - + testsuite/tests/simplCore/should_compile/TrickyJoins.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/th/T26862_th.script - + testsuite/tests/th/T26862_th.stderr - + testsuite/tests/th/T8306_th.script - + testsuite/tests/th/T8306_th.stderr - + testsuite/tests/th/T8306_th.stdout - testsuite/tests/th/T8412.stderr - + testsuite/tests/th/TH_EmptyLamCases.hs - + testsuite/tests/th/TH_EmptyLamCases.stderr - + testsuite/tests/th/TH_EmptyMultiIf.hs - + testsuite/tests/th/TH_EmptyMultiIf.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_fail/T26861.hs - + testsuite/tests/typecheck/should_fail/T26861.stderr - + testsuite/tests/typecheck/should_fail/T26862.hs - + testsuite/tests/typecheck/should_fail/T26862.stderr - testsuite/tests/typecheck/should_fail/T8306.stderr - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/unboxedsums/all.T - + testsuite/tests/unboxedsums/unboxedsums4p.hs - + testsuite/tests/unboxedsums/unboxedsums4p.stderr - + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.hs - + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.stderr - testsuite/tests/warnings/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/jsffi/dyld.mjs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5075477ca5ac4f2a68fe80533314b5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5075477ca5ac4f2a68fe80533314b5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/backports-9.12.4] Prepare release 9.12.4
by Zubin (＠wz1000) 02 Mar '26

02 Mar '26

Zubin pushed to branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC Commits: 45bc79ab by Zubin Duggal at 2026-03-02T16:47:45+05:30 Prepare release 9.12.4 - - - - - 3 changed files: - docs/users_guide/release-notes.rst - libraries/base/base.cabal.in - libraries/base/changelog.md Changes: ===================================== docs/users_guide/release-notes.rst ===================================== @@ -7,3 +7,4 @@ Release notes 9.12.1-notes 9.12.2-notes 9.12.3-notes + 9.12.4-notes ===================================== libraries/base/base.cabal.in ===================================== @@ -4,7 +4,7 @@ cabal-version: 3.0 -- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal name: base -version: 4.21.1.0 +version: 4.21.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause ===================================== libraries/base/changelog.md ===================================== @@ -1,7 +1,9 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) ## 4.21.2.0 *TBA* - * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) + * Expose `Backtraces` constructor and fields ([CLC proposal #199](https://github.com/haskell/core-libraries-committee/issues/199), [#26049](https://gitlab.haskell.org/ghc/ghc/-/issues/26049)) + * Store `StackTrace` and `StackSnapshot` in `Backtraces`, deferring decoding until display + * Evaluate backtraces for "error" exceptions at the moment they are thrown ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383), [#26751](https://gitlab.haskell.org/ghc/ghc/-/issues/26751)) ## 4.21.1.0 *Sept 2024* * Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)). View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45bc79ab3c196a90297cad2368983da… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45bc79ab3c196a90297cad2368983da… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/backports-9.12.4] 6 commits: determinism: Use deterministic map for Strings in TyLitMap
by Zubin (＠wz1000) 02 Mar '26

02 Mar '26

Zubin pushed to branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC Commits: 6b0e956c by Matthew Pickering at 2026-03-02T16:31:32+05:30 determinism: Use deterministic map for Strings in TyLitMap When generating typeable evidence the types we need evidence for all cached in a TypeMap, the order terms are retrieved from a type map determines the order the bindings appear in the program. A TypeMap is quite diligent to use deterministic maps, apart from in the TyLitMap, which uses a UniqFM for storing strings, whose ordering depends on the Unique of the FastString. This can cause non-deterministic .hi and .o files. An unexpected side-effect is the error message but RecordDotSyntaxFail8 changing. I looked into this with Sam and this change caused the constraints to be solved in a different order which results in a slightly different error message. I have accepted the new test, since the output before was non-deterministic and the new output is consistent with the other messages in that file. Fixes #26846 (cherry picked from commit aeeb4a2034e80e26503eb88f5abde85e87a82f7b) - - - - - e71ceeb6 by Andrew Lelechenko at 2026-03-02T16:32:06+05:30 Upgrade text submodule to 2.1.4 (cherry picked from commit 9e4d70c2764d117c5cf753127f93056d66e4f0d7) - - - - - ad61e24e by Zubin Duggal at 2026-03-02T16:32:12+05:30 Bump transformers submodule to 0.6.3.0 Fixes #26790 (cherry picked from commit ea0d1317a630799a6b7bea12b24ef7e1ea6ed512) - - - - - a85c480a by Matthew Pickering at 2026-03-02T16:32:18+05:30 determinism: Use a stable sort in WithHsDocIdentifiers binary instance `WithHsDocIdentifiers` is defined as ``` 71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers 72 { hsDocString :: !a 73 , hsDocIdentifiers :: ![Located (IdP pass)] 74 } ``` This list of names is populated from `rnHsDocIdentifiers`, which calls `lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls `nonDetEltsUFM` and returns the results in an order depending on uniques. Sorting the list with a stable sort before returning the interface makes the output deterministic and follows the approach taken by other fields in `Docs`. Fixes #26858 (cherry picked from commit 0020e38a021b5f0371c48fe73cddf8987acb1eb1) - - - - - ddfc5434 by Simon Peyton Jones at 2026-03-02T16:35:43+05:30 Fix subtle bug in cast worker/wrapper See (CWw4) in Note [Cast worker/wrapper]. The true payload is in the change to the definition of GHC.Types.Id.Info.hasInlineUnfolding Everthing else is just documentation. There is a 2% compile time decrease for T13056; I'll take the win! Metric Decrease: T13056 (cherry picked from commit 99d8c146c12146e1e21b1f2d31809845d4afe9d4) - - - - - b80be63d by Cheng Shao at 2026-03-02T16:37:31+05:30 wasm: use import.meta.main for proper distinction of nodejs main modules This patch uses `import.meta.main` for proper distinction of nodejs main modules, especially when the main module might be installed as a symlink. Fixes #26916. (cherry picked from commit 039f19778e35b193af0de2a2c6ed89556038627a) - - - - - 18 changed files: - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Types/Id/Info.hs - libraries/text - libraries/transformers - + testsuite/tests/ghc-api/TypeMapStringLiteral.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - + testsuite/tests/simplCore/should_compile/T26903.hs - + testsuite/tests/simplCore/should_compile/T26903.stderr - testsuite/tests/simplCore/should_compile/all.T - utils/jsffi/dyld.mjs - utils/jsffi/post-link.mjs Changes: ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -47,7 +47,7 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.Var import GHC.Types.Var.Env -import GHC.Types.Unique.FM +import GHC.Types.Unique.DFM import GHC.Utils.Outputable import GHC.Utils.Panic @@ -364,14 +364,14 @@ filterT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon ------------------------ data TyLitMap a = TLM { tlm_number :: Map.Map Integer a - , tlm_string :: UniqFM FastString a + , tlm_string :: UniqDFM FastString a , tlm_char :: Map.Map Char a } -- TODO(22292): derive instance Functor TyLitMap where fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM - { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } + { tlm_number = Map.map f tn, tlm_string = mapUDFM f ts, tlm_char = Map.map f tc } instance TrieMap TyLitMap where type Key TyLitMap = TyLit @@ -382,30 +382,30 @@ instance TrieMap TyLitMap where filterTM = filterTyLit emptyTyLitMap :: TyLitMap a -emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty } +emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUDFM, tlm_char = Map.empty } lkTyLit :: TyLit -> TyLitMap a -> Maybe a lkTyLit l = case l of NumTyLit n -> tlm_number >.> Map.lookup n - StrTyLit n -> tlm_string >.> (`lookupUFM` n) + StrTyLit n -> tlm_string >.> (`lookupUDFM` n) CharTyLit n -> tlm_char >.> Map.lookup n xtTyLit :: TyLit -> XT a -> TyLitMap a -> TyLitMap a xtTyLit l f m = case l of NumTyLit n -> m { tlm_number = Map.alter f n (tlm_number m) } - StrTyLit n -> m { tlm_string = alterUFM f (tlm_string m) n } + StrTyLit n -> m { tlm_string = alterUDFM f (tlm_string m) n } CharTyLit n -> m { tlm_char = Map.alter f n (tlm_char m) } foldTyLit :: (a -> b -> b) -> TyLitMap a -> b -> b -foldTyLit l m = flip (nonDetFoldUFM l) (tlm_string m) +foldTyLit l m = flip (foldUDFM l) (tlm_string m) . flip (Map.foldr l) (tlm_number m) . flip (Map.foldr l) (tlm_char m) filterTyLit :: (a -> Bool) -> TyLitMap a -> TyLitMap a filterTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.filter f tn, tlm_string = filterUFM f ts, tlm_char = Map.filter f tc } + = TLM { tlm_number = Map.filter f tn, tlm_string = filterUDFM f ts, tlm_char = Map.filter f tc } ------------------------------------------------- -- | @TypeMap a@ is a map from 'Type' to @a@. If you are a client, this ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -474,14 +474,14 @@ leaving a simpler job for demand-analysis worker/wrapper. See #19874. Wrinkles -1. We must /not/ do cast w/w on +(CWW1) We must /not/ do cast w/w on f = g |> co otherwise it'll just keep repeating forever! You might think this is avoided because the call to tryCastWorkerWrapper is guarded by - preInlineUnconditinally, but I'm worried that a loop-breaker or an - exported Id might say False to preInlineUnonditionally. + preInlineUnconditionally, but I'm worried that a loop-breaker or an + exported Id might say False to preInlineUnconditionally. -2. We need to be careful with inline/noinline pragmas: +(CWW2) We need to be careful with inline/noinline pragmas: rec { {-# NOINLINE f #-} f = (...g...) |> co ; g = ...f... } @@ -496,15 +496,15 @@ Wrinkles f = $wf |> co ; g = ...f... } and that is bad: the whole point is that we want to inline that - cast! We want to transfer the pagma to $wf: + cast! We want to transfer the pragma to $wf: rec { {-# NOINLINE $wf #-} $wf = ...g... ; f = $wf |> co ; g = ...f... } c.f. Note [Worker/wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap. -3. We should still do cast w/w even if `f` is INLINEABLE. E.g. - {- f: Stable unfolding = <stable-big> -} +(CWW3) We should still do cast w/w even if `f` is INLINEABLE. E.g. + {- f: Stable unfolding (arity 2) = <stable-big> -} f = (\xy. <big-body>) |> co Then we want to w/w to {- $wf: Stable unfolding = <stable-big> |> sym co -} @@ -513,15 +513,43 @@ Wrinkles Notice that the stable unfolding moves to the worker! Now demand analysis will work fine on $wf, whereas it has trouble with the original f. c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. - This point also applies to strong loopbreakers with INLINE pragmas, see - wrinkle (4). -4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence - hasInlineUnfolding in tryCastWorkerWrapper, which responds False to - loop-breakers) because they'll definitely be inlined anyway, cast and - all. And if we do cast w/w for an INLINE function with arity zero, we get +(CWW4) We should /not/ do cast w/w for INLINE functions (hence `hasInlineUnfolding` + in `tryCastWorkerWrapper`) because they'll definitely be inlined anyway, cast + and all. + + Moreover, if we do cast w/w for an INLINE function with arity zero, we get something really silly: we inline that "worker" right back into the wrapper! - Worse than a no-op, because we have then lost the stable unfolding. + In fact it is Much Worse than a no-op, because we have then lost the stable + unfolding --- aargh (see #26903). E.g. similar example to (CWW3) + {- g: Stable unfolding (arity 0) = <stable-big> -} NB arity 0! + g = (\xy. <big-body>) |> co + If we w/w to this: + {- $wg: Stable unfolding (arity 0) = <stable-big> |> sym co -} + $wg = \xy. <big-body> + g = $wg |> co + then we'll inline $wg at the call site in `g` giving + {- $wg: Stable unfolding (arity 0) = <stable-big> |> sym co -} + $wg = \xy. <big-body> + g = (<stable-big> |> sym co) |> co + and now we'll drop `$wg` as dead and we have lost the unfolding on `g`. + (We could /also/ give the binding `g = $wf |> co` a stable unfolding. Then + things would work right; but there is also no point in doing the cast + worker/wrapper in the first place.) + + NB: you might wonder about a loop-breaker with an INLINE pragma; after all, a + loop breaker won't "definitely be inlined anyway", so arguably we should not + disable cast w/w/ for it. But a Rec group can /look/ recursive at an early + stage, and subsequently /become/ non-recursive after some simplification. + (This is common in instance decls; see Note [Checking for INLINE loop breakers] + in GHC.Core.Lint.) So the danger is that we'll permanently lose that stable + unfolding that we specifically wanted (#26903). Simple solution: disable cast + w/w for /any/ INLINE function. See the defn + of `GHC.Types.Id.Info.hasInlineUnfolding`. + + The danger is that an INLINE pragma on a genuninely-recursive function + will kill worker-wrapper. Well, so be it. They are pretty suspicious anyway; + see Note [Checking for INLINE loop breakers]. All these wrinkles are exactly like worker/wrapper for strictness analysis: f is the wrapper and must inline like crazy @@ -586,11 +614,11 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co) | BC_Let top_lvl is_rec <- bind_cxt -- Not join points , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform -- a DFunUnfolding in mk_worker_unfolding - , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 - , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4 - , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would - -- lose the underlying runtime representation. - -- See Note [Preserve RuntimeRep info in cast w/w] + , not (exprIsTrivial rhs) -- Not x = y |> co; see (CWW1) + , not (hasInlineUnfolding info) -- Not INLINE things: see (CWW4) + , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would + -- lose the underlying runtime representation. + -- See Note [Preserve RuntimeRep info in cast w/w] , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings -- See Note [OPAQUE pragma] = do { uniq <- getUniqueM @@ -637,13 +665,13 @@ tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co) `setArityInfo` work_arity -- We do /not/ want to transfer OccInfo, Rules -- Note [Preserve strictness in cast w/w] - -- and Wrinkle 2 of Note [Cast worker/wrapper] + -- and (CWW2) of Note [Cast worker/wrapper] ----------- Worker unfolding ----------- -- Stable case: if there is a stable unfolding we have to compose with (Sym co); -- the next round of simplification will do the job -- Non-stable case: use work_rhs - -- Wrinkle 3 of Note [Cast worker/wrapper] + -- See (CWW4) of Note [Cast worker/wrapper] mk_worker_unfolding top_lvl work_id work_rhs = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -176,8 +176,9 @@ several liked-named Ids bouncing around at the same time---absolute mischief.) Notice that we refrain from w/w'ing an INLINE function even if it is -in a recursive group. It might not be the loop breaker. (We could -test for loop-breaker-hood, but I'm not sure that ever matters.) +in a recursive group. It might not be the loop breaker. (We used to +test for loop-breaker-hood, but see (CWW4) in Note [Cast worker/wrapper] +in GHC.Core.Opt.Simplify.Iteration.) Note [Worker/wrapper for INLINABLE functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -147,6 +147,12 @@ perPassFlags dflags pass check_lbs = case pass of CoreDesugar -> False CoreDesugarOpt -> False + + -- Disable Lint warnings on the first simplifier pass, because + -- there may be some INLINE knots still tied, which is tiresomely noisy + CoreDoSimplify cfg + | InitialPhase <- sm_phase (so_mode cfg) + -> False _ -> True -- See Note [Checking StaticPtrs] ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -50,6 +50,7 @@ import qualified GHC.Utils.Outputable as O import GHC.Hs.Extension import GHC.Types.Unique.Map import Data.List (sortBy) +import Data.Function import GHC.Hs.DocString @@ -88,7 +89,7 @@ instance Outputable a => Outputable (WithHsDocIdentifiers a pass) where instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where put_ bh (WithHsDocIdentifiers s ids) = do put_ bh s - put_ bh $ BinLocated <$> ids + put_ bh $ BinLocated <$> (sortBy (stableNameCmp `on` getName) ids) get bh = liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh) ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -568,7 +568,12 @@ hasInlineUnfolding :: IdInfo -> Bool -- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is -- (a) always inlined; that is, with an `UnfWhen` guidance, or -- (b) a DFunUnfolding which never needs to be inlined -hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info) +-- +-- Very important that this work with `realUnfoldingInfo` and so returns +-- True even for a loop-breaker that has an INLINE pragma. +-- See (CWW4) in Note [Cast worker/wrapper] in GHC.Core.Opt.Simplify.Iteration +-- for discussion, and #26903 for the dire consequences of getting this wrong. +hasInlineUnfolding info = isInlineUnfolding (realUnfoldingInfo info) setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit 5f343f668f421bfb30cead594e52d0ac6206ff67 +Subproject commit 423fd981e576bd17a8b5fa48d0ad6b9a0c370e77 ===================================== libraries/transformers ===================================== @@ -1 +1 @@ -Subproject commit cee47cca7705edafe0a5839439e679edbd61890a +Subproject commit 0d615bc2457d5d2c695dcfdb902d88c1225beff3 ===================================== testsuite/tests/ghc-api/TypeMapStringLiteral.hs ===================================== @@ -0,0 +1,58 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Control.Monad (unless) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Short as SBS +import Data.Char (ord) +import Data.List (foldl') +import GHC.Core.Map.Type (TypeMap, emptyTypeMap, extendTypeMap, foldTypeMap) +import GHC.Core.Type (Type, mkStrLitTy) +import GHC.Data.FastString (FastString (..), FastZString (..)) +import GHC.Utils.Encoding (zEncodeString) + +main :: IO () +main = do + let logicalEntries = + [ ("alpha", "payload-alpha") + , ("beta", "payload-beta") + , ("gamma", "payload-gamma") + ] + uniquesOne = [1, 2, 3] + uniquesTwo = [200, 100, 500] + + tmOne = buildMap logicalEntries uniquesOne + tmTwo = buildMap logicalEntries uniquesTwo + + foldedOne = foldValues tmOne + foldedTwo = foldValues tmTwo + + assert "foldTypeMap order independent of FastString uniques" $ + foldedOne == foldedTwo + + +buildMap :: [(String, a)] -> [Int] -> TypeMap a +buildMap entries uniques = + foldl' insertEntry emptyTypeMap (zip uniques entries) + where + insertEntry :: TypeMap a -> (Int, (String, a)) -> TypeMap a + insertEntry tm (u, (txt, payload)) = + extendTypeMap tm (strLiteralWithUnique u txt) payload + +foldValues :: TypeMap a -> [a] +foldValues tm = foldTypeMap (:) [] tm + +strLiteralWithUnique :: Int -> String -> Type +strLiteralWithUnique u = mkStrLitTy . fakeFastString u + +fakeFastString :: Int -> String -> FastString +fakeFastString u s = FastString + { uniq = u + , n_chars = length s + , fs_sbs = SBS.pack (map (fromIntegral . ord) s) + , fs_zenc = error "unused" + } + +assert :: String -> Bool -> IO () +assert label condition = unless condition $ + error ("TypeMap string literal test failed: " ++ label) ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -43,3 +43,4 @@ test('T20757', [unless(opsys('mingw32'), skip), exit_code(1), normalise_version( ['-package ghc']) test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc']) test('T26120', [], compile_and_run, ['-package ghc']) +test('TypeMapStringLiteral', normal, compile_and_run, ['-package ghc']) ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -6,14 +6,14 @@ docs: '<>', ':=:', 'Bool' -} identifiers: + {DocsInHiFile.hs:4:2-3} + GHC.Internal.Base.<> {DocsInHiFile.hs:2:6-9} GHC.Internal.Data.Foldable.elem - {DocsInHiFile.hs:2:6-9} - elem {DocsInHiFile.hs:2:14-18} GHC.Internal.System.IO.print - {DocsInHiFile.hs:4:2-3} - GHC.Internal.Base.<> + {DocsInHiFile.hs:2:6-9} + elem {DocsInHiFile.hs:4:15-18} GHC.Types.Bool export docs: ===================================== testsuite/tests/showIface/HaddockSpanIssueT24378.stdout ===================================== @@ -6,14 +6,14 @@ docs: '<>', ':=:', 'Bool' -} identifiers: + {HaddockSpanIssueT24378.hs:3:2-3} + GHC.Internal.Base.<> {HaddockSpanIssueT24378.hs:1:6-9} GHC.Internal.Data.Foldable.elem - {HaddockSpanIssueT24378.hs:1:6-9} - elem {HaddockSpanIssueT24378.hs:1:14-18} GHC.Internal.System.IO.print - {HaddockSpanIssueT24378.hs:3:2-3} - GHC.Internal.Base.<> + {HaddockSpanIssueT24378.hs:1:6-9} + elem {HaddockSpanIssueT24378.hs:3:15-18} GHC.Types.Bool export docs: ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -3,10 +3,10 @@ docs: Just text: -- | 'foo#' `Bar##` `*##` identifiers: - {MagicHashInHaddocks.hs:3:7-10} - foo# {MagicHashInHaddocks.hs:3:14-18} Bar## + {MagicHashInHaddocks.hs:3:7-10} + foo# export docs: [] declaration docs: ===================================== testsuite/tests/simplCore/should_compile/T26903.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE DefaultSignatures #-} +module T26903 where + +newtype T a = MkT [a] + +class C a where + op :: [a] -> [a] -> T a + + -- This default method + -- * Has an INLINE pragma + -- * Is too big to inline without a pragma + -- * Has arity zero + {-# INLINE[1] op #-} + default op :: Ord a => [a] -> [a] -> T a + op = \xs ys -> MkT $ if xs>ys then reverse (reverse (reverse (reverse xs))) + else reverse (reverse (reverse (reverse (xs ++ ys)))) + +instance C Int where {} + +test :: [Int] -> T Int +test xs = op [] xs + -- We expect to see `op` inlined into the RHS of `test` + ===================================== testsuite/tests/simplCore/should_compile/T26903.stderr ===================================== @@ -0,0 +1,52 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 127, types: 130, coercions: 48, joins: 0/0} + +$dmop + = (\ @a _ $dOrd xs ys -> + case $fOrdList_$ccompare $dOrd xs ys of { + __DEFAULT -> + reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) []; + GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) [] + }) + `cast` <Co:20> :: ... + +$fCInt_$cop + = (\ xs ys -> + case $fOrdList_$s$ccompare xs ys of { + __DEFAULT -> + reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) []; + GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) [] + }) + `cast` <Co:11> :: ... + +$fCInt1 + = \ xs ys -> + case $fOrdList_$s$ccompare xs ys of { + __DEFAULT -> + reverse1 (reverse1 (reverse1 (reverse1 (++ xs ys) []) []) []) []; + GT -> reverse1 (reverse1 (reverse1 (reverse xs) []) []) [] + } + +$fCInt = C:C ($fCInt1 `cast` <Co:11> :: ...) + +test4 = reverse1 [] [] + +test3 = reverse1 test4 [] + +test2 = reverse1 test3 [] + +test1 = reverse1 test2 [] + +test + = \ xs -> + case $fOrdList_$s$ccompare [] xs of { + __DEFAULT -> + (reverse1 (reverse1 (reverse1 (reverse1 (++ [] xs) []) []) []) []) + `cast` <Co:3> :: ...; + GT -> test1 `cast` <Co:3> :: ... + } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -537,3 +537,4 @@ test('T25883b', normal, compile_grep_core, ['']) test('T25883c', normal, compile_grep_core, ['']) test('T25883d', [extra_files(['T25883d_import.hs'])], multimod_compile_filter, ['T25883d', '-O -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques', r'grep -e "y ="']) test('T26681', normal, compile, ['-O']) +test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all']) ===================================== utils/jsffi/dyld.mjs ===================================== @@ -850,7 +850,7 @@ class DyLD { } function isMain() { - return import.meta.filename === process.argv[1]; + return import.meta.main; } if (isMain()) { ===================================== utils/jsffi/post-link.mjs ===================================== @@ -75,7 +75,7 @@ export async function postLink(mod) { } function isMain() { - return import.meta.filename === process.argv[1]; + return import.meta.main; } async function main() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/abc4b2368d78eeae32efb40f119ba9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/abc4b2368d78eeae32efb40f119ba9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/reduce-type-in-stg] Add note about tagToEnum# in STG
by Jaro Reinders (＠jaro) 02 Mar '26

02 Mar '26

Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC Commits: 87077c02 by Jaro Reinders at 2026-03-02T11:57:48+01:00 Add note about tagToEnum# in STG - - - - - 3 changed files: - compiler/GHC/CoreToStg.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToCmm/Prim.hs Changes: ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -548,8 +548,11 @@ mkStgApp f how_bound core_args stg_args res_ty else StgConApp dc NoNumber stg_args [] - -- We rewrite the TagToEnum primop to a special StgTagToEnumOp which contains information about the type constructor - PrimOpId TagToEnumOp _ -> StgOpApp (StgTagToEnumOp (tcTyConAppTyCon res_ty)) stg_args res_kind + -- We rewrite the 'tagToEnum#' primop to a special 'StgTagToEnumOp' which + -- stores the type constructor information. See Note [tagToEnum# in STG] + -- in GHC.Stg.Syntax. + PrimOpId TagToEnumOp _ -> + StgOpApp (StgTagToEnumOp (tcTyConAppTyCon res_ty)) stg_args res_kind -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -766,6 +766,30 @@ StgOp An StgOp allows us to group together PrimOps and ForeignCalls. It's quite useful to move these around together, notably in StgOpApp and COpStmt. + +Note [tagToEnum# in STG] +~~~~~~~~~~~~~~~~~~~~~~~~ + +STG is untyped, but 'tagToEnum#' needs type information, so we make it a special +STG operation which stores the type constructor information alongside it. + +This happens in three main steps throughout the compiler: + +1. The type checker ensures 'tagToEnum#' is applied to a concrete type. +2. When converting Core to STG, we rewrite the 'tagToEnum#' primop to a special + 'StgTagToEnumOp' along with the type constructor info (the 'TyCon'). +3. This information is used for code generation in the back end. + +At run-time, the 'tagToEnum#' operation converts an integer to a constructor of +an enumeration data type. Given an integer, it produces a pointer to a data +constructor. Hence, we need information about where the constructors are stored +in memory. + +To preserve this information we desugar the 'tagToEnum#' primop into a special +'StgTagToEnumOp' which has an extra field to store the type constructor +information. This desugaring happens when converting Core to STG, which is the +last moment that we still have access to the type information. + -} data StgOp @@ -780,7 +804,7 @@ data StgOp -- GHC.StgToCmm.Foreign. -- See Note [Unlifted boxed arguments to foreign calls] - | StgTagToEnumOp TyCon + | StgTagToEnumOp TyCon -- See Note [tagToEnum# in STG] {- ************************************************************************ ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1685,8 +1685,9 @@ emitPrimOp cfg primop = then Left (MO_S_Mul2 (wordWidth platform)) else Right genericIntMul2Op - -- tagToEnum# is removed in CoreToStg and rewritten to a special StgTagToEnumOp - -- See Note [?] + -- 'tagToEnum#' is removed in CoreToStg and rewritten to a special + -- 'StgTagToEnumOp' from GHC.Stg.Syntax instead. + -- See Note [tagToEnum# in STG] in GHC.Stg.Syntax TagToEnumOp -> panic "emitPrimOp: TagToEnumOp should have been gone by now" -- Out of line primops. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87077c02e07a6c8fe7c5eab3a40bf40… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87077c02e07a6c8fe7c5eab3a40bf40… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/backports-9.12.4
by Zubin (＠wz1000) 02 Mar '26

02 Mar '26

Zubin pushed new branch wip/backports-9.12.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-9.12.4 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26878] Simplify `GHC.Core.Utils.mkTick`
by sheaf (＠sheaf) 02 Mar '26

02 Mar '26

sheaf pushed to branch wip/T26878 at Glasgow Haskell Compiler / GHC Commits: 344c1fb3 by Simon Peyton Jones at 2026-03-02T11:50:04+01:00 Simplify `GHC.Core.Utils.mkTick` Addresses #26878, by deleting code! Fixes #26941 by no longer wrapping coercions with SCC ticks. Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> - - - - - 4 changed files: - compiler/GHC/Core/Utils.hs - + testsuite/tests/simplCore/should_compile/T26941.hs - + testsuite/tests/simplCore/should_compile/T26941_aux.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -304,58 +304,58 @@ mkCast expr co ********************************************************************* -} -- | Wraps the given expression in the source annotation, dropping the --- annotation if possible. +-- annotation if possible. So +-- mkTick t e = Tick t e +-- except that we may optimise by pushing `t` inwards or dropping it mkTick :: CoreTickish -> CoreExpr -> CoreExpr -mkTick t orig_expr = mkTick' id orig_expr +mkTick t orig_expr = mkTick' orig_expr where -- Some ticks (cost-centres) can be split in two, with the -- non-counting part having laxer placement properties. - canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t + can_split = tickishCanSplit t - -- mkTick' handles floating of ticks *into* the expression. - mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with) - -- Always a composition of (Tick t) wrappers - -> CoreExpr -- Current expression - -> CoreExpr - -- So in the call (mkTick' rest e), the expression - -- (rest e) - -- has the same type as e - -- Returns an expression equivalent to (Tick t (rest e)) - mkTick' rest expr = case expr of - -- Float ticks into unsafe coerce the same way we would do with a cast. - Case scrut bndr ty alts@[Alt ac abs _rhs] - | Just rhs <- isUnsafeEqualityCase scrut bndr alts - -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)] + stop_here e = Tick t e -- Just wrap `t` around the current expression + -- That's the default option! - -- Cost centre ticks should never be reordered relative to each - -- other. Therefore we can stop whenever two collide. + -- mkTick' handles floating of tick `t` *into* the expression. + mkTick' :: CoreExpr -> CoreExpr + mkTick' expr = case expr of Tick t2 e - | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr + | ProfNote { profNoteCC = cc1, profNoteCount = cnt1, profNoteScope = scope1 } <- t + , ProfNote { profNoteCC = cc2, profNoteCount = cnt2, profNoteScope = scope2 } <- t2 + -> + -- If the two ticks share the same cost centre and at most one of them + -- counts, then we can merge the two. + if cc1 == cc2 && (not cnt1 || not cnt2) + then + let t' = ProfNote { profNoteCC = cc1 + , profNoteCount = cnt1 || cnt2 + , profNoteScope = scope1 || scope2 + } + in mkTick t' expr + else + -- Cost centre ticks for different cost centres should never be reordered + -- relative to each other. Therefore we can stop whenever two collide. + stop_here expr + + | tickishPlace t2 /= tickishPlace t + -> -- Otherwise, we assume that ticks of different + -- placements float through each other. + Tick t2 $ mkTick' e + + -- For source note ticks, this is where we make sure to + -- not introduce redundant ticks. + | tickishContains t t2 -> mkTick' e -- Drop t2 + | tickishContains t2 t -> expr -- Drop t - -- Otherwise we assume that ticks of different placements float - -- through each other. - | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e - - -- For annotations this is where we make sure to not introduce - -- redundant ticks. - | tickishContains t t2 -> mkTick' rest e -- Drop t2 - | tickishContains t2 t -> rest e -- Drop t - | otherwise -> mkTick' (rest . Tick t2) e - - -- Ticks don't care about types, so we just float all ticks - -- through them. Note that it's not enough to check for these - -- cases top-level. While mkTick will never produce Core with type - -- expressions below ticks, such constructs can be the result of - -- unfoldings. We therefore make an effort to put everything into - -- the right place no matter what we start with. - Cast e co -> mkCast (mkTick' rest e) co - Coercion co -> Tick t $ rest (Coercion co) + | otherwise + -> stop_here expr -- Always safe Lam x e -- Always float through type lambdas. Even for non-type lambdas, -- floating is allowed for all but the most strict placement rule. | not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime - -> Lam x $ mkTick' rest e + -> Lam x $ mkTick' e -- If it is both counting and scoped, we split the tick into its -- two components, often allowing us to keep the counting tick on @@ -363,26 +363,41 @@ mkTick t orig_expr = mkTick' id orig_expr -- The point of this is that the counting tick can probably be -- floated, and the lambda may then be in a position to be -- beta-reduced. - | canSplit - -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e + | can_split + -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e App f arg -- Always float through type applications. | not (isRuntimeArg arg) - -> App (mkTick' rest f) arg + -> App (mkTick' f) arg -- We can also float through constructor applications, placement -- permitting. Again we can split. - | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit) + | isSaturatedConApp expr + , tickishPlace t == PlaceCostCentre || can_split -> if tickishPlace t == PlaceCostCentre - then rest $ tickHNFArgs t expr - else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr + then tickHNFArgs t expr + else Tick (mkNoScope t) $ tickHNFArgs (mkNoCount t) expr + + -- Ticks don't care about types, so we just float all ticks + -- through them. Note that it's not enough to check for these + -- cases at the top-level. While mkTick will never produce Core with type + -- expressions below ticks, such constructs can be the result of + -- unfoldings. We therefore make an effort to put everything into + -- the right place no matter what we start with. + Cast e co -> mkCast (mkTick' e) co + + -- Float ticks into 'unsafeCoerce' the same way we would do with a cast. + Case scrut bndr ty alts@[Alt ac abs _rhs] + | Just rhs <- isUnsafeEqualityCase scrut bndr alts + -> Case scrut bndr ty [Alt ac abs (mkTick' rhs)] Var x - | notFunction && tickishPlace t == PlaceCostCentre - -> rest expr -- Drop t - | notFunction && canSplit - -> Tick (mkNoScope t) $ rest expr + | notFunction + , tickishPlace t == PlaceCostCentre || can_split + -> if tickishPlace t == PlaceCostCentre + then expr -- Drop tick t entirely + else Tick (mkNoScope t) expr where -- SCCs can be eliminated on variables provided the variable -- is not a function. In these cases the SCC makes no difference: @@ -392,12 +407,24 @@ mkTick t orig_expr = mkTick' id orig_expr -- when the function is called, so we must retain those. notFunction = not (isFunTy (idType x)) + Coercion co + -- Make sure to drop SCCs around coercions, to avoid generating Core + -- of the form 'let co = scc<foo> <Int>_N' (which Core Lint isn't happy with). + -- See #26941. + | tickishPlace t == PlaceCostCentre + -> Coercion co -- Drop tick t entirely + | can_split + -> Tick (mkNoScope t) expr + Lit{} | tickishPlace t == PlaceCostCentre - -> rest expr -- Drop t + -> expr -- Drop tick t entirely + | can_split + -> Tick (mkNoScope t) expr - -- Catch-all: Annotate where we stand - _any -> Tick t $ rest expr + -- Catch-all: Annotate where we stand. + -- Used for Type, Let, most Cases + _any -> Tick t expr mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr mkTicks ticks expr = foldr mkTick expr ticks ===================================== testsuite/tests/simplCore/should_compile/T26941.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} + +module T26941 where + +import GHC.TypeLits + +import T26941_aux ( SMayNat(SKnown), ListH, shxHead ) + +shsHead :: ListH (Just n : sh) Int -> SNat n +shsHead shx = + case shxHead shx of + SKnown SNat -> SNat ===================================== testsuite/tests/simplCore/should_compile/T26941_aux.hs ===================================== @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE TypeOperators #-} + +module T26941_aux where + +import Data.Kind +import GHC.TypeLits + +shxHead :: ListH (n : sh) i -> SMayNat i n +shxHead list = {-# SCC "bad_scc" #-} + ( case list of (i `ConsKnown` _) -> SKnown i ) + +type ListH :: [Maybe Nat] -> Type -> Type +data ListH sh i where + ConsKnown :: SNat n -> ListH sh i -> ListH (Just n : sh) i + +data SMayNat i n where + SKnown :: SNat n -> SMayNat i (Just n) ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -568,6 +568,8 @@ test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniqu test('T26349', normal, compile, ['-O -ddump-rules']) test('T26681', normal, compile, ['-O']) +test('T26941', [extra_files(['T26941_aux.hs']), req_profiling], multimod_compile, ['T26941', '-v0 -O -prof']) + # T26709: we expect three `case` expressions not four test('T26709', [grep_errmsg(r'case')], multimod_compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/344c1fb30ab19acf169ad474e6ee34a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/344c1fb30ab19acf169ad474e6ee34a… You're receiving this email because of your account on gitlab.haskell.org.

1 0