never executed always true always false
    1 {-# LANGUAGE DeriveDataTypeable #-}
    2 
    3 -- | Source text
    4 --
    5 -- Keeping Source Text for source to source conversions
    6 --
    7 module GHC.Types.SourceText
    8    ( SourceText (..)
    9    , pprWithSourceText
   10 
   11    -- * Literals
   12    , IntegralLit(..)
   13    , FractionalLit(..)
   14    , StringLiteral(..)
   15    , negateIntegralLit
   16    , negateFractionalLit
   17    , mkIntegralLit
   18    , mkTHFractionalLit, rationalFromFractionalLit
   19    , integralFractionalLit, mkSourceFractionalLit
   20    , FractionalExponentBase(..)
   21 
   22    -- Used by the pm checker.
   23    , fractionalLitFromRational
   24    , mkFractionalLit
   25 
   26    )
   27 where
   28 
   29 import GHC.Prelude
   30 
   31 import GHC.Data.FastString
   32 
   33 import GHC.Utils.Outputable
   34 import GHC.Utils.Binary
   35 import GHC.Utils.Panic
   36 
   37 import Data.Function (on)
   38 import Data.Data
   39 import GHC.Real ( Ratio(..) )
   40 import GHC.Types.SrcLoc
   41 
   42 {-
   43 Note [Pragma source text]
   44 ~~~~~~~~~~~~~~~~~~~~~~~~~
   45 The lexer does a case-insensitive match for pragmas, as well as
   46 accepting both UK and US spelling variants.
   47 
   48 So
   49 
   50   {-# SPECIALISE #-}
   51   {-# SPECIALIZE #-}
   52   {-# Specialize #-}
   53 
   54 will all generate ITspec_prag token for the start of the pragma.
   55 
   56 In order to be able to do source to source conversions, the original
   57 source text for the token needs to be preserved, hence the
   58 `SourceText` field.
   59 
   60 So the lexer will then generate
   61 
   62   ITspec_prag "{ -# SPECIALISE"
   63   ITspec_prag "{ -# SPECIALIZE"
   64   ITspec_prag "{ -# Specialize"
   65 
   66 for the cases above.
   67  [without the space between '{' and '-', otherwise this comment won't parse]
   68 
   69 
   70 Note [Literal source text]
   71 ~~~~~~~~~~~~~~~~~~~~~~~~~~
   72 The lexer/parser converts literals from their original source text
   73 versions to an appropriate internal representation. This is a problem
   74 for tools doing source to source conversions, so the original source
   75 text is stored in literals where this can occur.
   76 
   77 Motivating examples for HsLit
   78 
   79   HsChar          '\n'       == '\x20`
   80   HsCharPrim      '\x41`#    == `A`
   81   HsString        "\x20\x41" == " A"
   82   HsStringPrim    "\x20"#    == " "#
   83   HsInt           001        == 1
   84   HsIntPrim       002#       == 2#
   85   HsWordPrim      003##      == 3##
   86   HsInt64Prim     004##      == 4##
   87   HsWord64Prim    005##      == 5##
   88   HsInteger       006        == 6
   89 
   90 For OverLitVal
   91 
   92   HsIntegral      003      == 0x003
   93   HsIsString      "\x41nd" == "And"
   94 -}
   95 
   96  -- Note [Literal source text],[Pragma source text]
   97 data SourceText
   98    = SourceText String
   99    | NoSourceText
  100       -- ^ For when code is generated, e.g. TH,
  101       -- deriving. The pretty printer will then make
  102       -- its own representation of the item.
  103    deriving (Data, Show, Eq )
  104 
  105 instance Outputable SourceText where
  106   ppr (SourceText s) = text "SourceText" <+> text s
  107   ppr NoSourceText   = text "NoSourceText"
  108 
  109 instance Binary SourceText where
  110   put_ bh NoSourceText = putByte bh 0
  111   put_ bh (SourceText s) = do
  112         putByte bh 1
  113         put_ bh s
  114 
  115   get bh = do
  116     h <- getByte bh
  117     case h of
  118       0 -> return NoSourceText
  119       1 -> do
  120         s <- get bh
  121         return (SourceText s)
  122       _ -> panic $ "Binary SourceText:" ++ show h
  123 
  124 -- | Special combinator for showing string literals.
  125 pprWithSourceText :: SourceText -> SDoc -> SDoc
  126 pprWithSourceText NoSourceText     d = d
  127 pprWithSourceText (SourceText src) _ = text src
  128 
  129 ------------------------------------------------
  130 -- Literals
  131 ------------------------------------------------
  132 
  133 -- | Integral Literal
  134 --
  135 -- Used (instead of Integer) to represent negative zegative zero which is
  136 -- required for NegativeLiterals extension to correctly parse `-0::Double`
  137 -- as negative zero. See also #13211.
  138 data IntegralLit = IL
  139    { il_text  :: SourceText
  140    , il_neg   :: Bool -- See Note [Negative zero] in GHC.Rename.Pat
  141    , il_value :: Integer
  142    }
  143    deriving (Data, Show)
  144 
  145 mkIntegralLit :: Integral a => a -> IntegralLit
  146 mkIntegralLit i = IL { il_text = SourceText (show i_integer)
  147                      , il_neg = i < 0
  148                      , il_value = i_integer }
  149   where
  150     i_integer :: Integer
  151     i_integer = toInteger i
  152 
  153 negateIntegralLit :: IntegralLit -> IntegralLit
  154 negateIntegralLit (IL text neg value)
  155   = case text of
  156       SourceText ('-':src) -> IL (SourceText src)       False    (negate value)
  157       SourceText      src  -> IL (SourceText ('-':src)) True     (negate value)
  158       NoSourceText         -> IL NoSourceText          (not neg) (negate value)
  159 
  160 -- | Fractional Literal
  161 --
  162 -- Used (instead of Rational) to represent exactly the floating point literal that we
  163 -- encountered in the user's source program. This allows us to pretty-print exactly what
  164 -- the user wrote, which is important e.g. for floating point numbers that can't represented
  165 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
  166 -- Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
  167 -- The actual value then is: sign * fl_signi * (fl_exp_base^fl_exp)
  168 --                             where sign = if fl_neg then (-1) else 1
  169 --
  170 -- For example FL { fl_neg = True, fl_signi = 5.3, fl_exp = 4, fl_exp_base = Base10 }
  171 -- denotes  -5300
  172 
  173 data FractionalLit = FL
  174     { fl_text :: SourceText     -- ^ How the value was written in the source
  175     , fl_neg :: Bool                        -- See Note [Negative zero]
  176     , fl_signi :: Rational                  -- The significand component of the literal
  177     , fl_exp :: Integer                     -- The exponent component of the literal
  178     , fl_exp_base :: FractionalExponentBase -- See Note [Fractional exponent bases]
  179     }
  180     deriving (Data, Show)
  181   -- The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on
  182 
  183 -- See Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
  184 data FractionalExponentBase
  185   = Base2 -- Used in hex fractional literals
  186   | Base10
  187   deriving (Eq, Ord, Data, Show)
  188 
  189 mkFractionalLit :: SourceText -> Bool -> Rational -> Integer -> FractionalExponentBase
  190                 -> FractionalLit
  191 mkFractionalLit = FL
  192 
  193 mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
  194 mkRationalWithExponentBase i e feb = i * (eb ^^ e)
  195   where eb = case feb of Base2 -> 2 ; Base10 -> 10
  196 
  197 fractionalLitFromRational :: Rational -> FractionalLit
  198 fractionalLitFromRational r =  FL { fl_text = NoSourceText
  199                            , fl_neg = r < 0
  200                            , fl_signi = r
  201                            , fl_exp = 0
  202                            , fl_exp_base = Base10 }
  203 
  204 rationalFromFractionalLit :: FractionalLit -> Rational
  205 rationalFromFractionalLit (FL _ _ i e expBase) =
  206   mkRationalWithExponentBase i e expBase
  207 
  208 mkTHFractionalLit :: Rational -> FractionalLit
  209 mkTHFractionalLit r =  FL { fl_text = SourceText (show (realToFrac r::Double))
  210                              -- Converting to a Double here may technically lose
  211                              -- precision (see #15502). We could alternatively
  212                              -- convert to a Rational for the most accuracy, but
  213                              -- it would cause Floats and Doubles to be displayed
  214                              -- strangely, so we opt not to do this. (In contrast
  215                              -- to mkIntegralLit, where we always convert to an
  216                              -- Integer for the highest accuracy.)
  217                            , fl_neg = r < 0
  218                            , fl_signi = r
  219                            , fl_exp = 0
  220                            , fl_exp_base = Base10 }
  221 
  222 negateFractionalLit :: FractionalLit -> FractionalLit
  223 negateFractionalLit (FL text neg i e eb)
  224   = case text of
  225       SourceText ('-':src) -> FL (SourceText src)       False (negate i) e eb
  226       SourceText      src  -> FL (SourceText ('-':src)) True  (negate i) e eb
  227       NoSourceText         -> FL NoSourceText (not neg) (negate i) e eb
  228 
  229 -- | The integer should already be negated if it's negative.
  230 integralFractionalLit :: Bool -> Integer -> FractionalLit
  231 integralFractionalLit neg i = FL { fl_text = SourceText (show i)
  232                                  , fl_neg = neg
  233                                  , fl_signi = i :% 1
  234                                  , fl_exp = 0
  235                                  , fl_exp_base = Base10 }
  236 
  237 -- | The arguments should already be negated if they are negative.
  238 mkSourceFractionalLit :: String -> Bool -> Integer -> Integer
  239                       -> FractionalExponentBase
  240                       -> FractionalLit
  241 mkSourceFractionalLit !str !b !r !i !ff = FL (SourceText str) b (r :% 1) i ff
  242 
  243 {- Note [fractional exponent bases]
  244 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  245 For hexadecimal rationals of
  246 the form 0x0.3p10 the exponent is given on base 2 rather than
  247 base 10. These are the only options, hence the sum type. See also #15646.
  248 -}
  249 
  250 
  251 -- Comparison operations are needed when grouping literals
  252 -- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
  253 
  254 instance Eq IntegralLit where
  255   (==) = (==) `on` il_value
  256 
  257 instance Ord IntegralLit where
  258   compare = compare `on` il_value
  259 
  260 instance Outputable IntegralLit where
  261   ppr (IL (SourceText src) _ _) = text src
  262   ppr (IL NoSourceText _ value) = text (show value)
  263 
  264 
  265 -- | Compare fractional lits with small exponents for value equality but
  266 --   large values for syntactic equality.
  267 compareFractionalLit :: FractionalLit -> FractionalLit -> Ordering
  268 compareFractionalLit fl1 fl2
  269   | fl_exp fl1 < 100 && fl_exp fl2 < 100 && fl_exp fl1 >= -100 && fl_exp fl2 >= -100
  270     = rationalFromFractionalLit fl1 `compare` rationalFromFractionalLit fl2
  271   | otherwise = (compare `on` (\x -> (fl_signi x, fl_exp x, fl_exp_base x))) fl1 fl2
  272 
  273 -- | Be wary of using this instance to compare for equal *values* when exponents are
  274 -- large. The same value expressed in different syntactic form won't compare as equal when
  275 -- any of the exponents is >= 100.
  276 instance Eq FractionalLit where
  277   (==) fl1 fl2 = case compare fl1 fl2 of
  278           EQ -> True
  279           _  -> False
  280 
  281 -- | Be wary of using this instance to compare for equal *values* when exponents are
  282 -- large. The same value expressed in different syntactic form won't compare as equal when
  283 -- any of the exponents is >= 100.
  284 instance Ord FractionalLit where
  285   compare = compareFractionalLit
  286 
  287 instance Outputable FractionalLit where
  288   ppr (fl@(FL {})) =
  289     pprWithSourceText (fl_text fl) $
  290       rational $ mkRationalWithExponentBase (fl_signi fl) (fl_exp fl) (fl_exp_base fl)
  291 
  292 -- | A String Literal in the source, including its original raw format for use by
  293 -- source to source manipulation tools.
  294 data StringLiteral = StringLiteral
  295                        { sl_st :: SourceText, -- literal raw source.
  296                                               -- See not [Literal source text]
  297                          sl_fs :: FastString, -- literal string value
  298                          sl_tc :: Maybe RealSrcSpan -- Location of
  299                                                     -- possible
  300                                                     -- trailing comma
  301                        -- AZ: if we could have a LocatedA
  302                        -- StringLiteral we would not need sl_tc, but
  303                        -- that would cause import loops.
  304 
  305                        -- AZ:2: sl_tc should be an EpaAnchor, to allow
  306                        -- editing and reprinting the AST. Need a more
  307                        -- robust solution.
  308 
  309                        } deriving Data
  310 
  311 instance Eq StringLiteral where
  312   (StringLiteral _ a _) == (StringLiteral _ b _) = a == b
  313 
  314 instance Outputable StringLiteral where
  315   ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
  316 
  317 instance Binary StringLiteral where
  318   put_ bh (StringLiteral st fs _) = do
  319             put_ bh st
  320             put_ bh fs
  321   get bh = do
  322             st <- get bh
  323             fs <- get bh
  324             return (StringLiteral st fs Nothing)