[Git][ghc/ghc][wip/aforemny/parameterize-source-text-lits-over-pass] ttg: use `StringLit` for `HsIsString`
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Oct 7 15:45:46 UTC 2024
Rodrigo Mesquita pushed to branch wip/aforemny/parameterize-source-text-lits-over-pass at Glasgow Haskell Compiler / GHC
Commits:
bb6016cb by Alexander Foremny at 2024-10-07T16:45:08+01:00
ttg: use `StringLit` for `HsIsString`
While `OverLitVal`'s data constructors `HsIntegral`, `HsFractional`
carried `IntegralLit`, `FractionalLit` types, `HsIsString` carries only
`SourceText` and `FastString`. We will want to parameterize over
`SourceText`, which `StringLit`s will support. So we change `HsIsString`
to carry a `StringLit`.
- - - - -
11 changed files:
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/SourceText.hs
- compiler/Language/Haskell/Syntax/Lit.hs
Changes:
=====================================
compiler/GHC/Builtin/Utils.hs
=====================================
@@ -271,7 +271,7 @@ ghcPrimWarns = WarnSome
[]
where
mk_txt msg =
- DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText msg Nothing) []]
+ DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (SL NoSourceText msg Nothing) []]
mk_decl_dep (occ, msg) = (occ, mk_txt msg)
ghcPrimFixities :: [(OccName,Fixity)]
=====================================
compiler/GHC/Hs/Lit.hs
=====================================
@@ -227,9 +227,9 @@ instance OutputableBndrId p
= ppr val <+> (whenPprDebug (parens (pprXOverLit (ghcPass @p) ext)))
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 s)
+ ppr (HsIntegral i) = pprWithSourceText (il_text i) (integer (il_value i))
+ ppr (HsFractional f) = ppr f
+ ppr (HsIsString s) = pprWithSourceText (sl_st s) (pprHsString (sl_fs 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
=====================================
@@ -380,9 +380,9 @@ mkRecStmt anns stmts = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)
{ recS_stmts = stmts }
-mkHsIntegral i = OverLit noExtField (HsIntegral i)
-mkHsFractional f = OverLit noExtField (HsFractional f)
-mkHsIsString src s = OverLit noExtField (HsIsString src s)
+mkHsIntegral i = OverLit noExtField (HsIntegral i)
+mkHsFractional f = OverLit noExtField (HsFractional f)
+mkHsIsString src s = OverLit noExtField (HsIsString (SL src s Nothing))
mkHsDo ctxt stmts = HsDo noAnn ctxt stmts
mkHsDoAnns ctxt stmts anns = HsDo anns ctxt stmts
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -32,6 +32,7 @@ import GHC.Types.Basic
import GHC.Types.SourceText
( FractionalLit,
IntegralLit(il_value),
+ StringLit(sl_fs),
negateFractionalLit,
integralFractionalLit )
import GHC.Driver.DynFlags
@@ -1291,8 +1292,8 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) =
(HsFractional f, is_neg)
| is_neg -> PgN $! negateFractionalLit f
| otherwise -> PgN f
- (HsIsString _ s, _) -> assert (isNothing mb_neg) $
- PgOverS s
+ (HsIsString s, _) -> assert (isNothing mb_neg) $
+ PgOverS (sl_fs s)
patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) =
case oval of
HsIntegral i -> PgNpK (il_value i)
=====================================
compiler/GHC/HsToCore/Match/Literal.hs
=====================================
@@ -592,7 +592,7 @@ tidyNPat (OverLit (OverLitTc False _ ty) val) mb_neg _eq outer_ty
mb_str_lit :: Maybe FastString
mb_str_lit = case (mb_neg, val) of
- (Nothing, HsIsString _ s) -> Just s
+ (Nothing, HsIsString s) -> Just (sl_fs s)
_ -> Nothing
tidyNPat over_lit mb_neg eq outer_ty
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -3058,7 +3058,7 @@ repOverloadedLiteral (OverLit { ol_val = val})
mk_lit :: OverLitVal -> MetaM (HsLit GhcRn)
mk_lit (HsIntegral i) = mk_integer (il_value i)
mk_lit (HsFractional f) = mk_rational f
-mk_lit (HsIsString _ s) = mk_string s
+mk_lit (HsIsString s) = mk_string (sl_fs s)
repRdrName :: RdrName -> MetaM (Core TH.Name)
repRdrName rdr_name = do
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -4765,5 +4765,5 @@ tyLitFromLit _ = Nothing
tyLitFromOverloadedLit :: OverLitVal -> Maybe (HsTyLit GhcRn)
tyLitFromOverloadedLit (HsIntegral n) = Just $ HsNumTy NoSourceText (il_value n)
-tyLitFromOverloadedLit (HsIsString _ s) = Just $ HsStrTy NoSourceText s
+tyLitFromOverloadedLit (HsIsString s) = Just $ HsStrTy NoSourceText (sl_fs s)
tyLitFromOverloadedLit HsFractional{} = Nothing
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -817,7 +817,7 @@ mkOverLit (HsFractional r)
= do { rat_ty <- tcMetaTy rationalTyConName
; return (HsRat noExtField r rat_ty) }
-mkOverLit (HsIsString src s) = return (HsString src s)
+mkOverLit (HsIsString s) = return (HsString (sl_st s) (sl_fs s))
{-
************************************************************************
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -2363,7 +2363,7 @@ shortCutLit platform val res_ty
= case val of
HsIntegral int_lit -> go_integral int_lit
HsFractional frac_lit -> go_fractional frac_lit
- HsIsString s src -> go_string s src
+ HsIsString s_lit -> go_string (sl_st s_lit) (sl_fs s_lit)
where
go_integral int@(IL src neg i)
| isIntTy res_ty && platformInIntRange platform i
=====================================
compiler/GHC/Types/SourceText.hs
=====================================
@@ -317,5 +317,8 @@ data StringLit = SL
instance Eq StringLit where
(SL _ a _) == (SL _ b _) = a == b
+instance Ord StringLit where
+ (SL _ a _) `compare` (SL _ b _) = a `lexicalCompareFS` b
+
instance Outputable StringLit where
ppr sl = pprWithSourceText (sl_st sl) (doubleQuotes $ ftext $ sl_fs sl)
=====================================
compiler/Language/Haskell/Syntax/Lit.hs
=====================================
@@ -20,10 +20,10 @@ module Language.Haskell.Syntax.Lit where
import Language.Haskell.Syntax.Extension
-import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText)
+import GHC.Types.SourceText (IntegralLit, FractionalLit, StringLit)
import GHC.Core.Type (Type)
-import GHC.Data.FastString (FastString, lexicalCompareFS)
+import GHC.Data.FastString (FastString)
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
@@ -124,24 +124,24 @@ data HsOverLit p
-- the following
-- | Overloaded Literal Value
data OverLitVal
- = HsIntegral !IntegralLit -- ^ Integer-looking literals;
- | HsFractional !FractionalLit -- ^ Frac-looking literals
- | HsIsString !SourceText !FastString -- ^ String-looking literals
+ = HsIntegral !IntegralLit -- ^ Integer-looking literals;
+ | HsFractional !FractionalLit -- ^ Frac-looking literals
+ | HsIsString !StringLit -- ^ String-looking literals
deriving Data
instance Eq OverLitVal where
(HsIntegral i1) == (HsIntegral i2) = i1 == i2
(HsFractional f1) == (HsFractional f2) = f1 == f2
- (HsIsString _ s1) == (HsIsString _ s2) = s1 == s2
+ (HsIsString s1) == (HsIsString s2) = s1 == s2
_ == _ = False
instance Ord OverLitVal where
compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
compare (HsIntegral _) (HsFractional _) = LT
- compare (HsIntegral _) (HsIsString _ _) = LT
+ compare (HsIntegral _) (HsIsString _) = LT
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 _ _) (HsIntegral _) = GT
- compare (HsIsString _ _) (HsFractional _) = GT
+ compare (HsFractional _) (HsIsString _) = LT
+ compare (HsIsString s1) (HsIsString s2) = s1 `compare` s2
+ compare (HsIsString _) (HsIntegral _) = GT
+ compare (HsIsString _) (HsFractional _) = GT
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb6016cba42cf0803580e8d7b5bf0f9d32d21393
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb6016cba42cf0803580e8d7b5bf0f9d32d21393
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/20241007/66e99fc4/attachment-0001.html>
More information about the ghc-commits
mailing list