11 May
2026
11 May
'26
4:23 p.m.
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
e55d1e73 by Wolfgang Jeltsch at 2026-05-11T12:23:14-04:00
Move the `Text.Read` implementation into `base`
- - - - -
f127d6b8 by Vladislav Zavialov at 2026-05-11T12:23:15-04:00
EPA: Use AnnParen for tuples and sums
Summary of changes
* Do not use AnnParen in XListTy, replace it with EpToken "[" and "]"
* Specialise AnnParen to tuple/sums by dropping the AnnParensSquare
and keeping only AnnParens and AnnParensHash
* Use AnnParen in XExplicitTuple
* Use AnnParen in XExplicitTupleTy
* Use AnnParen in XTuplePat
* Use AnnParen in XExplicitSum (via AnnExplicitSum)
* Use AnnParen in XSumPat (via EpAnnSumPat)
This is a refactoring with no user-facing changes.
- - - - -
d8a6ac65 by Alice Rixte at 2026-05-11T12:23:23-04:00
Script for downloading and copying `base-exports` file
- - - - -
27 changed files:
- + changelog.d/ghc-api-epa-parens
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- libraries/base/src/Data/Functor/Classes.hs
- libraries/base/src/Data/Functor/Compose.hs
- libraries/base/src/Prelude.hs
- libraries/base/src/Text/Read.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- − libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- testsuite/tests/ghc-api/T25121_status.stdout
- + testsuite/tests/interface-stability/.gitignore
- testsuite/tests/interface-stability/README.mkd
- + testsuite/tests/interface-stability/download-base-exports.sh
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/th/T24111.stdout
- testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T21130.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
changelog.d/ghc-api-epa-parens
=====================================
@@ -0,0 +1,12 @@
+section: ghc-lib
+synopsis: Use ``AnnParen`` for tuples and sums
+issues: #26969
+mrs: !15836
+
+description: {
+Do not use ``AnnParen`` in ``XListTy``, replacing it with ``EpToken "["`` and ``"]"``,
+and specialise it to tuples/sums by dropping the ``AnnParensSquare`` constructor,
+keeping only ``AnnParens`` and ``AnnParensHash``. Use ``AnnParen`` in ``XExplicitTuple``,
+``XExplicitTupleTy``, ``XTuplePat``, ``XExplicitSum`` (via ``AnnExplicitSum``), and
+``XSumPat`` (via ``EpAnnSumPat``).
+}
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -221,7 +221,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
NoBlankEpAnnotations -> parens (case ap of
(AnnParens o c) -> text "AnnParens" $$ vcat [showAstData' o, showAstData' c]
(AnnParensHash o c) -> text "AnnParensHash" $$ vcat [showAstData' o, showAstData' c]
- (AnnParensSquare o c) -> text "AnnParensSquare" $$ vcat [showAstData' o, showAstData' c]
)
annClassDecl :: AnnClassDecl -> SDoc
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -264,7 +264,7 @@ type instance XPar GhcPs = (EpToken "(", EpToken ")")
type instance XPar GhcRn = NoExtField
type instance XPar GhcTc = NoExtField
-type instance XExplicitTuple GhcPs = (EpaLocation, EpaLocation)
+type instance XExplicitTuple GhcPs = AnnParen
type instance XExplicitTuple GhcRn = NoExtField
type instance XExplicitTuple GhcTc = NoExtField
@@ -554,14 +554,13 @@ mkHsVarWithUserRdr rdr n = HsVar noExtField $
data AnnExplicitSum
= AnnExplicitSum {
- aesOpen :: EpaLocation,
+ aesParens :: AnnParen,
aesBarsBefore :: [EpToken "|"],
- aesBarsAfter :: [EpToken "|"],
- aesClose :: EpaLocation
+ aesBarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn AnnExplicitSum where
- noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
+ noAnn = AnnExplicitSum noAnn noAnn noAnn
data AnnFieldLabel
= AnnFieldLabel {
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -113,7 +113,7 @@ type instance XListPat GhcRn = NoExtField
type instance XListPat GhcTc = Type
-- List element type, for use in hsPatType.
-type instance XTuplePat GhcPs = (EpaLocation, EpaLocation)
+type instance XTuplePat GhcPs = AnnParen
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
@@ -263,13 +263,13 @@ discarded inside tcMatchPats, where we know if visible pattern retained or erase
-- API Annotations types
data EpAnnSumPat = EpAnnSumPat
- { sumPatParens :: (EpaLocation, EpaLocation)
+ { sumPatParens :: AnnParen
, sumPatVbarsBefore :: [EpToken "|"]
, sumPatVbarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn EpAnnSumPat where
- noAnn = EpAnnSumPat (noAnn, noAnn) [] []
+ noAnn = EpAnnSumPat noAnn [] []
-- ---------------------------------------------------------------------
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -445,7 +445,7 @@ type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpToken "'"
type instance XAppTy (GhcPass _) = NoExtField
type instance XFunTy (GhcPass _) = NoExtField
-type instance XListTy (GhcPass _) = AnnParen
+type instance XListTy (GhcPass _) = (EpToken "[", EpToken "]")
type instance XTupleTy (GhcPass _) = AnnParen
type instance XSumTy (GhcPass _) = AnnParen
type instance XOpTy (GhcPass _) = NoExtField
@@ -470,7 +470,7 @@ type instance XExplicitListTy GhcPs = (EpToken "'", EpToken "[", EpToken "]")
type instance XExplicitListTy GhcRn = NoExtField
type instance XExplicitListTy GhcTc = Kind
-type instance XExplicitTupleTy GhcPs = (EpToken "'", EpToken "(", EpToken ")")
+type instance XExplicitTupleTy GhcPs = (EpToken "'", AnnParen)
type instance XExplicitTupleTy GhcRn = NoExtField
type instance XExplicitTupleTy GhcTc = [Kind]
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2398,14 +2398,14 @@ atype :: { LHsType GhcPs }
| '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE '(' ')' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) IsPromoted []) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $3)) IsPromoted []) }}
| SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }
| SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)
; amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}
| SIMPLEQUOTE '(' ktype ',' comma_types1 ')'
{% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; h <- addTrailingCommaA $3 (epTok $4)
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) IsPromoted (h : $5)) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $6)) IsPromoted (h : $5)) }}
| '[' ']' {% withCombinedComments $1 $> (mkListSyntaxTy0 (epTok $1) (epTok $2)) }
| SIMPLEQUOTE '[' comma_types0 ']' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; amsA' (sLL $1 $> $ HsExplicitListTy (epTok $1, epTok $2, epTok $4) IsPromoted $3) }}
@@ -3221,7 +3221,7 @@ aexp2 :: { ECP }
| '(' tup_exprs ')' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2
- (glR $1,glR $3)}
+ (AnnParens (epTok $1) (epTok $3))}
| '(' orpats(exp2) ')' {% do
{ pat <- hintOrPats (sL1a $2 (OrPat NoExtField (unLoc $2)))
@@ -3237,11 +3237,11 @@ aexp2 :: { ECP }
| '(#' texp '#)' { ECP $
unECP $2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed (Tuple [Right $2])
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '(#' tup_exprs '#)' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed $2
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '[' list ']' { ECP $ $2 (comb2 $1 $>) (glR $1,glR $3) }
| '_' { ECP $ mkHsWildCardPV (getLoc $1) }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -552,12 +552,11 @@ data AnnListBrackets
-- Annotations for parenthesised elements, such as tuples, lists
-- ---------------------------------------------------------------------
--- | exact print annotation for an item having surrounding "brackets", such as
--- tuples or lists
+-- | exact print annotation for an item having parentheses, with or without
+-- the hash symbol, e.g. tuples, unboxed tuples, unboxed sums
data AnnParen
= AnnParens (EpToken "(") (EpToken ")") -- ^ '(', ')'
| AnnParensHash (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)'
- | AnnParensSquare (EpToken "[") (EpToken "]") -- ^ '[', ']'
deriving Data
-- ---------------------------------------------------------------------
@@ -1219,7 +1218,6 @@ instance (Outputable e)
instance Outputable AnnParen where
ppr (AnnParens o c) = text "AnnParens" <+> ppr o <+> ppr c
ppr (AnnParensHash o c) = text "AnnParensHash" <+> ppr o <+> ppr c
- ppr (AnnParensSquare o c) = text "AnnParensSquare" <+> ppr o <+> ppr c
instance Outputable AnnListItem where
ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1228,17 +1228,11 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
-- With NoListTuplePuns, contexts are parsed as data constructors, which causes failure
-- downstream.
-- This converts them just like when they are parsed as types in the punned case.
- check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) _ ts))
- = punsAllowed >>= \case
- True -> unprocessed
- False -> do
- let
- (op, cp) = case q of
- EpTok ql -> ([EpTok ql], [c])
- _ -> ([o], [c])
- mkCTuple (oparens ++ op, cp ++ cparens, cs) ts
+ check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (_, AnnParens o c) NotPromoted ts))
+ = mkCTuple (oparens ++ [o], c : cparens, cs) ts
+
check (opi,cpi,csi) (L _lp1 (HsParTy (o,c) ty))
- -- to be sure HsParTy doesn't get into the way
+ -- to be sure HsParTy doesn't get in the way
= check (o:opi, c:cpi, csi) ty
-- No need for anns, returning original
@@ -1269,11 +1263,10 @@ checkContextExpr orig_expr@(L (EpAnn l _ cs) _) =
where
check :: ([EpToken "("],[EpToken ")"],EpAnnComments)
-> LHsExpr GhcPs -> PV (LocatedC [LHsExpr GhcPs])
- check (oparens,cparens,cs) (L _ (ExplicitTuple (ap_open, ap_close) tup_args boxity))
+ check (oparens,cparens,cs) (L _ (ExplicitTuple (AnnParens open_tok close_tok) tup_args Boxed))
-- Neither unboxed tuples (#e1,e2#) nor tuple sections (e1,,e2,) can be a context
- | isBoxed boxity
- , Just es <- tupArgsPresent_maybe tup_args
- = mkCTuple (oparens ++ [EpTok ap_open], EpTok ap_close : cparens, cs) es
+ | Just es <- tupArgsPresent_maybe tup_args
+ = mkCTuple (oparens ++ [open_tok], close_tok : cparens, cs) es
check (opi, cpi, csi) (L _ (HsPar (open_tok, close_tok) expr))
= check (opi ++ [open_tok], close_tok : cpi, csi) expr
check (oparens,cparens,cs) (L _ (HsVar _ (L (EpAnn _ (NameAnnOnly (NameParens open closed) []) _) name)))
@@ -1861,7 +1854,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
mkHsBangPatPV :: SrcSpan -> LocatedA b -> EpToken "!" -> PV (LocatedA b)
-- | Disambiguate tuple sections and unboxed sums
mkSumOrTuplePV
- :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> (EpaLocation, EpaLocation) -> PV (LocatedA b)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> AnnParen -> PV (LocatedA b)
-- | Disambiguate "type t" (embedded type)
mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate modifiers (%a)
@@ -3694,7 +3687,7 @@ hintBangPat span e = do
addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalBangPattern e
mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
- -> (EpaLocation, EpaLocation)
+ -> AnnParen
-> PV (LHsExpr GhcPs)
-- Tuple
@@ -3709,15 +3702,15 @@ mkSumOrTupleExpr l@(EpAnn anc an csIn) boxity (Tuple es) anns = do
-- Sum
-- mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
-- return $ L l (ExplicitSum noExtField alt arity e)
-mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) (o, c) = do
- let an = AnnExplicitSum o barsp barsa c
+mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) anns = do
+ let an = AnnExplicitSum anns barsp barsa
!cs <- getCommentsFor (locA l)
return $ L (EpAnn anc anIn (csIn Semi.<> cs)) (ExplicitSum an alt arity e)
mkSumOrTupleExpr l Boxed a@Sum{} _ =
addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrUnsupportedBoxedSumExpr a
mkSumOrTuplePat
- :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> (EpaLocation, EpaLocation)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> AnnParen
-> PV (LocatedA (PatBuilder GhcPs))
-- Tuple
@@ -3843,7 +3836,7 @@ mkTupleSyntaxTy parOpen args parClose =
HsExplicitTupleTy annsKeyword NotPromoted args
annParen = AnnParens parOpen parClose
- annsKeyword = (NoEpTok, parOpen, parClose)
+ annsKeyword = (NoEpTok, annParen)
-- | Decide whether to parse tuple con syntax @(,)@ in a type as a
-- type or data constructor, based on the extension @ListTuplePuns@.
@@ -3895,7 +3888,7 @@ mkListSyntaxTy1 brkOpen t brkClose =
HsExplicitListTy annsKeyword NotPromoted [t]
annsKeyword = (NoEpTok, brkOpen, brkClose)
- annParen = AnnParensSquare brkOpen brkClose
+ annParen = (brkOpen, brkClose)
parseError :: HsExpr GhcPs
parseError = HsHole HoleError
=====================================
libraries/base/src/Data/Functor/Classes.hs
=====================================
@@ -85,7 +85,7 @@ import GHC.Internal.Read (expectP, list, paren, readField)
import GHC.Internal.Show (appPrec)
import GHC.Internal.Text.ParserCombinators.ReadPrec (ReadPrec, readPrec_to_S, readS_to_Prec, pfail)
-import GHC.Internal.Text.Read (Read(..), parens, prec, step, reset)
+import Text.Read (Read(..), parens, prec, step, reset)
import GHC.Internal.Text.Read.Lex (Lexeme(..))
import GHC.Internal.Text.Show (showListWith)
import Prelude
=====================================
libraries/base/src/Data/Functor/Compose.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Internal.Data.Foldable (Foldable(..))
import GHC.Internal.Data.Monoid (Sum(..), All(..), Any(..), Product(..))
import GHC.Internal.Data.Type.Equality (TestEquality(..), (:~:)(..))
import GHC.Generics (Generic, Generic1)
-import GHC.Internal.Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
+import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
import Prelude
infixr 9 `Compose`
=====================================
libraries/base/src/Prelude.hs
=====================================
@@ -179,7 +179,7 @@ import GHC.Internal.Data.Tuple
import GHC.Internal.Base hiding ( foldr, mapM, sequence )
import GHC.Internal.Classes
import GHC.Internal.Err
-import GHC.Internal.Text.Read
+import Text.Read
import GHC.Internal.Enum
import GHC.Internal.Num
import GHC.Internal.Prim (seq)
=====================================
libraries/base/src/Text/Read.hs
=====================================
@@ -39,5 +39,84 @@ module Text.Read
readMaybe
) where
-import GHC.Internal.Text.Read
+import GHC.Err (errorWithoutStackTrace)
+import GHC.Read
+ (
+ ReadS,
+ Read (readsPrec, readList, readPrec, readListPrec),
+ lex,
+ readParen,
+ readListDefault,
+ lexP,
+ parens,
+ readListPrecDefault
+ )
+import Control.Monad (return)
+import Data.Function (id)
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Either (Either (Left, Right), either)
+import Data.String (String)
+import Text.Read.Lex (Lexeme (Char, String, Punc, Ident, Symbol, Number, EOF))
+import Text.ParserCombinators.ReadP (skipSpaces)
import Text.ParserCombinators.ReadPrec
+
+-- $setup
+-- >>> import Prelude
+
+------------------------------------------------------------------------
+-- utility functions
+
+-- | equivalent to 'readsPrec' with a precedence of 0.
+reads :: Read a => ReadS a
+reads = readsPrec minPrec
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+-- A 'Left' value indicates a parse error.
+--
+-- >>> readEither "123" :: Either String Int
+-- Right 123
+--
+-- >>> readEither "hello" :: Either String Int
+-- Left "Prelude.read: no parse"
+--
+-- @since base-4.6.0.0
+readEither :: Read a => String -> Either String a
+readEither s =
+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+ [x] -> Right x
+ [] -> Left "Prelude.read: no parse"
+ _ -> Left "Prelude.read: ambiguous parse"
+ where
+ read' =
+ do x <- readPrec
+ lift skipSpaces
+ return x
+
+-- | Parse a string using the 'Read' instance.
+-- Succeeds if there is exactly one valid result.
+--
+-- >>> readMaybe "123" :: Maybe Int
+-- Just 123
+--
+-- >>> readMaybe "hello" :: Maybe Int
+-- Nothing
+--
+-- @since base-4.6.0.0
+readMaybe :: Read a => String -> Maybe a
+readMaybe s = case readEither s of
+ Left _ -> Nothing
+ Right a -> Just a
+
+-- | The 'read' function reads input from a string, which must be
+-- completely consumed by the input process. 'read' fails with an 'error' if the
+-- parse is unsuccessful, and it is therefore discouraged from being used in
+-- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
+--
+-- >>> read "123" :: Int
+-- 123
+--
+-- >>> read "hello" :: Int
+-- *** Exception: Prelude.read: no parse
+read :: Read a => String -> a
+read s = either errorWithoutStackTrace id (readEither s)
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -329,7 +329,6 @@ Library
GHC.Internal.System.Posix.Types
GHC.Internal.Text.ParserCombinators.ReadP
GHC.Internal.Text.ParserCombinators.ReadPrec
- GHC.Internal.Text.Read
GHC.Internal.Text.Read.Lex
GHC.Internal.Text.Show
GHC.Internal.Type.Reflection
=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
=====================================
@@ -46,7 +46,7 @@ import GHC.Internal.IO.Encoding.Types
import qualified GHC.Internal.IO.Encoding.Iconv as Iconv
#else
import qualified GHC.Internal.IO.Encoding.CodePage as CodePage
-import GHC.Internal.Text.Read (reads)
+import GHC.Internal.Read (readsPrec)
#endif
import qualified GHC.Internal.IO.Encoding.Latin1 as Latin1
import qualified GHC.Internal.IO.Encoding.UTF8 as UTF8
@@ -319,7 +319,8 @@ mkTextEncoding' cfm enc =
_ | isAscii -> return (Latin1.mkAscii cfm)
_ | isLatin1 -> return (Latin1.mkLatin1_checked cfm)
#if defined(mingw32_HOST_OS)
- 'C':'P':n | [(cp,"")] <- reads n -> return $ CodePage.mkCodePageEncoding cfm cp
+ 'C':'P':n | [(cp,"")] <- readsPrec 0 n -> return $ CodePage.mkCodePageEncoding cfm cp
+ -- 'readsPrec 0' is the same as 'reads', but 'reads' is only defined in @base@.
_ -> unknownEncodingErr (enc ++ codingFailureModeSuffix cfm)
#else
-- Otherwise, handle other encoding needs via iconv.
=====================================
libraries/ghc-internal/src/GHC/Internal/Text/Read.hs deleted
=====================================
@@ -1,115 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.Text.Read
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries@haskell.org
--- Stability : provisional
--- Portability : non-portable (uses Text.ParserCombinators.ReadP)
---
--- Converting strings to values.
---
--- The "Text.Read" library is the canonical library to import for
--- 'Read'-class facilities. For GHC only, it offers an extended and much
--- improved 'Read' class, which constitutes a proposed alternative to the
--- Haskell 2010 'Read'. In particular, writing parsers is easier, and
--- the parsers are much more efficient.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.Text.Read (
- -- * The 'Read' class
- Read(..),
- ReadS,
-
- -- * Haskell 2010 functions
- reads,
- read,
- readParen,
- lex,
-
- -- * New parsing functions
- module GHC.Internal.Text.ParserCombinators.ReadPrec,
- L.Lexeme(..),
- lexP,
- parens,
- readListDefault,
- readListPrecDefault,
- readEither,
- readMaybe
-
- ) where
-
-import GHC.Internal.Base (String, id, return)
-import GHC.Internal.Err (errorWithoutStackTrace)
-import GHC.Internal.Maybe (Maybe(..))
-import GHC.Internal.Read
-import GHC.Internal.Data.Either
-import GHC.Internal.Text.ParserCombinators.ReadP as P
-import GHC.Internal.Text.ParserCombinators.ReadPrec
-import qualified GHC.Internal.Text.Read.Lex as L
-
--- $setup
--- >>> import Prelude
-
-------------------------------------------------------------------------
--- utility functions
-
--- | equivalent to 'readsPrec' with a precedence of 0.
-reads :: Read a => ReadS a
-reads = readsPrec minPrec
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
--- A 'Left' value indicates a parse error.
---
--- >>> readEither "123" :: Either String Int
--- Right 123
---
--- >>> readEither "hello" :: Either String Int
--- Left "Prelude.read: no parse"
---
--- @since base-4.6.0.0
-readEither :: Read a => String -> Either String a
-readEither s =
- case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
- [x] -> Right x
- [] -> Left "Prelude.read: no parse"
- _ -> Left "Prelude.read: ambiguous parse"
- where
- read' =
- do x <- readPrec
- lift P.skipSpaces
- return x
-
--- | Parse a string using the 'Read' instance.
--- Succeeds if there is exactly one valid result.
---
--- >>> readMaybe "123" :: Maybe Int
--- Just 123
---
--- >>> readMaybe "hello" :: Maybe Int
--- Nothing
---
--- @since base-4.6.0.0
-readMaybe :: Read a => String -> Maybe a
-readMaybe s = case readEither s of
- Left _ -> Nothing
- Right a -> Just a
-
--- | The 'read' function reads input from a string, which must be
--- completely consumed by the input process. 'read' fails with an 'error' if the
--- parse is unsuccessful, and it is therefore discouraged from being used in
--- real applications. Use 'readMaybe' or 'readEither' for safe alternatives.
---
--- >>> read "123" :: Int
--- 123
---
--- >>> read "hello" :: Int
--- *** Exception: Prelude.read: no parse
-read :: Read a => String -> a
-read s = either errorWithoutStackTrace id (readEither s)
=====================================
testsuite/tests/ghc-api/T25121_status.stdout
=====================================
@@ -18,8 +18,8 @@ X(ExplicitList) mismatch
>>> AnnList ()
<<< ((EpToken "'"),(EpToken "["),(EpToken "]"))
X(ExplicitTuple) mismatch
- >>> ((EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]),(EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]))
- <<< ((EpToken "'"),(EpToken "("),(EpToken ")"))
+ >>> AnnParen
+ <<< ((EpToken "'"),AnnParen)
X(Hole) match = HoleKind
Extension fields @GhcRn
=====================================
testsuite/tests/interface-stability/.gitignore
=====================================
@@ -0,0 +1 @@
+download-base-exports
=====================================
testsuite/tests/interface-stability/README.mkd
=====================================
@@ -1,6 +1,6 @@
# Interface stability testing
-The tests in this directory verify that the interfaces of exposed by GHC's
+The tests in this directory verify that the interfaces exposed by GHC's
core libraries do not inadvertently change. They use the `utils/dump-decls`
utility to dump all exported declarations of all exposed modules for the
following packages:
@@ -27,7 +27,9 @@ The `base-exports` test in particular has rather platform-dependent output.
Consequently, updating its output can be a bit tricky. There are two ways by
which one can do this:
- * Extrapolation: The various platforms' `base-exports.stdout` files are
+#### Extrapolation
+
+The various platforms' `base-exports.stdout` files are
similar enough that one can often apply the same patch of one file to the
others. For instance:
```
@@ -40,8 +42,44 @@ which one can do this:
In the case of conflicts, increasing the fuzz factor (using `-F`) can be
quite effective.
- * Using CI: Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
+#### Using CI
+
+Each CI job produces a tarball, `unexpected-test-output.tar.gz`,
which contains the output produced by the job's failing tests. Simply
- download this tarball and extracting the appropriate `base-exports.stdout-*`
+ download this tarball and extract the appropriate `base-exports.stdout-*`
files into this directory.
+Doing this by hand is of course very annoying. To make things faster, use the script in this folder called `download.base-exports.sh` :
+
+* Running for the first time
+ 1. Find the URL for downloading unexpected-test-output.tar.gz. To do so
+ * Go to the CI job page you want to download
+ * Click on "Browse"
+ * Find unexpected-test-output.tar.gz
+ * Right-click the download link then "Copy link" (Firefox)
+ 2. The URL should look like this :
+ `https://gitlab.haskell.org/ghc/ghc/-/jobs/2503744/artifacts/file/unexpected-test-output.tar.gz`
+ * the prefix is : `https://gitlab.haskell.org/ghc/ghc/-/jobs/`
+ * the job ID is : `2503744`
+ * and the suffix : `/artifacts/file/unexpected-test-output.tar.gz`
+ 3. The script prompts you with URL prefix and suffix.
+ 4. It will save a file to remember this, so you only need to do this once.
+ 5. If you need to change the URL, just edit the file `download-base-exports/url-unexpected-test-output` directly.
+
+* Downloading the artifacts
+ 1. Find all the job IDs you want to download. For this, just go to the jobs
+ page `https://gitlab.haskell.org//ghc/-/jobs`
+ 2. Make sure you get all the artifacts. You need 3 of them.
+ To get all 3 CI jobs, the label `javascript` must be on the MR.
+ If you don't have the rights for adding these labels, ask.
+ 1. The `x86` CI job for darwin or linux : `base-exports.stdout`
+ 2. The `windows` job : `base-exports.stdout-mingw32`
+ 3. The `javascript` CI job :
+ `base-exports.stdout-javascript-unknown-ghcjs`
+ 3. Run the script with all the job IDs :
+ `./download-base-exports.sh 2502789 2502792 2502793`
+
+ Using a range downloads more artifacts than necessary, but is a
+ no-brainer:
+
+ `./download-base-exports.sh {2502789..2502795}`
=====================================
testsuite/tests/interface-stability/download-base-exports.sh
=====================================
@@ -0,0 +1,55 @@
+#!/usr/bin/env bash
+
+# See the README file in this folder for usage
+
+jobIDs=("$@")
+
+BASE_DIR_NAME=download-base-exports
+DL_DIR_NAME=dl
+BASE_DIR="$(dirname "$0")/$BASE_DIR_NAME"
+DL_DIR=$BASE_DIR/$DL_DIR_NAME
+URL_FILE="$BASE_DIR/url-unexpected-test-output"
+
+DEFAULT_PREFIX="https://gitlab.haskell.org/ghc/ghc/-/jobs/"
+DEFAULT_POSTFIX="/artifacts/raw/unexpected-test-output.tar.gz"
+
+mkdir -p "$BASE_DIR"
+
+# URL configuration for finding unexpected-test-output.tar.gz
+
+if [[ ! -f "$URL_FILE" ]]; then
+ echo "No URL for unexpected-test-output.tar.gz was found"
+
+ read -p "Enter job URL prefix [${DEFAULT_PREFIX}]: " inputPrefix
+ read -p "Enter job URL postfix [${DEFAULT_POSTFIX}]: " inputPostfix
+
+ urlPrefix="${inputPrefix:-$DEFAULT_PREFIX}"
+ urlPostfix="${inputPostfix:-$DEFAULT_POSTFIX}"
+
+ {
+ echo "urlPrefix=$urlPrefix"
+ echo "urlPostfix=$urlPostfix"
+ } > "$URL_FILE"
+else
+ source "$URL_FILE"
+fi
+
+mkdir -p $DL_DIR
+
+echo "urlPrefix: $urlPrefix"
+echo "jobIDs: $jobIDs"
+echo "urlPostfix: $urlPostfix"
+echo ""
+echo "Downloading unexpected-test-output.tar.gz for each job ..."
+
+# Download and copy base-exports* files
+
+for jobID in "${jobIDs[@]}"; do
+ unexpectedOutputUrl="$urlPrefix$jobID$urlPostfix"
+
+ wget -O "$DL_DIR/job$jobID.tar.gz" $unexpectedOutputUrl
+
+ mkdir -p "$DL_DIR/job$jobID"
+ tar -xzf "$DL_DIR/job$jobID.tar.gz" -C "$DL_DIR/job$jobID"
+ cp "$DL_DIR/job$jobID"/unexpected-test-output/testsuite/tests/interface-stability/base-exports* "$BASE_DIR/.."
+done
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -274,7 +274,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:9:16 }))
(EpTok
@@ -656,7 +656,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:10:27 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -602,7 +602,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:12:27 }))
(EpTok
@@ -710,7 +710,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:11:16 }))
(EpTok
@@ -1930,7 +1930,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:31:12 }))
(EpTok
@@ -1995,7 +1995,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:32:10 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -728,7 +728,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:19:12 }))
(EpTok
@@ -1424,13 +1424,14 @@
(EpaComments
[]))
(HsExplicitTupleTy
- ((,,)
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:16 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:17 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:44 })))
+ (AnnParens
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:17 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:44 }))))
(IsPromoted)
[(L
(EpAnn
@@ -1508,7 +1509,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:34 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -458,7 +458,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:8:57 }))
(EpTok
@@ -705,7 +705,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:9:57 }))
(EpTok
=====================================
testsuite/tests/th/T24111.stdout
=====================================
@@ -3,6 +3,6 @@ pattern (:+_0) :: GHC.Internal.Types.Int ->
(GHC.Internal.Types.Int, GHC.Internal.Types.Int)
pattern x_1 :+_0 y_2 = (x_1, y_2)
pattern A_0 :: GHC.Internal.Types.Int -> GHC.Internal.Base.String
-pattern A_0 n_1 <- (GHC.Internal.Text.Read.read -> n_1) where
+pattern A_0 n_1 <- (Text.Read.read -> n_1) where
A_0 0 = "hi"
A_0 1 = "bye"
=====================================
testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
=====================================
@@ -11,14 +11,13 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef
words :: String -> [String]
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.Data.OldList’))
- read :: forall a. Read a => String -> a
- with read @[String]
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Text.Read’))
repeat :: forall a. a -> [a]
with repeat @String
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.List’))
+ read :: forall a. Read a => String -> a
+ with read @[String]
+ (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
mempty :: forall a. Monoid a => a
with mempty @(String -> [String])
(imported from ‘Prelude’
=====================================
testsuite/tests/typecheck/should_fail/T21130.stderr
=====================================
@@ -6,6 +6,9 @@ T21130.hs:10:6: error: [GHC-88464]
In an equation for ‘x’: x = (_ f) :: Int
• Relevant bindings include x :: Int (bound at T21130.hs:10:1)
Valid hole fits include
+ read :: forall a. Read a => String -> a
+ with read @Int
+ (imported from ‘Prelude’ (and originally defined in ‘Text.Read’))
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
with head @Int
(imported from ‘Prelude’
@@ -14,10 +17,6 @@ T21130.hs:10:6: error: [GHC-88464]
with last @Int
(imported from ‘Prelude’
(and originally defined in ‘GHC.Internal.List’))
- read :: forall a. Read a => String -> a
- with read @Int
- (imported from ‘Prelude’
- (and originally defined in ‘GHC.Internal.Text.Read’))
T21130.hs:10:8: error: [GHC-39999]
• Ambiguous type variable ‘t0’ arising from a use of ‘f’
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -858,9 +858,6 @@ markParenO (AnnParens o c) = do
markParenO (AnnParensHash o c) = do
o' <- markEpToken o
return (AnnParensHash o' c)
-markParenO (AnnParensSquare o c) = do
- o' <- markEpToken o
- return (AnnParensSquare o' c)
markParenC :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markParenC (AnnParens o c) = do
@@ -869,9 +866,6 @@ markParenC (AnnParens o c) = do
markParenC (AnnParensHash o c) = do
c' <- markEpToken c
return (AnnParensHash o c')
-markParenC (AnnParensSquare o c) = do
- c' <- markEpToken c
- return (AnnParensSquare o c')
-- ---------------------------------------------------------------------
-- Bare bones Optics
@@ -1015,15 +1009,14 @@ lsnd k parent = fmap (\new -> (fst parent, new))
-- -------------------------------------
-- data AnnExplicitSum
-- = AnnExplicitSum {
--- aesOpen :: EpaLocation,
+-- aesParens :: AnnParen,
-- aesBarsBefore :: [EpToken "|"],
--- aesBarsAfter :: [EpToken "|"],
--- aesClose :: EpaLocation
+-- aesBarsAfter :: [EpToken "|"]
-- } deriving Data
-laesOpen :: Lens AnnExplicitSum EpaLocation
-laesOpen k parent = fmap (\new -> parent { aesOpen = new })
- (k (aesOpen parent))
+laesParens :: Lens AnnExplicitSum AnnParen
+laesParens k parent = fmap (\new -> parent { aesParens = new })
+ (k (aesParens parent))
laesBarsBefore :: Lens AnnExplicitSum [EpToken "|"]
laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })
@@ -1033,10 +1026,6 @@ laesBarsAfter :: Lens AnnExplicitSum [EpToken "|"]
laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })
(k (aesBarsAfter parent))
-laesClose :: Lens AnnExplicitSum EpaLocation
-laesClose k parent = fmap (\new -> parent { aesClose = new })
- (k (aesClose parent))
-
-- -------------------------------------
-- data AnnFieldLabel
-- = AnnFieldLabel {
@@ -1183,12 +1172,12 @@ lga_sep k parent = fmap (\new -> parent { ga_sep = new })
-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
--- { sumPatParens :: (EpaLocation, EpaLocation)
+-- { sumPatParens :: AnnParen
-- , sumPatVbarsBefore :: [EpToken "|"]
-- , sumPatVbarsAfter :: [EpToken "|"]
-- } deriving Data
-lsumPatParens :: Lens EpAnnSumPat (EpaLocation, EpaLocation)
+lsumPatParens :: Lens EpAnnSumPat AnnParen
lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })
(k (sumPatParens parent))
@@ -2940,23 +2929,21 @@ instance ExactPrint (HsExpr GhcPs) where
expr' <- markAnnotated expr
return (SectionR an op' expr')
- exact (ExplicitTuple (o,c) args b) = do
- o0 <- if b == Boxed then printStringAtAA o "("
- else printStringAtAA o "(#"
+ exact (ExplicitTuple an args b) = do
+ an0 <- markOpeningParen an
args' <- mapM markAnnotated args
- c0 <- if b == Boxed then printStringAtAA c ")"
- else printStringAtAA c "#)"
+ an1 <- markClosingParen an0
debugM $ "ExplicitTuple done"
- return (ExplicitTuple (o0,c0) args' b)
+ return (ExplicitTuple an1 args' b)
exact (ExplicitSum an alt arity expr) = do
- an0 <- markLensFun an laesOpen (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an laesParens markOpeningParen
an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM markEpToken locs)
expr' <- markAnnotated expr
an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 laesClose (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 laesParens markClosingParen
return (ExplicitSum an3 alt arity expr')
exact (HsCase an e alts) = do
@@ -3970,11 +3957,11 @@ instance ExactPrint (HsType GhcPs) where
(mult', ty1') <- markModifiedFunArrOf mult (markAnnotated ty1)
ty2' <- markAnnotated ty2
return (HsFunTy an mult' ty1' ty2')
- exact (HsListTy an tys) = do
- an0 <- markOpeningParen an
- tys' <- markAnnotated tys
- an1 <- markClosingParen an0
- return (HsListTy an1 tys')
+ exact (HsListTy (o,c) t) = do
+ o' <- markEpToken o
+ t' <- markAnnotated t
+ c' <- markEpToken c
+ return (HsListTy (o',c') t')
exact (HsTupleTy an con tys) = do
an0 <- markOpeningParen an
tys' <- markAnnotated tys
@@ -4026,14 +4013,14 @@ instance ExactPrint (HsType GhcPs) where
tys' <- markAnnotated tys
c' <- markEpToken c
return (HsExplicitListTy (sq',o',c') prom tys')
- exact (HsExplicitTupleTy (sq, o, c) prom tys) = do
+ exact (HsExplicitTupleTy (sq, an) prom tys) = do
sq' <- if (isPromoted prom)
then markEpToken sq
else return sq
- o' <- markEpToken o
+ an0 <- markOpeningParen an
tys' <- markAnnotated tys
- c' <- markEpToken c
- return (HsExplicitTupleTy (sq', o', c') prom tys')
+ an1 <- markClosingParen an0
+ return (HsExplicitTupleTy (sq', an1) prom tys')
exact (HsTyLit an lit) = do
lit' <- withPpr lit
return (HsTyLit an lit')
@@ -4713,22 +4700,18 @@ instance ExactPrint (Pat GhcPs) where
(an', pats') <- markAnnList' an (markAnnotated pats)
return (ListPat an' pats')
- exact (TuplePat (o,c) pats boxity) = do
- o0 <- case boxity of
- Boxed -> printStringAtAA o "("
- Unboxed -> printStringAtAA o "(#"
+ exact (TuplePat an pats boxity) = do
+ an0 <- markOpeningParen an
pats' <- markAnnotated pats
- c0 <- case boxity of
- Boxed -> printStringAtAA c ")"
- Unboxed -> printStringAtAA c "#)"
- return (TuplePat (o0,c0) pats' boxity)
+ an1 <- markClosingParen an0
+ return (TuplePat an1 pats' boxity)
exact (SumPat an pat alt arity) = do
- an0 <- markLensFun an (lsumPatParens . lfst) (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an lsumPatParens markOpeningParen
an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM markEpToken locs)
pat' <- markAnnotated pat
an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 (lsumPatParens . lsnd) (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 lsumPatParens markClosingParen
return (SumPat an3 pat' alt arity)
exact (OrPat an pats) = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ede968b68d4d509194460f07b80ef89541d78a7a...d8a6ac65f96d50882bda17ea0378ebc116fd4255
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ede968b68d4d509194460f07b80ef89541d78a7a...d8a6ac65f96d50882bda17ea0378ebc116fd4255
You're receiving this email because of your account on gitlab.haskell.org.