[Git][ghc/ghc][wip/aforemny/ttg-remove-source-text] ttg: remove `GHC.Types.SourceText` imports from `Language.Haskell`
Alexander Foremny (@aforemny)
gitlab at gitlab.haskell.org
Mon Jun 10 13:09:07 UTC 2024
Alexander Foremny pushed to branch wip/aforemny/ttg-remove-source-text at Glasgow Haskell Compiler / GHC
Commits:
9f5ff22e by Alexander Foremny at 2024-06-10T15:08:41+02:00
ttg: remove `GHC.Types.SourceText` imports from `Language.Haskell`
To remove `GHC.Types.SourceText` from `Language.Haskell`, we move
`SourceText`'s literals to `Language.Haskell.Syntax.Lit`.
A temporary hs-boot file has been added for
`Language.Haskell.Syntax.Lit` because without it, currently, we are
unable to break cyclic module imports.
Breaking cyclic module imports between `GHC` and `Language.Haskell`
should not exist in the end of things, so that file can be removed
before merging.
Additionally, this commit changes the implementation of `Eq (XXOverLit
pass)` and `Eq (OverLitVal pass)` to not use `panic` anymore.
Additionally, a module `GHC.Utils.Outputable.Instances` is introduced
that, similar to `GHC.Hs.Instances`, collects (unavoidable) orphan
instances for `Outputable`.
- - - - -
26 changed files:
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Types/PkgQual.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Unit/Module/Warnings.hs
- + compiler/GHC/Utils/Outputable/Instances.hs
- compiler/Language/Haskell/Syntax/Binds.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- + compiler/Language/Haskell/Syntax/Lit.hs-boot
- compiler/ghc.cabal.in
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
Changes:
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -56,7 +56,6 @@ import GHC.Types.Name.Set
import GHC.Types.Basic
import GHC.Types.Id
import GHC.Generics (Generic)
-import Data.Data ( Data )
import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
import qualified Data.List.NonEmpty as NE
import Data.Maybe ( isJust )
@@ -115,7 +114,6 @@ data ClsInst
-- See Note [Implementation of deprecated instances]
-- in GHC.Tc.Solver.Dict
}
- deriving Data
-- | A fuzzy comparison function for class instances, intended for sorting
-- instances before displaying them to the user.
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -30,8 +30,9 @@ module GHC.Hs.Binds
import GHC.Prelude
-import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Binds
+import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Lit
import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprFunBind, pprPatBind )
import {-# SOURCE #-} GHC.Hs.Pat (pprLPat )
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -21,8 +21,11 @@ module GHC.Hs.Instances where
-- UndecidableInstances ?
+import Language.Haskell.Syntax.Lit
+
import Data.Data hiding ( Fixity )
+import GHC.Core.InstEnv
import GHC.Prelude
import GHC.Hs.Extension
import GHC.Hs.Binds
@@ -32,7 +35,9 @@ import GHC.Hs.Lit
import GHC.Hs.Type
import GHC.Hs.Pat
import GHC.Hs.ImpExp
+import GHC.Types.PkgQual
import GHC.Parser.Annotation
+import GHC.Unit.Module.Warnings
-- ---------------------------------------------------------------------
-- Data derivations from GHC.Hs-----------------------------------------
@@ -578,3 +583,29 @@ deriving instance Data XXPatGhcTc
deriving instance Data XViaStrategyPs
-- ---------------------------------------------------------------------
+
+deriving instance Data (IntegralLit GhcPs)
+deriving instance Data (IntegralLit GhcRn)
+deriving instance Data (IntegralLit GhcTc)
+
+deriving instance Data (FractionalLit GhcPs)
+deriving instance Data (FractionalLit GhcRn)
+deriving instance Data (FractionalLit GhcTc)
+
+deriving instance Data (StringLit GhcPs)
+deriving instance Data (StringLit GhcRn)
+deriving instance Data (StringLit GhcTc)
+
+deriving instance Data (OverLitVal GhcPs)
+deriving instance Data (OverLitVal GhcRn)
+deriving instance Data (OverLitVal GhcTc)
+
+deriving instance Data (RawPkgQual GhcPs)
+deriving instance Data (RawPkgQual GhcRn)
+deriving instance Data (RawPkgQual GhcTc)
+
+deriving instance Data (WarningTxt GhcPs)
+deriving instance Data (WarningTxt GhcRn)
+deriving instance Data (WarningTxt GhcTc)
+
+deriving instance Data ClsInst
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -31,7 +31,6 @@ import GHC.HsToCore.Arrows
import GHC.HsToCore.Monad
import GHC.HsToCore.Pmc
import GHC.HsToCore.Errors.Types
-import GHC.Types.SourceText
import GHC.Types.Name hiding (varName)
import GHC.Core.FamInstEnv( topNormaliseType )
import GHC.HsToCore.Quote
=====================================
compiler/GHC/HsToCore/Match.hs
=====================================
@@ -29,10 +29,6 @@ import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr)
import GHC.Types.Basic
-import GHC.Types.SourceText
- ( FractionalLit,
- IntegralLit(il_value),
- StringLit(sl_fs) )
import GHC.Driver.DynFlags
import GHC.Hs
import GHC.Hs.Syn.Type
=====================================
compiler/GHC/HsToCore/Pmc/Desugar.hs
=====================================
@@ -45,7 +45,6 @@ import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.Type
import GHC.Data.Maybe
import qualified GHC.LanguageExtensions as LangExt
-import GHC.Types.SourceText (FractionalLit(..))
import Control.Monad (zipWithM, replicateM)
import Data.List (elemIndex)
import Data.List.NonEmpty ( NonEmpty(..) )
=====================================
compiler/GHC/HsToCore/Pmc/Solver/Types.hs
=====================================
@@ -68,7 +68,7 @@ import GHC.Builtin.Types.Prim
import GHC.Tc.Solver.InertSet (InertSet, emptyInert)
import GHC.Tc.Utils.TcType (isStringTy)
import GHC.Types.CompleteMatch (CompleteMatch(..))
-import GHC.Types.SourceText (SourceText(..), FractionalLit, FractionalExponentBase(..))
+import GHC.Types.SourceText (SourceText(..))
import Numeric (fromRat)
import Data.Foldable (find)
import Data.Ratio
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -67,7 +67,6 @@ import GHC.Types.SourceFile
import GHC.Types.TyThing
import GHC.Types.HpcInfo
import GHC.Types.CompleteMatch
-import GHC.Types.SourceText
import GHC.Types.SrcLoc ( unLoc )
import GHC.Utils.Outputable
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -95,6 +95,8 @@ import GHC.Utils.Panic
import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith,
seqList, zipWithEqual )
+import Language.Haskell.Syntax.Lit
+
import Control.Monad
import System.IO.Unsafe
import Control.DeepSeq
=====================================
compiler/GHC/Parser/HaddockLex.x
=====================================
@@ -10,7 +10,6 @@ import GHC.Hs.Doc
import GHC.Parser.Lexer
import GHC.Parser.Annotation
import GHC.Types.SrcLoc
-import GHC.Types.SourceText
import GHC.Data.StringBuffer
import qualified GHC.Data.Strict as Strict
import GHC.Types.Name.Reader
@@ -27,6 +26,8 @@ import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
import qualified GHC.LanguageExtensions as LangExt
+
+import Language.Haskell.Syntax.Lit
}
-- -----------------------------------------------------------------------------
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -22,7 +22,6 @@ import GHC.Prelude hiding ( head )
import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr )
import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )
-import GHC.Types.SourceText (StringLit)
import GHC.Hs
import GHC.Types.FieldLabel
import GHC.Types.Name.Reader
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -75,7 +75,6 @@ import GHC.Types.Hint
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Basic ( TopLevelFlag(..) )
-import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.HpcInfo
import GHC.Types.PkgQual
=====================================
compiler/GHC/Rename/Pat.hs
=====================================
@@ -67,7 +67,6 @@ import GHC.Types.Name.Reader
import GHC.Types.Unique.Set
import GHC.Types.Basic
-import GHC.Types.SourceText
import GHC.Utils.Misc
import GHC.Data.FastString ( uniqCompareFS )
import GHC.Data.List.SetOps( removeDups )
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -59,7 +59,7 @@ import GHC.Types.Name.Env
import GHC.Core.DataCon
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.SourceFile
-import GHC.Types.SourceText ( SourceText(..), IntegralLit )
+import GHC.Types.SourceText (SourceText(..))
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Unit.Module.ModIface
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -66,7 +66,6 @@ import GHC.Builtin.Types ( mkConstraintTupleTy, multiplicityTy, oneDataConTy )
import GHC.Builtin.Types.Prim
import GHC.Unit.Module
-import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.Var as Var
import GHC.Types.Var.Set
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -135,7 +135,6 @@ import GHC.Core.UsageEnv
import GHC.Types.Var
import GHC.Types.Id as Id
import GHC.Types.Name
-import GHC.Types.SourceText
import GHC.Types.Var.Set
import GHC.Builtin.Types
=====================================
compiler/GHC/Types/PkgQual.hs
=====================================
@@ -9,6 +9,7 @@ import GHC.Unit.Types
import GHC.Utils.Outputable
import Language.Haskell.Syntax.Extension
+import {-# SOURCE #-} Language.Haskell.Syntax.Lit
import Data.Data
@@ -17,10 +18,6 @@ data RawPkgQual pass
= NoRawPkgQual -- ^ No package qualifier
| RawPkgQual (StringLit pass) -- ^ Raw package qualifier string.
-deriving instance
- (Data pass, XStringLit pass ~ (SourceText, Maybe NoCommentsLocation))
- => Data (RawPkgQual pass)
-
-- | Package-qualifier after renaming
--
-- Renaming detects if "this" or the unit-id of the home-unit was used as a
=====================================
compiler/GHC/Types/SourceText.hs
=====================================
@@ -11,14 +11,6 @@ module GHC.Types.SourceText
( SourceText (..)
, NoCommentsLocation
, pprWithSourceText
-
- -- * Literals
- , IntegralLit(..)
- , FractionalLit(..)
- , StringLit(..)
- , rationalFromFractionalLit
- , FractionalExponentBase(..)
-
)
where
@@ -30,13 +22,10 @@ import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Utils.Panic
-import Data.Function (on)
import Data.Data
import GHC.Types.SrcLoc
import Control.DeepSeq
-import Language.Haskell.Syntax.Extension
-
{-
Note [Pragma source text]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -128,135 +117,3 @@ instance Binary SourceText where
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText NoSourceText d = d
pprWithSourceText (SourceText src) _ = ftext src
-
-------------------------------------------------
--- Literals
-------------------------------------------------
-
--- | Integral Literal
---
--- Used (instead of Integer) to represent negative zegative zero which is
--- required for NegativeLiterals extension to correctly parse `-0::Double`
--- as negative zero. See also #13211.
-data IntegralLit pass = IL
- { il_text :: XIntegralLit pass
- , il_neg :: Bool -- See Note [Negative zero] in GHC.Rename.Pat
- , il_value :: Integer
- }
-
-deriving instance (Data pass, XIntegralLit pass ~ SourceText)
- => Data (IntegralLit pass)
-
-deriving instance (XIntegralLit pass ~ SourceText) => Show (IntegralLit pass)
-
--- | Fractional Literal
---
--- Used (instead of Rational) to represent exactly the floating point literal that we
--- encountered in the user's source program. This allows us to pretty-print exactly what
--- the user wrote, which is important e.g. for floating point numbers that can't represented
--- as Doubles (we used to via Double for pretty-printing). See also #2245.
--- Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
--- The actual value then is: sign * fl_signi * (fl_exp_base^fl_exp)
--- where sign = if fl_neg then (-1) else 1
---
--- For example FL { fl_neg = True, fl_signi = 5.3, fl_exp = 4, fl_exp_base = Base10 }
--- denotes -5300
-
-data FractionalLit pass = FL
- { fl_text :: XFractionalLit pass -- ^ How the value was written in the source
- , fl_neg :: Bool -- See Note [Negative zero]
- , fl_signi :: Rational -- The significand component of the literal
- , fl_exp :: Integer -- The exponent component of the literal
- , fl_exp_base :: FractionalExponentBase -- See Note [fractional exponent bases]
- }
-
-deriving instance (Data pass, XFractionalLit pass ~ SourceText)
- => Data (FractionalLit pass)
-
--- | The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
-deriving instance (XFractionalLit pass ~ SourceText) => Show (FractionalLit pass)
-
--- See Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
-data FractionalExponentBase
- = Base2 -- Used in hex fractional literals
- | Base10
- deriving (Eq, Ord, Data, Show)
-
-mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
-mkRationalWithExponentBase i e feb = i * (eb ^^ e)
- where eb = case feb of Base2 -> 2 ; Base10 -> 10
-
-rationalFromFractionalLit :: FractionalLit pass -> Rational
-rationalFromFractionalLit (FL _ _ i e expBase) =
- mkRationalWithExponentBase i e expBase
-
-{- Note [fractional exponent bases]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For hexadecimal rationals of
-the form 0x0.3p10 the exponent is given on base 2 rather than
-base 10. These are the only options, hence the sum type. See also #15646.
--}
-
-
--- Comparison operations are needed when grouping literals
--- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
-
-instance Eq (IntegralLit pass) where
- (==) = (==) `on` il_value
-
-instance Ord (IntegralLit pass) where
- compare = compare `on` il_value
-
-instance (XIntegralLit pass ~ SourceText) => Outputable (IntegralLit pass) where
- ppr (IL (SourceText src) _ _) = ftext src
- ppr (IL NoSourceText _ value) = text (show value)
-
-
--- | Compare fractional lits with small exponents for value equality but
--- large values for syntactic equality.
-compareFractionalLit :: FractionalLit pass -> FractionalLit pass -> Ordering
-compareFractionalLit fl1 fl2
- | fl_exp fl1 < 100 && fl_exp fl2 < 100 && fl_exp fl1 >= -100 && fl_exp fl2 >= -100
- = rationalFromFractionalLit fl1 `compare` rationalFromFractionalLit fl2
- | otherwise = (compare `on` (\x -> (fl_signi x, fl_exp x, fl_exp_base x))) fl1 fl2
-
--- | Be wary of using this instance to compare for equal *values* when exponents are
--- large. The same value expressed in different syntactic form won't compare as equal when
--- any of the exponents is >= 100.
-instance Eq (FractionalLit pass) where
- (==) fl1 fl2 = case compare fl1 fl2 of
- EQ -> True
- _ -> False
-
--- | Be wary of using this instance to compare for equal *values* when exponents are
--- large. The same value expressed in different syntactic form won't compare as equal when
--- any of the exponents is >= 100.
-instance Ord (FractionalLit pass) where
- compare = compareFractionalLit
-
-instance (XFractionalLit pass ~ SourceText)
- => Outputable (FractionalLit pass) where
- ppr (fl@(FL {})) =
- pprWithSourceText (fl_text fl) $
- rational $ mkRationalWithExponentBase (fl_signi fl) (fl_exp fl) (fl_exp_base fl)
-
--- | A String Literal in the source, including its original raw format for use by
--- source to source manipulation tools.
-data StringLit pass = SL
- { sl_st :: XStringLit pass, -- literal raw source.
- -- See Note [Literal source text]
- sl_fs :: FastString -- literal string value
- }
-
-instance Eq (StringLit pass) where
- (SL _ a) == (SL _ b) = a == b
-
-instance Ord (StringLit pass) where
- (SL _ a) `compare` (SL _ b) = a `lexicalCompareFS` b
-
-deriving instance (Data pass, XStringLit pass ~ (SourceText, Maybe NoCommentsLocation))
- => Data (StringLit pass)
-
-instance (XStringLit pass ~ (SourceText, Maybe NoCommentsLocation))
- => Outputable (StringLit pass) where
- ppr sl = pprWithSourceText (fst (sl_st sl)) (doubleQuotes $ ftext $ sl_fs sl)
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -60,10 +60,12 @@ import GHC.Hs.Extension
import GHC.Parser.Annotation
import GHC.Utils.Outputable
+import GHC.Utils.Outputable.Instances ()
import GHC.Utils.Binary
import GHC.Unicode
import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Lit
import Data.Data
import Data.List (isPrefixOf)
@@ -237,11 +239,6 @@ warningTxtSame w1 w2
deriving instance Eq InWarningCategory
deriving instance (Eq (IdP (GhcPass pass))) => Eq (WarningTxt (GhcPass pass))
-deriving instance
- ( Data (GhcPass p),
- (XStringLit (GhcPass p) ~ (SourceText, Maybe NoCommentsLocation)),
- Data (IdP (GhcPass p)))
- => Data (WarningTxt (GhcPass p))
type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
=====================================
compiler/GHC/Utils/Outputable/Instances.hs
=====================================
@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module GHC.Utils.Outputable.Instances where
+
+import GHC.Prelude
+import GHC.Types.SourceText (SourceText(..), pprWithSourceText)
+import GHC.Types.SrcLoc (NoCommentsLocation)
+import GHC.Utils.Outputable
+import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Lit
+
+instance (XIntegralLit pass ~ SourceText) => Outputable (IntegralLit pass) where
+ ppr (IL (SourceText src) _ _) = ftext src
+ ppr (IL NoSourceText _ value) = text (show value)
+
+instance (XFractionalLit pass ~ SourceText)
+ => Outputable (FractionalLit pass) where
+ ppr (fl@(FL {})) =
+ pprWithSourceText (fl_text fl) $
+ rational $ mkRationalWithExponentBase (fl_signi fl) (fl_exp fl) (fl_exp_base fl)
+
+instance (XStringLit pass ~ (SourceText, Maybe NoCommentsLocation))
+ => Outputable (StringLit pass) where
+ ppr sl = pprWithSourceText (fst (sl_st sl)) (doubleQuotes $ ftext $ sl_fs sl)
=====================================
compiler/Language/Haskell/Syntax/Binds.hs
=====================================
@@ -30,13 +30,13 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Pat
( LPat )
import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Lit
import Language.Haskell.Syntax.Type
import GHC.Types.Fixity (Fixity)
import GHC.Types.Basic (InlinePragma)
import GHC.Data.BooleanFormula (LBooleanFormula)
-import GHC.Types.SourceText (StringLit)
import Data.Void
import Data.Bool
=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -32,7 +32,6 @@ import Language.Haskell.Syntax.Binds
-- others:
import GHC.Types.Fixity (LexicalFixity(Infix), Fixity)
-import GHC.Types.SourceText (StringLit)
import GHC.Data.FastString (FastString)
=====================================
compiler/Language/Haskell/Syntax/Lit.hs
=====================================
@@ -18,21 +18,16 @@
-- | Source-language literals
module Language.Haskell.Syntax.Lit where
+import Prelude
import Language.Haskell.Syntax.Extension
-import GHC.Types.SourceText (IntegralLit, FractionalLit, StringLit, SourceText, NoCommentsLocation)
import GHC.Core.Type (Type)
-import GHC.Utils.Panic (panic)
-import GHC.Data.FastString (FastString)
+import GHC.Data.FastString (FastString, lexicalCompareFS)
import Data.ByteString (ByteString)
import Data.Data hiding ( Fixity )
-import Data.Bool
-import Data.Ord
-import Data.Eq
-import Data.Char
-import Prelude (Maybe, Integer)
+import Data.Function (on)
{-
************************************************************************
@@ -127,14 +122,12 @@ data OverLitVal pass
| HsFractional !(FractionalLit pass) -- ^ Frac-looking literals
| HsIsString !(StringLit pass) -- ^ String-looking literals
-deriving instance (Data pass, XIntegralLit pass ~ SourceText, XFractionalLit pass ~ SourceText, XStringLit pass ~ (SourceText, Maybe NoCommentsLocation)) => Data (OverLitVal pass)
-
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
instance (Eq (XXOverLit pass)) => Eq (HsOverLit pass) where
(OverLit _ val1) == (OverLit _ val2) = val1 == val2
(XOverLit val1) == (XOverLit val2) = val1 == val2
- _ == _ = panic "Eq HsOverLit"
+ _ == _ = False
instance Eq (OverLitVal pass) where
(HsIntegral i1) == (HsIntegral i2) = i1 == i2
@@ -145,7 +138,8 @@ instance Eq (OverLitVal pass) where
instance (Ord (XXOverLit pass)) => Ord (HsOverLit pass) where
compare (OverLit _ val1) (OverLit _ val2) = val1 `compare` val2
compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2
- compare _ _ = panic "Ord HsOverLit"
+ compare (OverLit _ _) (XOverLit _) = GT
+ compare (XOverLit _) (OverLit _ _) = LT
instance Ord (OverLitVal pass) where
compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2
@@ -157,3 +151,115 @@ instance Ord (OverLitVal pass) where
compare (HsIsString s1) (HsIsString s2) = s1 `compare` s2
compare (HsIsString _) (HsIntegral _) = GT
compare (HsIsString _) (HsFractional _) = GT
+
+------------------------------------------------
+-- Literals
+------------------------------------------------
+
+-- | Integral Literal
+--
+-- Used (instead of Integer) to represent negative zegative zero which is
+-- required for NegativeLiterals extension to correctly parse `-0::Double`
+-- as negative zero. See also #13211.
+data IntegralLit pass = IL
+ { il_text :: XIntegralLit pass
+ , il_neg :: Bool -- See Note [Negative zero] in GHC.Rename.Pat
+ , il_value :: Integer
+ }
+
+-- Comparison operations are needed when grouping literals
+-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
+
+instance Eq (IntegralLit pass) where
+ (==) = (==) `on` il_value
+
+instance Ord (IntegralLit pass) where
+ compare = compare `on` il_value
+
+-- | The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
+deriving instance Show (XIntegralLit pass) => Show (IntegralLit pass)
+
+-- | Fractional Literal
+--
+-- Used (instead of Rational) to represent exactly the floating point literal that we
+-- encountered in the user's source program. This allows us to pretty-print exactly what
+-- the user wrote, which is important e.g. for floating point numbers that can't represented
+-- as Doubles (we used to via Double for pretty-printing). See also #2245.
+-- Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
+-- The actual value then is: sign * fl_signi * (fl_exp_base^fl_exp)
+-- where sign = if fl_neg then (-1) else 1
+--
+-- For example FL { fl_neg = True, fl_signi = 5.3, fl_exp = 4, fl_exp_base = Base10 }
+-- denotes -5300
+
+data FractionalLit pass = FL
+ { fl_text :: XFractionalLit pass -- ^ How the value was written in the source
+ , fl_neg :: Bool -- See Note [Negative zero]
+ , fl_signi :: Rational -- The significand component of the literal
+ , fl_exp :: Integer -- The exponent component of the literal
+ , fl_exp_base :: FractionalExponentBase -- See Note [fractional exponent bases]
+ }
+
+-- See Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
+data FractionalExponentBase
+ = Base2 -- Used in hex fractional literals
+ | Base10
+ deriving (Eq, Ord, Data, Show)
+
+-- TODO
+{- Note [fractional exponent bases]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For hexadecimal rationals of
+the form 0x0.3p10 the exponent is given on base 2 rather than
+base 10. These are the only options, hence the sum type. See also #15646.
+-}
+
+-- | Be wary of using this instance to compare for equal *values* when exponents are
+-- large. The same value expressed in different syntactic form won't compare as equal when
+-- any of the exponents is >= 100.
+instance Eq (FractionalLit pass) where
+ (==) fl1 fl2 = case compare fl1 fl2 of
+ EQ -> True
+ _ -> False
+
+-- | Be wary of using this instance to compare for equal *values* when exponents are
+-- large. The same value expressed in different syntactic form won't compare as equal when
+-- any of the exponents is >= 100.
+instance Ord (FractionalLit pass) where
+ compare = compareFractionalLit
+
+-- | The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
+deriving instance Show (XFractionalLit pass) => Show (FractionalLit pass)
+
+-- | Compare fractional lits with small exponents for value equality but
+-- large values for syntactic equality.
+compareFractionalLit :: FractionalLit pass -> FractionalLit pass -> Ordering
+compareFractionalLit fl1 fl2
+ | fl_exp fl1 < 100 && fl_exp fl2 < 100 && fl_exp fl1 >= -100 && fl_exp fl2 >= -100
+ = rationalFromFractionalLit fl1 `compare` rationalFromFractionalLit fl2
+ | otherwise = (compare `on` (\x -> (fl_signi x, fl_exp x, fl_exp_base x))) fl1 fl2
+
+rationalFromFractionalLit :: FractionalLit pass -> Rational
+rationalFromFractionalLit (FL _ _ i e expBase) =
+ mkRationalWithExponentBase i e expBase
+
+mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
+mkRationalWithExponentBase i e feb = i * (eb ^^ e)
+ where eb = case feb of Base2 -> 2 ; Base10 -> 10
+
+-- | A String Literal in the source, including its original raw format for use by
+-- source to source manipulation tools.
+data StringLit pass = SL
+ { sl_st :: XStringLit pass, -- literal raw source.
+ -- See Note [Literal source text]
+ sl_fs :: FastString -- literal string value
+ }
+
+instance Eq (StringLit pass) where
+ (SL _ a) == (SL _ b) = a == b
+
+instance Ord (StringLit pass) where
+ (SL _ a) `compare` (SL _ b) = a `lexicalCompareFS` b
+
+-- | The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
+deriving instance Show (XStringLit pass) => Show (StringLit pass)
=====================================
compiler/Language/Haskell/Syntax/Lit.hs-boot
=====================================
@@ -0,0 +1,41 @@
+{-# LANGUAGE UndecidableInstances #-}
+module Language.Haskell.Syntax.Lit where
+
+import GHC.Data.FastString
+import Language.Haskell.Syntax.Extension
+import Prelude
+
+data IntegralLit pass = IL
+ { il_text :: XIntegralLit pass
+ , il_neg :: Bool
+ , il_value :: Integer
+ }
+
+instance Eq (IntegralLit pass)
+instance Ord (IntegralLit pass)
+
+data FractionalLit pass = FL
+ { fl_text :: XFractionalLit pass
+ , fl_neg :: Bool
+ , fl_signi :: Rational
+ , fl_exp :: Integer
+ , fl_exp_base :: FractionalExponentBase
+ }
+
+instance Eq (FractionalLit pass)
+instance Ord (FractionalLit pass)
+
+data FractionalExponentBase
+ = Base2
+ | Base10
+
+instance Eq FractionalExponentBase
+instance Ord FractionalExponentBase
+
+data StringLit pass = SL
+ { sl_st :: XStringLit pass,
+
+ sl_fs :: FastString
+ }
+instance Eq (StringLit pass)
+instance Ord (StringLit pass)
=====================================
compiler/ghc.cabal.in
=====================================
@@ -949,6 +949,7 @@ Library
GHC.Utils.Monad.Codensity
GHC.Utils.Monad.State.Strict
GHC.Utils.Outputable
+ GHC.Utils.Outputable.Instances
GHC.Utils.Panic
GHC.Utils.Panic.Plain
GHC.Utils.Ppr
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
=====================================
@@ -36,6 +36,8 @@ import GHC.Utils.Error (pprLocMsgEnvelopeDefault)
import GHC.Utils.Outputable (text, ($$))
import GHC.Utils.Panic (panic)
+import Language.Haskell.Syntax.Lit
+
import Haddock.Backends.Hyperlinker.Types as T
import Haddock.GhcUtils
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5ff22e8c988d661a8ec33701333867f3403411
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f5ff22e8c988d661a8ec33701333867f3403411
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/20240610/0d26453d/attachment-0001.html>
More information about the ghc-commits
mailing list