[Git][ghc/ghc][wip/romes/ast-ohne-faststring] the biggest boy
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Jun 12 06:33:47 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/ast-ohne-faststring at Glasgow Haskell Compiler / GHC
Commits:
d9408cc5 by Rodrigo Mesquita at 2024-06-12T07:33:23+01:00
the biggest boy
- - - - -
27 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/check-exact.cabal
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2031,7 +2031,7 @@ pprUntypedSplice True n (HsUntypedSpliceExpr _ e) = ppr_splice (text "$") n e
pprUntypedSplice False n (HsUntypedSpliceExpr _ e) = ppr_splice empty n e
pprUntypedSplice _ _ (HsQuasiQuote _ q s) = ppr_quasi q (unLoc s)
-ppr_quasi :: OutputableBndr p => p -> FastString -> SDoc
+ppr_quasi :: OutputableBndr p => p -> T.Text -> SDoc
ppr_quasi quoter quote = char '[' <> ppr quoter <> vbar <>
ppr quote <> text "|]"
@@ -2411,6 +2411,7 @@ type instance Anno (FieldLabelStrings (GhcPass p)) = EpAnnCO
type instance Anno FieldLabelString = SrcSpanAnnN
type instance Anno FastString = EpAnnCO
+type instance Anno T.Text = EpAnnCO
-- Used in HsQuasiQuote and perhaps elsewhere
type instance Anno (DotFieldOcc (GhcPass p)) = EpAnnCO
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -37,7 +37,6 @@ import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Lit
import qualified Data.Text as T
-import GHC.Data.FastString (unpackFS)
{-
************************************************************************
@@ -223,7 +222,7 @@ instance OutputableBndrId p
instance Outputable OverLitVal where
ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
ppr (HsFractional f) = ppr f
- ppr (HsIsString st s) = pprWithSourceText st (pprHsString (unpackFS s))
+ ppr (HsIsString st s) = pprWithSourceText st (pprHsString (T.unpack s))
-- | pmPprHsLit pretty prints literals and is used when pretty printing pattern
-- match warnings. All are printed the same (i.e., without hashes if they are
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -331,7 +331,7 @@ nlParPat p = noLocA (gParPat p)
mkHsIntegral :: IntegralLit -> HsOverLit GhcPs
mkHsFractional :: FractionalLit -> HsOverLit GhcPs
-mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs
+mkHsIsString :: SourceText -> T.Text -> HsOverLit GhcPs
mkHsDo :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs
mkHsDoAnns :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> AnnList -> HsExpr GhcPs
mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -69,6 +69,7 @@ import GHC.Utils.Panic
import GHC.Core.PatSyn
import Control.Monad
import GHC.Types.Error
+import GHC.Data.FastString
{-
************************************************************************
@@ -611,7 +612,7 @@ ds_prag_expr (HsPragSCC _ cc) expr = do
then do
mod_name <- getModule
count <- goptM Opt_ProfCountEntries
- let nm = sl_fs cc
+ let nm = mkFastStringText $ sl_fs cc
flavour <- mkExprCCFlavour <$> getCCIndexDsM nm
Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True)
<$> dsLExpr expr
=====================================
compiler/GHC/HsToCore/Foreign/C.hs
=====================================
@@ -60,6 +60,7 @@ import GHC.Utils.Encoding
import Data.Maybe
import Data.List (nub)
+import qualified Data.Text as T
dsCFExport:: Id -- Either the exported Id,
-- or the foreign-export-dynamic constructor
@@ -344,7 +345,7 @@ toCType = f False
-- anything, as it may be the synonym that is annotated.
| Just tycon <- tyConAppTyConPicky_maybe t
, Just (CType _ mHeader (_,cType)) <- tyConCType_maybe tycon
- = (mHeader, ftext cType)
+ = (mHeader, text $ T.unpack cType)
-- If we don't know a C type for this type, then try looking
-- through one layer of type synonym etc.
| Just t' <- coreView t
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -1292,7 +1292,7 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) =
| is_neg -> PgN $! negateFractionalLit f
| otherwise -> PgN f
(HsIsString _ s, _) -> assert (isNothing mb_neg) $
- PgOverS s
+ PgOverS (mkFastStringText s)
patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) =
case oval of
HsIntegral i -> PgNpK (il_value i)
=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -71,6 +71,8 @@ import Control.Monad
import Data.Int
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
import Data.Word
import GHC.Real ( Ratio(..), numerator, denominator )
@@ -120,7 +122,7 @@ dsLit l = do
HsFloatPrim _ fl -> return (Lit (LitFloat (rationalFromFractionalLit fl)))
HsDoublePrim _ fl -> return (Lit (LitDouble (rationalFromFractionalLit fl)))
HsChar _ c -> return (mkCharExpr c)
- HsString _ str -> mkStringExprFS str
+ HsString _ str -> mkStringExprFS (mkFastStringText str)
HsInteger _ i _ -> return (mkIntegerExpr platform i)
HsInt _ i -> return (mkIntExpr platform (il_value i))
HsRat _ fl ty -> dsFractionalLitToRational fl ty
@@ -538,10 +540,10 @@ tidyLitPat :: HsLit GhcTc -> Pat GhcTc
-- * We get rid of HsChar right here
tidyLitPat (HsChar src c) = unLoc (mkCharLitPat src c)
tidyLitPat (HsString src s)
- | lengthFS s <= 1 -- Short string literals only
+ | T.length s <= 1 -- Short string literals only
= unLoc $ foldr (\c pat -> mkPrefixConPat consDataCon
[mkCharLitPat src c, pat] [charTy])
- (mkNilPat charTy) (unpackFS s)
+ (mkNilPat charTy) (T.unpack s)
-- The stringTy is the type of the whole pattern, not
-- the type to instantiate (:) or [] with!
tidyLitPat lit = LitPat noExtField lit
@@ -588,7 +590,7 @@ tidyNPat (OverLit (OverLitTc False _ ty) val) mb_neg _eq outer_ty
(Just _, HsIntegral i) -> Just (-(il_value i))
_ -> Nothing
- mb_str_lit :: Maybe FastString
+ mb_str_lit :: Maybe T.Text
mb_str_lit = case (mb_neg, val) of
(Nothing, HsIsString _ s) -> Just s
_ -> Nothing
@@ -670,7 +672,7 @@ hsLitKey _ (HsCharPrim _ c) = mkLitChar c
hsLitKey _ (HsFloatPrim _ fl) = mkLitFloat (rationalFromFractionalLit fl)
hsLitKey _ (HsDoublePrim _ fl) = mkLitDouble (rationalFromFractionalLit fl)
-hsLitKey _ (HsString _ s) = LitString (bytesFS s)
+hsLitKey _ (HsString _ s) = LitString (T.encodeUtf8 s)
hsLitKey _ l = pprPanic "hsLitKey" (ppr l)
{-
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -99,6 +99,7 @@ import Data.Function
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import GHC.Types.Name.Reader (RdrName(..))
+import qualified Data.Text as T
data MetaWrappers = MetaWrappers {
-- Applies its argument to a type argument `m` and dictionary `Quote m`
@@ -1132,7 +1133,7 @@ rep_sccFun nm Nothing loc = do
rep_sccFun nm (Just (L _ str)) loc = do
nm1 <- lookupLOcc nm
- str1 <- coreStringLit (sl_fs str)
+ str1 <- coreStringLit (mkFastStringText $ sl_fs str)
scc <- repPragSCCFunNamed nm1 str1
return [(loc, scc)]
@@ -1477,7 +1478,7 @@ repTyLit :: HsTyLit (GhcPass p) -> MetaM (Core (M TH.TyLit))
repTyLit (HsNumTy _ i) = do
platform <- getPlatform
rep2 numTyLitName [mkIntegerExpr platform i]
-repTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS s
+repTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS (mkFastStringText s)
; rep2 strTyLitName [s']
}
repTyLit (HsCharTy _ c) = do { c' <- return (mkCharExpr c)
@@ -1909,7 +1910,7 @@ rep_implicit_param_bind (L loc (IPBind _ (L _ n) (L _ rhs)))
; return (locA loc, ipb) }
rep_implicit_param_name :: HsIPName -> MetaM (Core String)
-rep_implicit_param_name (HsIPName name) = coreStringLit name
+rep_implicit_param_name (HsIPName name) = coreStringLit (mkFastStringText name)
rep_val_binds :: HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
-- Assumes: all the binders of the binding are already in the meta-env
@@ -3001,7 +3002,7 @@ mk_integer i = return $ HsInteger NoSourceText i integerTy
mk_rational :: FractionalLit -> MetaM (HsLit GhcRn)
mk_rational r = do rat_ty <- lookupType rationalTyConName
return $ HsRat noExtField r rat_ty
-mk_string :: FastString -> MetaM (HsLit GhcRn)
+mk_string :: T.Text -> MetaM (HsLit GhcRn)
mk_string s = return $ HsString NoSourceText s
mk_char :: Char -> MetaM (HsLit GhcRn)
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -52,6 +52,9 @@ module GHC.Iface.Syntax (
import GHC.Prelude
import GHC.Data.FastString
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,
constraintKindTyConKey )
import GHC.Types.Unique ( hasKey )
@@ -369,7 +372,7 @@ data IfaceWarningTxt
| IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])]
data IfaceStringLiteral
- = IfStringLiteral SourceText FastString
+ = IfStringLiteral SourceText Text
data IfaceAnnotation
= IfaceAnnotation {
@@ -612,7 +615,7 @@ fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDo
fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names)
fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral
-fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st (fastStringToText fs) Nothing
+fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing
{-
@@ -783,7 +786,7 @@ instance Outputable IfaceWarningTxt where
pp_with_name = ppr . fst
instance Outputable IfaceStringLiteral where
- ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs)
+ ppr (IfStringLiteral st fs) = pprWithSourceText st (text $ T.unpack fs)
instance Outputable IfaceAnnotation where
ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
@@ -2358,8 +2361,8 @@ instance Binary IfaceWarningTxt where
_ -> pure IfDeprecatedTxt <*> get bh <*> get bh
instance Binary IfaceStringLiteral where
- put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2
- get bh = IfStringLiteral <$> get bh <*> get bh
+ put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh (T.encodeUtf8 a2)
+ get bh = IfStringLiteral <$> get bh <*> (T.decodeUtf8 <$> get bh)
instance Binary IfaceAnnotation where
put_ bh (IfaceAnnotation a1 a2) = do
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2744,8 +2744,8 @@ explicit_activation :: { ([AddEpAnn],Activation) } -- In brackets
quasiquote :: { Located (HsUntypedSplice GhcPs) }
: TH_QUASIQUOTE { let { loc = getLoc $1
; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
- ; quoterId = mkUnqual varName quoter }
- in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }
+; quoterId = mkUnqual varName quoter }
+in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) }
| TH_QQUASIQUOTE { let { loc = getLoc $1
; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1
; quoterId = mkQual varName (qual, quoter) }
@@ -3982,7 +3982,7 @@ consym :: { LocatedN RdrName }
literal :: { Located (HsLit GhcPs) }
: CHAR { sL1 $1 $ HsChar (getCHARs $1) $ getCHAR $1 }
| STRING { sL1 $1 $ HsString (getSTRINGs $1)
- $ getSTRING $1 }
+ $ T.pack $ getSTRING $1 }
| PRIMINTEGER { sL1 $1 $ HsIntPrim (getPRIMINTEGERs $1)
$ getPRIMINTEGER $1 }
| PRIMWORD { sL1 $1 $ HsWordPrim (getPRIMWORDs $1)
@@ -4148,7 +4148,7 @@ getOVERLAPS_PRAGs (L _ (IToverlaps_prag src)) = src
getINCOHERENT_PRAGs (L _ (ITincoherent_prag src)) = src
getCTYPEs (L _ (ITctype src)) = src
-getStringLiteral l = StringLiteral (getSTRINGs l) (getSTRING l) Nothing
+getStringLiteral l = StringLiteral (getSTRINGs l) (T.pack $ getSTRING l) Nothing
isUnicode :: Located Token -> Bool
isUnicode (L _ (ITforall iu)) = iu == UnicodeSyntax
=====================================
compiler/GHC/Parser/Header.hs
=====================================
@@ -139,7 +139,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
-- allow explicit "base" package qualifier (#19082, #17045)
&& case ideclPkgQual decl of
NoRawPkgQual -> True
- RawPkgQual b -> sl_fs b == unitIdFS baseUnitId
+ RawPkgQual b -> sl_fs b == fastStringToText (unitIdFS baseUnitId)
loc' = noAnnSrcSpan loc
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -984,11 +984,11 @@ data Token
| ITdollar -- prefix $
| ITdollardollar -- prefix $$
| ITtyQuote -- ''
- | ITquasiQuote (FastString,FastString,PsSpan)
+ | ITquasiQuote (FastString,Text,PsSpan)
-- ITquasiQuote(quoter, quote, loc)
-- represents a quasi-quote of the form
-- [quoter| quote |]
- | ITqQuasiQuote (FastString,FastString,FastString,PsSpan)
+ | ITqQuasiQuote (FastString,FastString,Text,PsSpan)
-- ITqQuasiQuote(Qual, quoter, quote, loc)
-- represents a qualified quasi-quote of the form
-- [Qual.quoter| quote |]
@@ -1720,7 +1720,7 @@ qvarid, qconid :: StringBuffer -> Int -> Token
qvarid buf len = ITqvarid $! splitQualName buf len False
qconid buf len = ITqconid $! splitQualName buf len False
-splitQualName :: StringBuffer -> Int -> Bool -> (FastString,FastString)
+splitQualName :: StringBuffer -> Int -> Bool -> (FastString, FastString)
-- takes a StringBuffer and a length, and returns the module name
-- and identifier parts of a qualified name. Splits at the *last* dot,
-- because of hierarchical module names.
@@ -2491,7 +2491,7 @@ lex_qquasiquote_tok span buf len _buf2 = do
return (L (mkPsSpan (psSpanStart span) end)
(ITqQuasiQuote (qual,
quoter,
- mkFastString (reverse quote),
+ T.pack (reverse quote),
mkPsSpan quoteStart end)))
lex_quasiquote_tok :: Action
@@ -2504,7 +2504,7 @@ lex_quasiquote_tok span buf len _buf2 = do
end <- getParsedLoc
return (L (mkPsSpan (psSpanStart span) end)
(ITquasiQuote (mkFastString quoter,
- mkFastString (reverse quote),
+ T.pack (reverse quote),
mkPsSpan quoteStart end)))
lex_quasiquote :: RealSrcLoc -> String -> P String
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -364,7 +364,7 @@ rnExpr (HsOverLabel src v)
, fvs ) }
where
hs_ty_arg = mkEmptyWildCardBndrs $ wrapGenSpan $
- HsTyLit noExtField (HsStrTy NoSourceText (mkFastStringText v))
+ HsTyLit noExtField (HsStrTy NoSourceText v)
rnExpr (HsLit x lit@(HsString src s))
= do { opt_OverloadedStrings <- xoptM LangExt.OverloadedStrings
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -446,7 +446,7 @@ rnImportDecl this_mod
renameRawPkgQual :: UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
renameRawPkgQual unit_env mn = \case
NoRawPkgQual -> NoPkgQual
- RawPkgQual p -> renamePkgQual unit_env mn (Just (sl_fs p))
+ RawPkgQual p -> renamePkgQual unit_env mn (Just (mkFastStringText $ sl_fs p))
-- | Rename raw package imports
renamePkgQual :: UnitEnv -> ModuleName -> Maybe FastString -> PkgQual
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -70,6 +70,7 @@ import GHCi.RemoteTypes ( ForeignRef )
import qualified GHC.Internal.TH.Syntax as TH (Q)
import qualified GHC.LanguageExtensions as LangExt
+import qualified Data.Text as T
{-
************************************************************************
@@ -414,7 +415,7 @@ makePending flavour n (HsQuasiQuote _ quoter quote)
------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name
- -> XRec GhcPs FastString
+ -> XRec GhcPs T.Text
-> LHsExpr GhcRn
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -748,7 +748,7 @@ genHsIntegralLit :: (NoAnn an) => IntegralLit -> LocatedAn an (HsExpr GhcRn)
genHsIntegralLit = genLHsLit . HsInt noExtField
genHsTyLit :: FastString -> HsType GhcRn
-genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText
+genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText . fastStringToText
genSimpleConPat :: Name -> [LPat GhcRn] -> LPat GhcRn
-- The pattern (C p1 .. pn)
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -690,7 +690,7 @@ funBindTicks loc fun_id mod sigs
-- by the renamer
, let cc_str
| Just cc_str <- mb_cc_str
- = sl_fs $ unLoc cc_str
+ = mkFastStringText $ sl_fs $ unLoc cc_str
| otherwise
= getOccFS (Var.varName fun_id)
cc_name = concatFS [moduleNameFS (moduleName mod), fsLit ".", cc_str]
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -1225,7 +1225,7 @@ tcHsType _ rn_ty@(HsTyLit _ (HsNumTy _ n)) exp_kind
tcHsType _ rn_ty@(HsTyLit _ (HsStrTy _ s)) exp_kind
= do { checkWiredInTyCon typeSymbolKindCon
- ; checkExpKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind }
+ ; checkExpKind rn_ty (mkStrLitTy $ mkFastStringText s) typeSymbolKind exp_kind }
tcHsType _ rn_ty@(HsTyLit _ (HsCharTy _ c)) exp_kind
= do { checkWiredInTyCon charTyCon
; checkExpKind rn_ty (mkCharLitTy c) charTy exp_kind }
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -50,6 +50,7 @@ import GHC.Utils.Misc
import GHC.Unit.Module
import GHC.Data.Bag
+import GHC.Data.FastString
import GHC.Driver.DynFlags
@@ -149,7 +150,7 @@ canDictCt ev cls tys
= Stage $
do { -- First we emit a new constraint that will capture the
-- given CallStack.
- let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName ip_name))
+ let new_loc = setCtLocOrigin loc (IPOccOrigin (HsIPName $ fastStringToText ip_name))
-- We change the origin to IPOccOrigin so
-- this rule does not fire again.
-- See Note [Overview of implicit CallStacks]
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1362,9 +1362,7 @@ cvtOverLit (IntegerL i)
cvtOverLit (RationalL r)
= do { force r; return $ mkHsFractional (mkTHFractionalLit r) }
cvtOverLit (StringL s)
- = do { let { s' = mkFastString s }
- ; force s'
- ; return $ mkHsIsString (quotedSourceText s) s'
+ = do { force s; return $ mkHsIsString (quotedSourceText s) (T.pack s)
}
cvtOverLit _ = panic "Convert.cvtOverLit: Unexpected overloaded literal"
-- An Integer is like an (overloaded) '3' in a Haskell source program
=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -36,8 +36,6 @@ import Language.Haskell.Syntax.Binds
import GHC.Types.Fixity (LexicalFixity(Infix), Fixity)
import GHC.Types.SourceText (StringLiteral)
-import GHC.Data.FastString (FastString)
-
-- libraries:
import Data.Data hiding (Fixity(..))
import Data.Bool
@@ -1436,7 +1434,7 @@ data HsUntypedSplice id
| HsQuasiQuote -- See Note [Quasi-quote overview]
(XQuasiQuote id)
(IdP id) -- The quoter (the bit between `[` and `|`)
- (XRec id FastString) -- The enclosed string
+ (XRec id Text) -- The enclosed string
| XUntypedSplice !(XXUntypedSplice id) -- Extension point; see Note [Trees That Grow]
-- in Language.Haskell.Syntax.Extension
=====================================
compiler/Language/Haskell/Syntax/Lit.hs
=====================================
@@ -23,8 +23,6 @@ import Language.Haskell.Syntax.Extension
import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText)
import GHC.Core.Type (Type)
-import GHC.Data.FastString (FastString, lexicalCompareFS)
-
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
import Data.Bool
@@ -125,7 +123,7 @@ data HsOverLit p
data OverLitVal
= HsIntegral !IntegralLit -- ^ Integer-looking literals;
| HsFractional !FractionalLit -- ^ Frac-looking literals
- | HsIsString !SourceText !FastString -- ^ String-looking literals
+ | HsIsString !SourceText !Text -- ^ String-looking literals
deriving Data
instance Eq OverLitVal where
@@ -141,6 +139,6 @@ instance Ord OverLitVal where
compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
compare (HsFractional _) (HsIntegral _) = GT
compare (HsFractional _) (HsIsString _ _) = LT
- compare (HsIsString _ s1) (HsIsString _ s2) = s1 `lexicalCompareFS` s2
+ compare (HsIsString _ s1) (HsIsString _ s2) = s1 `compare` s2
compare (HsIsString _ _) (HsIntegral _) = GT
compare (HsIsString _ _) (HsFractional _) = GT
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -68,6 +68,7 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Maybe ( isJust, mapMaybe )
import Data.Void
+import qualified Data.Text as T
import Lookup
import Utils
@@ -2126,7 +2127,7 @@ instance ExactPrint StringLiteral where
setAnnotationAnchor a _ _ _ = a
exact (StringLiteral src fs mcomma) = do
- printSourceTextAA src (show (unpackFS fs))
+ printSourceTextAA src (show fs)
mcomma' <- mapM (\r -> printStringAtNC r ",") mcomma
return (StringLiteral src fs mcomma')
@@ -2137,7 +2138,7 @@ instance ExactPrint FastString where
setAnnotationAnchor a _ _ _ = a
-- TODO: https://ghc.haskell.org/trac/ghc/ticket/10313 applies.
- -- exact fs = printStringAdvance (show (unpackFS fs))
+ -- exact fs = printStringAdvance (show fs)
exact fs = printStringAdvance (unpackFS fs) >> return fs
-- ---------------------------------------------------------------------
@@ -2703,7 +2704,7 @@ instance ExactPrint HsIPName where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact i@(HsIPName fs) = printStringAdvance ("?" ++ (unpackFS fs)) >> return i
+ exact i@(HsIPName fs) = printStringAdvance ("?" ++ (T.unpack fs)) >> return i
-- ---------------------------------------------------------------------
-- Managing lists which have been separated, e.g. Sigs and Binds
@@ -2962,12 +2963,12 @@ instance ExactPrint (HsExpr GhcPs) where
exact x@(HsOverLabel src l) = do
printStringAtLsDelta (SameLine 0) "#"
case src of
- NoSourceText -> printStringAtLsDelta (SameLine 0) (unpackFS l)
+ NoSourceText -> printStringAtLsDelta (SameLine 0) (T.unpack l)
SourceText txt -> printStringAtLsDelta (SameLine 0) (unpackFS txt)
return x
exact x@(HsIPVar _ (HsIPName n))
- = printStringAdvance ("?" ++ unpackFS n) >> return x
+ = printStringAdvance ("?" ++ T.unpack n) >> return x
exact x@(HsOverLit _an ol) = do
let str = case ol_val ol of
@@ -3276,7 +3277,7 @@ instance ExactPrint (HsPragE GhcPs) where
exact (HsPragSCC (an,st) sl) = do
an0 <- markAnnOpenP' an st "{-# SCC"
- let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl)
+ let txt = sourceTextToString (sl_st sl) (T.unpack $ sl_fs sl)
an1 <- markEpAnnLMS'' an0 lapr_rest AnnVal (Just txt) -- optional
an2 <- markEpAnnLMS'' an1 lapr_rest AnnValStr (Just txt) -- optional
an3 <- markAnnCloseP' an2
@@ -3304,7 +3305,7 @@ instance ExactPrint (HsUntypedSplice GhcPs) where
unless pMarkLayout $ setLayoutOffsetP 0
printStringAdvance
-- Note: Lexer.x does not provide unicode alternative. 2017-02-26
- ("[" ++ (showPprUnsafe q) ++ "|" ++ (unpackFS fs) ++ "|]")
+ ("[" ++ (showPprUnsafe q) ++ "|" ++ (T.unpack fs) ++ "|]")
unless pMarkLayout $ setLayoutOffsetP oldOffset
return (HsQuasiQuote an q (L l fs))
@@ -4482,7 +4483,7 @@ instance ExactPrint (LocatedP CType) where
Nothing -> return an0
Just (Header srcH _h) ->
markEpAnnLMS an0 lapr_rest AnnHeader (Just (toSourceTextWithSuffix srcH "" ""))
- an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (unpackFS ct) ""))
+ an2 <- markEpAnnLMS an1 lapr_rest AnnVal (Just (toSourceTextWithSuffix stct (T.unpack ct) ""))
an3 <- markAnnCloseP an2
return (L an3 (CType stp mh (stct,ct)))
=====================================
utils/check-exact/check-exact.cabal
=====================================
@@ -29,6 +29,7 @@ Executable check-exact
Utils
Build-Depends: base >= 4 && < 5,
bytestring,
+ text,
containers,
directory,
filepath,
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
=====================================
@@ -136,7 +136,7 @@ parse dflags fpath bs = case unP (go False []) initState of
L _ (ITstring _ file) <- tryP wrappedLexer
L spF ITclose_prag <- tryP wrappedLexer
- let newLoc = mkRealSrcLoc file (fromIntegral line - 1) (srcSpanEndCol spF)
+ let newLoc = mkRealSrcLoc (mkFastString file) (fromIntegral line - 1) (srcSpanEndCol spF)
(bEnd'', _) <- lift getInput
lift $ setInput (bEnd'', newLoc)
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -87,6 +87,7 @@ import Haddock.Types
import Data.Either (lefts, partitionEithers, rights)
import Data.Maybe (catMaybes, mapMaybe, maybeToList)
+import GHC.Data.FastString (fastStringToText)
-- | Whether or not to default 'RuntimeRep' variables to 'LiftedRep'. Check
-- out Note [Defaulting RuntimeRep variables] in GHC.Iface.Type for the
@@ -754,7 +755,7 @@ synifyType _ vs (TyConApp tc tys) =
| tc `hasKey` ipClassKey
, [name, ty] <- tys
, Just x <- isStrLitTy name =
- noLocA $ HsIParamTy noAnn (noLocA $ HsIPName x) (synifyType WithinType vs ty)
+ noLocA $ HsIParamTy noAnn (noLocA $ HsIPName (fastStringToText x)) (synifyType WithinType vs ty)
-- and equalities
| tc `hasKey` eqTyConKey
, [ty1, ty2] <- tys =
@@ -1005,7 +1006,7 @@ synifyPatSynType ps =
synifyTyLit :: TyLit -> HsTyLit GhcRn
synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n
-synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s
+synifyTyLit (StrTyLit s) = HsStrTy NoSourceText (fastStringToText s)
synifyTyLit (CharTyLit c) = HsCharTy NoSourceText c
synifyKindSig :: Kind -> LHsKind GhcRn
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -57,15 +57,13 @@ import Data.Traversable (for)
import Control.Arrow (first, (&&&))
import GHC hiding (lookupName)
import GHC.Builtin.Names
-import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Core.ConLike (ConLike (..))
-import GHC.Data.FastString (FastString, bytesFS, unpackFS)
+import GHC.Data.FastString (unpackFS)
import GHC.Driver.Ppr
import GHC.HsToCore.Docs hiding (mkMaps)
import GHC.Iface.Syntax
import GHC.Types.Avail
-import GHC.Types.Basic
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SafeHaskell
@@ -75,6 +73,8 @@ import GHC.Unit.Module.ModIface
import GHC.Unit.State (PackageName (..), UnitState)
import qualified GHC.Utils.Outputable as O
import GHC.Utils.Panic (pprPanic)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
createInterface1
:: MonadIO m
@@ -324,8 +324,8 @@ parseWarning dflags w = case w of
dstToDoc :: (IfaceStringLiteral, [Name]) -> HsDoc GhcRn
dstToDoc ((IfStringLiteral _ fs), ids) = WithHsDocIdentifiers (fsToDoc fs) (map noLoc ids)
- fsToDoc :: FastString -> HsDocString
- fsToDoc fs = GeneratedDocString $ HsDocStringChunk (bytesFS fs)
+ fsToDoc :: T.Text -> HsDocString
+ fsToDoc fs = GeneratedDocString $ HsDocStringChunk (T.encodeUtf8 fs)
format x bs =
DocWarning . DocParagraph . DocAppend (DocString x)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9408cc56ae54d0bd86a27308fe97dbf635fe727
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9408cc56ae54d0bd86a27308fe97dbf635fe727
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240612/fa164fd1/attachment-0001.html>
More information about the ghc-commits
mailing list