never executed always true always false
    1 
    2 {-# LANGUAGE ConstraintKinds      #-}
    3 {-# LANGUAGE DeriveDataTypeable   #-}
    4 {-# LANGUAGE FlexibleContexts     #-}
    5 {-# LANGUAGE FlexibleInstances    #-}
    6 {-# LANGUAGE TypeFamilies         #-}
    7 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
    8                                       -- in module Language.Haskell.Syntax.Extension
    9 
   10 {-
   11 (c) The University of Glasgow 2006
   12 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   13 
   14 -}
   15 
   16 -- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
   17 
   18 -- | Source-language literals
   19 module Language.Haskell.Syntax.Lit where
   20 
   21 import GHC.Prelude
   22 
   23 import GHC.Types.Basic (PprPrec(..), topPrec )
   24 import GHC.Types.SourceText
   25 import GHC.Core.Type
   26 import GHC.Utils.Outputable
   27 import GHC.Utils.Panic
   28 import GHC.Data.FastString
   29 import Language.Haskell.Syntax.Extension
   30 
   31 import Data.ByteString (ByteString)
   32 import Data.Data hiding ( Fixity )
   33 
   34 {-
   35 ************************************************************************
   36 *                                                                      *
   37 \subsection[HsLit]{Literals}
   38 *                                                                      *
   39 ************************************************************************
   40 -}
   41 
   42 -- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
   43 -- the following
   44 -- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the Xxxxx
   45 -- fields in the following
   46 -- | Haskell Literal
   47 data HsLit x
   48   = HsChar (XHsChar x) {- SourceText -} Char
   49       -- ^ Character
   50   | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
   51       -- ^ Unboxed character
   52   | HsString (XHsString x) {- SourceText -} FastString
   53       -- ^ String
   54   | HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString
   55       -- ^ Packed bytes
   56   | HsInt (XHsInt x)  IntegralLit
   57       -- ^ Genuinely an Int; arises from
   58       -- "GHC.Tc.Deriv.Generate", and from TRANSLATION
   59   | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
   60       -- ^ literal @Int#@
   61   | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
   62       -- ^ literal @Word#@
   63   | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
   64       -- ^ literal @Int64#@
   65   | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
   66       -- ^ literal @Word64#@
   67   | HsInteger (XHsInteger x) {- SourceText -} Integer Type
   68       -- ^ Genuinely an integer; arises only
   69       -- from TRANSLATION (overloaded
   70       -- literals are done with HsOverLit)
   71   | HsRat (XHsRat x)  FractionalLit Type
   72       -- ^ Genuinely a rational; arises only from
   73       -- TRANSLATION (overloaded literals are
   74       -- done with HsOverLit)
   75   | HsFloatPrim (XHsFloatPrim x)   FractionalLit
   76       -- ^ Unboxed Float
   77   | HsDoublePrim (XHsDoublePrim x) FractionalLit
   78       -- ^ Unboxed Double
   79 
   80   | XLit !(XXLit x)
   81 
   82 instance Eq (HsLit x) where
   83   (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
   84   (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2
   85   (HsString _ x1)     == (HsString _ x2)     = x1==x2
   86   (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
   87   (HsInt _ x1)        == (HsInt _ x2)        = x1==x2
   88   (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2
   89   (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2
   90   (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2
   91   (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
   92   (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2
   93   (HsRat _ x1 _)      == (HsRat _ x2 _)      = x1==x2
   94   (HsFloatPrim _ x1)  == (HsFloatPrim _ x2)  = x1==x2
   95   (HsDoublePrim _ x1) == (HsDoublePrim _ x2) = x1==x2
   96   _                   == _                   = False
   97 
   98 -- | Haskell Overloaded Literal
   99 data HsOverLit p
  100   = OverLit {
  101       ol_ext :: (XOverLit p),
  102       ol_val :: OverLitVal}
  103 
  104   | XOverLit
  105       !(XXOverLit p)
  106 
  107 -- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
  108 -- the following
  109 -- | Overloaded Literal Value
  110 data OverLitVal
  111   = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;
  112   | HsFractional !FractionalLit          -- ^ Frac-looking literals
  113   | HsIsString   !SourceText !FastString -- ^ String-looking literals
  114   deriving Data
  115 
  116 negateOverLitVal :: OverLitVal -> OverLitVal
  117 negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
  118 negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
  119 negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
  120 
  121 -- Comparison operations are needed when grouping literals
  122 -- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
  123 instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
  124   (OverLit _ val1) == (OverLit _ val2) = val1 == val2
  125   (XOverLit  val1) == (XOverLit  val2) = val1 == val2
  126   _ == _ = panic "Eq HsOverLit"
  127 
  128 instance Eq OverLitVal where
  129   (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2
  130   (HsFractional f1)   == (HsFractional f2)   = f1 == f2
  131   (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2
  132   _                   == _                   = False
  133 
  134 instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
  135   compare (OverLit _ val1)  (OverLit _ val2) = val1 `compare` val2
  136   compare (XOverLit  val1)  (XOverLit  val2) = val1 `compare` val2
  137   compare _ _ = panic "Ord HsOverLit"
  138 
  139 instance Ord OverLitVal where
  140   compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2
  141   compare (HsIntegral _)      (HsFractional _)    = LT
  142   compare (HsIntegral _)      (HsIsString _ _)    = LT
  143   compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2
  144   compare (HsFractional _)    (HsIntegral   _)    = GT
  145   compare (HsFractional _)    (HsIsString _ _)    = LT
  146   compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `lexicalCompareFS` s2
  147   compare (HsIsString _ _)    (HsIntegral   _)    = GT
  148   compare (HsIsString _ _)    (HsFractional _)    = GT
  149 
  150 instance Outputable OverLitVal where
  151   ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))
  152   ppr (HsFractional f)   = ppr f
  153   ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)
  154 
  155 -- | @'hsLitNeedsParens' p l@ returns 'True' if a literal @l@ needs
  156 -- to be parenthesized under precedence @p@.
  157 hsLitNeedsParens :: PprPrec -> HsLit x -> Bool
  158 hsLitNeedsParens p = go
  159   where
  160     go (HsChar {})        = False
  161     go (HsCharPrim {})    = False
  162     go (HsString {})      = False
  163     go (HsStringPrim {})  = False
  164     go (HsInt _ x)        = p > topPrec && il_neg x
  165     go (HsIntPrim _ x)    = p > topPrec && x < 0
  166     go (HsWordPrim {})    = False
  167     go (HsInt64Prim _ x)  = p > topPrec && x < 0
  168     go (HsWord64Prim {})  = False
  169     go (HsInteger _ x _)  = p > topPrec && x < 0
  170     go (HsRat _ x _)      = p > topPrec && fl_neg x
  171     go (HsFloatPrim _ x)  = p > topPrec && fl_neg x
  172     go (HsDoublePrim _ x) = p > topPrec && fl_neg x
  173     go (XLit _)           = False
  174 
  175 -- | @'hsOverLitNeedsParens' p ol@ returns 'True' if an overloaded literal
  176 -- @ol@ needs to be parenthesized under precedence @p@.
  177 hsOverLitNeedsParens :: PprPrec -> HsOverLit x -> Bool
  178 hsOverLitNeedsParens p (OverLit { ol_val = olv }) = go olv
  179   where
  180     go :: OverLitVal -> Bool
  181     go (HsIntegral x)   = p > topPrec && il_neg x
  182     go (HsFractional x) = p > topPrec && fl_neg x
  183     go (HsIsString {})  = False
  184 hsOverLitNeedsParens _ (XOverLit { }) = False