{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DeriveDataTypeable   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                      -- in module Language.Haskell.Syntax.Extension

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

-}

-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*

-- | Source-language literals
module Language.Haskell.Syntax.Lit where

import Language.Haskell.Syntax.Extension

import GHC.Utils.Panic (panic)
import GHC.Types.SourceText (IntegralLit, FractionalLit, SourceText, negateIntegralLit, negateFractionalLit)
import GHC.Core.Type (Type)

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 (Integer)

{-
************************************************************************
*                                                                      *
\subsection[HsLit]{Literals}
*                                                                      *
************************************************************************
-}

-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
-- the following
-- Note [Trees That Grow] in Language.Haskell.Syntax.Extension for the Xxxxx
-- fields in the following
-- | Haskell Literal
data HsLit x
  = HsChar (XHsChar x) {- SourceText -} Char
      -- ^ Character
  | HsCharPrim (XHsCharPrim x) {- SourceText -} Char
      -- ^ Unboxed character
  | HsString (XHsString x) {- SourceText -} FastString
      -- ^ String
  | HsStringPrim (XHsStringPrim x) {- SourceText -} !ByteString
      -- ^ Packed bytes
  | HsInt (XHsInt x)  IntegralLit
      -- ^ Genuinely an Int; arises from
      -- "GHC.Tc.Deriv.Generate", and from TRANSLATION
  | HsIntPrim (XHsIntPrim x) {- SourceText -} Integer
      -- ^ literal @Int#@
  | HsWordPrim (XHsWordPrim x) {- SourceText -} Integer
      -- ^ literal @Word#@
  | HsInt64Prim (XHsInt64Prim x) {- SourceText -} Integer
      -- ^ literal @Int64#@
  | HsWord64Prim (XHsWord64Prim x) {- SourceText -} Integer
      -- ^ literal @Word64#@
  | HsInteger (XHsInteger x) {- SourceText -} Integer Type
      -- ^ Genuinely an integer; arises only
      -- from TRANSLATION (overloaded
      -- literals are done with HsOverLit)
  | HsRat (XHsRat x)  FractionalLit Type
      -- ^ Genuinely a rational; arises only from
      -- TRANSLATION (overloaded literals are
      -- done with HsOverLit)
  | HsFloatPrim (XHsFloatPrim x)   FractionalLit
      -- ^ Unboxed Float
  | HsDoublePrim (XHsDoublePrim x) FractionalLit
      -- ^ Unboxed Double

  | XLit !(XXLit x)

instance Eq (HsLit x) where
  (HsChar XHsChar x
_ Char
x1)       == :: HsLit x -> HsLit x -> Bool
== (HsChar XHsChar x
_ Char
x2)       = Char
x1Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x2
  (HsCharPrim XHsCharPrim x
_ Char
x1)   == (HsCharPrim XHsCharPrim x
_ Char
x2)   = Char
x1Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
x2
  (HsString XHsString x
_ FastString
x1)     == (HsString XHsString x
_ FastString
x2)     = FastString
x1FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
==FastString
x2
  (HsStringPrim XHsStringPrim x
_ ByteString
x1) == (HsStringPrim XHsStringPrim x
_ ByteString
x2) = ByteString
x1ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
x2
  (HsInt XHsInt x
_ IntegralLit
x1)        == (HsInt XHsInt x
_ IntegralLit
x2)        = IntegralLit
x1IntegralLit -> IntegralLit -> Bool
forall a. Eq a => a -> a -> Bool
==IntegralLit
x2
  (HsIntPrim XHsIntPrim x
_ Integer
x1)    == (HsIntPrim XHsIntPrim x
_ Integer
x2)    = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
  (HsWordPrim XHsWordPrim x
_ Integer
x1)   == (HsWordPrim XHsWordPrim x
_ Integer
x2)   = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
  (HsInt64Prim XHsInt64Prim x
_ Integer
x1)  == (HsInt64Prim XHsInt64Prim x
_ Integer
x2)  = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
  (HsWord64Prim XHsWord64Prim x
_ Integer
x1) == (HsWord64Prim XHsWord64Prim x
_ Integer
x2) = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
  (HsInteger XHsInteger x
_ Integer
x1 Type
_)  == (HsInteger XHsInteger x
_ Integer
x2 Type
_)  = Integer
x1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
x2
  (HsRat XHsRat x
_ FractionalLit
x1 Type
_)      == (HsRat XHsRat x
_ FractionalLit
x2 Type
_)      = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
  (HsFloatPrim XHsFloatPrim x
_ FractionalLit
x1)  == (HsFloatPrim XHsFloatPrim x
_ FractionalLit
x2)  = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
  (HsDoublePrim XHsDoublePrim x
_ FractionalLit
x1) == (HsDoublePrim XHsDoublePrim x
_ FractionalLit
x2) = FractionalLit
x1FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
==FractionalLit
x2
  HsLit x
_                   == HsLit x
_                   = Bool
False

-- | Haskell Overloaded Literal
data HsOverLit p
  = OverLit {
      forall p. HsOverLit p -> XOverLit p
ol_ext :: (XOverLit p),
      forall p. HsOverLit p -> OverLitVal
ol_val :: OverLitVal}

  | XOverLit
      !(XXOverLit p)

-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
-- the following
-- | Overloaded Literal Value
data OverLitVal
  = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;
  | HsFractional !FractionalLit          -- ^ Frac-looking literals
  | HsIsString   !SourceText !FastString -- ^ String-looking literals
  deriving Typeable OverLitVal
Typeable OverLitVal =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> OverLitVal -> c OverLitVal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OverLitVal)
-> (OverLitVal -> Constr)
-> (OverLitVal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OverLitVal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OverLitVal))
-> ((forall b. Data b => b -> b) -> OverLitVal -> OverLitVal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OverLitVal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OverLitVal -> r)
-> (forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OverLitVal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal)
-> Data OverLitVal
OverLitVal -> Constr
OverLitVal -> DataType
(forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OverLitVal -> u
forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverLitVal -> c OverLitVal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverLitVal
$ctoConstr :: OverLitVal -> Constr
toConstr :: OverLitVal -> Constr
$cdataTypeOf :: OverLitVal -> DataType
dataTypeOf :: OverLitVal -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverLitVal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OverLitVal)
$cgmapT :: (forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
gmapT :: (forall b. Data b => b -> b) -> OverLitVal -> OverLitVal
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverLitVal -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> OverLitVal -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverLitVal -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverLitVal -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverLitVal -> m OverLitVal
Data

negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral IntegralLit
i) = IntegralLit -> OverLitVal
HsIntegral (IntegralLit -> IntegralLit
negateIntegralLit IntegralLit
i)
negateOverLitVal (HsFractional FractionalLit
f) = FractionalLit -> OverLitVal
HsFractional (FractionalLit -> FractionalLit
negateFractionalLit FractionalLit
f)
negateOverLitVal OverLitVal
_ = String -> OverLitVal
forall a. HasCallStack => String -> a
panic String
"negateOverLitVal: argument is not a number"

-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where
  (OverLit XOverLit p
_ OverLitVal
val1) == :: HsOverLit p -> HsOverLit p -> Bool
== (OverLit XOverLit p
_ OverLitVal
val2) = OverLitVal
val1 OverLitVal -> OverLitVal -> Bool
forall a. Eq a => a -> a -> Bool
== OverLitVal
val2
  (XOverLit  XXOverLit p
val1) == (XOverLit  XXOverLit p
val2) = XXOverLit p
val1 XXOverLit p -> XXOverLit p -> Bool
forall a. Eq a => a -> a -> Bool
== XXOverLit p
val2
  HsOverLit p
_ == HsOverLit p
_ = String -> Bool
forall a. HasCallStack => String -> a
panic String
"Eq HsOverLit"

instance Eq OverLitVal where
  (HsIntegral   IntegralLit
i1)   == :: OverLitVal -> OverLitVal -> Bool
== (HsIntegral   IntegralLit
i2)   = IntegralLit
i1 IntegralLit -> IntegralLit -> Bool
forall a. Eq a => a -> a -> Bool
== IntegralLit
i2
  (HsFractional FractionalLit
f1)   == (HsFractional FractionalLit
f2)   = FractionalLit
f1 FractionalLit -> FractionalLit -> Bool
forall a. Eq a => a -> a -> Bool
== FractionalLit
f2
  (HsIsString SourceText
_ FastString
s1)   == (HsIsString SourceText
_ FastString
s2)   = FastString
s1 FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
s2
  OverLitVal
_                   == OverLitVal
_                   = Bool
False

instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where
  compare :: HsOverLit p -> HsOverLit p -> Ordering
compare (OverLit XOverLit p
_ OverLitVal
val1)  (OverLit XOverLit p
_ OverLitVal
val2) = OverLitVal
val1 OverLitVal -> OverLitVal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` OverLitVal
val2
  compare (XOverLit  XXOverLit p
val1)  (XOverLit  XXOverLit p
val2) = XXOverLit p
val1 XXOverLit p -> XXOverLit p -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` XXOverLit p
val2
  compare HsOverLit p
_ HsOverLit p
_ = String -> Ordering
forall a. HasCallStack => String -> a
panic String
"Ord HsOverLit"

instance Ord OverLitVal where
  compare :: OverLitVal -> OverLitVal -> Ordering
compare (HsIntegral IntegralLit
i1)     (HsIntegral IntegralLit
i2)     = IntegralLit
i1 IntegralLit -> IntegralLit -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IntegralLit
i2
  compare (HsIntegral IntegralLit
_)      (HsFractional FractionalLit
_)    = Ordering
LT
  compare (HsIntegral IntegralLit
_)      (HsIsString SourceText
_ FastString
_)    = Ordering
LT
  compare (HsFractional FractionalLit
f1)   (HsFractional FractionalLit
f2)   = FractionalLit
f1 FractionalLit -> FractionalLit -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FractionalLit
f2
  compare (HsFractional FractionalLit
_)    (HsIntegral   IntegralLit
_)    = Ordering
GT
  compare (HsFractional FractionalLit
_)    (HsIsString SourceText
_ FastString
_)    = Ordering
LT
  compare (HsIsString SourceText
_ FastString
s1)   (HsIsString SourceText
_ FastString
s2)   = FastString
s1 FastString -> FastString -> Ordering
`lexicalCompareFS` FastString
s2
  compare (HsIsString SourceText
_ FastString
_)    (HsIntegral   IntegralLit
_)    = Ordering
GT
  compare (HsIsString SourceText
_ FastString
_)    (HsFractional FractionalLit
_)    = Ordering
GT