HsLit.hs 8.74 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[HsLit]{Abstract syntax: source-language literals}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, DeriveDataTypeable #-}
9 10 11 12 13 14 15 16
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}

17 18 19 20
module HsLit where

#include "HsVersions.h"

21
import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
22 23
import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
                    negateFractionalLit,SourceText(..),pprWithSourceText )
24
import Type       ( Type )
25
import Outputable
26
import FastString
27
import PlaceHolder ( PostTc,PostRn,DataId,OutputableBndrId )
28

29
import Data.ByteString (ByteString)
30
import Data.Data hiding ( Fixity )
dreixel's avatar
dreixel committed
31

Austin Seipp's avatar
Austin Seipp committed
32 33 34
{-
************************************************************************
*                                                                      *
35
\subsection[HsLit]{Literals}
Austin Seipp's avatar
Austin Seipp committed
36 37 38
*                                                                      *
************************************************************************
-}
39

40
-- Note [Literal source text] in BasicTypes for SourceText fields in
Alan Zimmerman's avatar
Alan Zimmerman committed
41
-- the following
42
-- | Haskell Literal
43
data HsLit
44 45 46 47 48 49 50 51
  = HsChar          SourceText Char
      -- ^ Character
  | HsCharPrim      SourceText Char
      -- ^ Unboxed character
  | HsString        SourceText FastString
      -- ^ String
  | HsStringPrim    SourceText ByteString
      -- ^ Packed bytes
52
  | HsInt           IntegralLit
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
      -- ^ Genuinely an Int; arises from
      -- @TcGenDeriv@, and from TRANSLATION
  | HsIntPrim       SourceText Integer
      -- ^ literal @Int#@
  | HsWordPrim      SourceText Integer
      -- ^ literal @Word#@
  | HsInt64Prim     SourceText Integer
      -- ^ literal @Int64#@
  | HsWord64Prim    SourceText Integer
      -- ^ literal @Word64#@
  | HsInteger       SourceText Integer Type
      -- ^ Genuinely an integer; arises only
      -- from TRANSLATION (overloaded
      -- literals are done with HsOverLit)
  | HsRat           FractionalLit Type
      -- ^ Genuinely a rational; arises only from
      -- TRANSLATION (overloaded literals are
      -- done with HsOverLit)
  | HsFloatPrim     FractionalLit
      -- ^ Unboxed Float
  | HsDoublePrim    FractionalLit
      -- ^ Unboxed Double
75
  deriving Data
76 77

instance Eq HsLit where
78 79 80 81
  (HsChar _ x1)       == (HsChar _ x2)       = x1==x2
  (HsCharPrim _ x1)   == (HsCharPrim _ x2)   = x1==x2
  (HsString _ x1)     == (HsString _ x2)     = x1==x2
  (HsStringPrim _ x1) == (HsStringPrim _ x2) = x1==x2
82
  (HsInt x1)          == (HsInt x2)          = x1==x2
83 84 85 86 87 88 89 90 91
  (HsIntPrim _ x1)    == (HsIntPrim _ x2)    = x1==x2
  (HsWordPrim _ x1)   == (HsWordPrim _ x2)   = x1==x2
  (HsInt64Prim _ x1)  == (HsInt64Prim _ x2)  = x1==x2
  (HsWord64Prim _ x1) == (HsWord64Prim _ x2) = x1==x2
  (HsInteger _ x1 _)  == (HsInteger _ x2 _)  = x1==x2
  (HsRat x1 _)        == (HsRat x2 _)        = x1==x2
  (HsFloatPrim x1)    == (HsFloatPrim x2)    = x1==x2
  (HsDoublePrim x1)   == (HsDoublePrim x2)   = x1==x2
  _                   == _                   = False
92

93 94
-- | Haskell Overloaded Literal
data HsOverLit id
95
  = OverLit {
96
        ol_val :: OverLitVal,
97
        ol_rebindable :: PostRn id Bool, -- Note [ol_rebindable]
98
        ol_witness :: HsExpr id,     -- Note [Overloaded literal witnesses]
99 100
        ol_type :: PostTc id Type }
deriving instance (DataId id) => Data (HsOverLit id)
101

102
-- Note [Literal source text] in BasicTypes for SourceText fields in
Alan Zimmerman's avatar
Alan Zimmerman committed
103
-- the following
104
-- | Overloaded Literal Value
105
data OverLitVal
106
  = HsIntegral   !IntegralLit            -- ^ Integer-looking literals;
107 108
  | HsFractional !FractionalLit          -- ^ Frac-looking literals
  | HsIsString   !SourceText !FastString -- ^ String-looking literals
109
  deriving Data
110

111 112 113 114 115
negateOverLitVal :: OverLitVal -> OverLitVal
negateOverLitVal (HsIntegral i) = HsIntegral (negateIntegralLit i)
negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f)
negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"

116
overLitType :: HsOverLit a -> PostTc a Type
117 118
overLitType = ol_type

Austin Seipp's avatar
Austin Seipp committed
119
{-
120 121
Note [ol_rebindable]
~~~~~~~~~~~~~~~~~~~~
122
The ol_rebindable field is True if this literal is actually
123 124 125 126 127 128 129 130 131 132
using rebindable syntax.  Specifically:

  False iff ol_witness is the standard one
  True  iff ol_witness is non-standard

Equivalently it's True if
  a) RebindableSyntax is on
  b) the witness for fromInteger/fromRational/fromString
     that happens to be in scope isn't the standard one

133 134
Note [Overloaded literal witnesses]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
135
*Before* type checking, the HsExpr in an HsOverLit is the
136 137
name of the coercion function, 'fromInteger' or 'fromRational'.
*After* type checking, it is a witness for the literal, such as
138
        (fromInteger 3) or lit_78
139
This witness should replace the literal.
140

141
This dual role is unusual, because we're replacing 'fromInteger' with
142
a call to fromInteger.  Reason: it allows commoning up of the fromInteger
143
calls, which wouldn't be possible if the desguarar made the application.
144

145 146
The PostTcType in each branch records the type the overload literal is
found to have.
Austin Seipp's avatar
Austin Seipp committed
147
-}
148

149 150
-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)
151
instance Eq (HsOverLit id) where
152 153 154
  (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2

instance Eq OverLitVal where
155
  (HsIntegral   i1)   == (HsIntegral   i2)   = i1 == i2
156 157 158
  (HsFractional f1)   == (HsFractional f2)   = f1 == f2
  (HsIsString _ s1)   == (HsIsString _ s2)   = s1 == s2
  _                   == _                   = False
159

160
instance Ord (HsOverLit id) where
161 162 163
  compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2

instance Ord OverLitVal where
164 165 166
  compare (HsIntegral i1)     (HsIntegral i2)     = i1 `compare` i2
  compare (HsIntegral _)      (HsFractional _)    = LT
  compare (HsIntegral _)      (HsIsString _ _)    = LT
167
  compare (HsFractional f1)   (HsFractional f2)   = f1 `compare` f2
168
  compare (HsFractional _)    (HsIntegral   _)    = GT
169 170
  compare (HsFractional _)    (HsIsString _ _)    = LT
  compare (HsIsString _ s1)   (HsIsString _ s2)   = s1 `compare` s2
171
  compare (HsIsString _ _)    (HsIntegral   _)    = GT
172
  compare (HsIsString _ _)    (HsFractional _)    = GT
173 174

instance Outputable HsLit where
Alan Zimmerman's avatar
Alan Zimmerman committed
175 176 177 178
    ppr (HsChar st c)       = pprWithSourceText st (pprHsChar c)
    ppr (HsCharPrim st c)   = pp_st_suffix st primCharSuffix (pprPrimChar c)
    ppr (HsString st s)     = pprWithSourceText st (pprHsString s)
    ppr (HsStringPrim st s) = pprWithSourceText st (pprHsBytes s)
179
    ppr (HsInt i)           = pprWithSourceText (il_text i) (integer (il_value i))
Alan Zimmerman's avatar
Alan Zimmerman committed
180 181 182 183 184 185 186 187 188 189 190 191
    ppr (HsInteger st i _)  = pprWithSourceText st (integer i)
    ppr (HsRat f _)         = ppr f
    ppr (HsFloatPrim f)     = ppr f <> primFloatSuffix
    ppr (HsDoublePrim d)    = ppr d <> primDoubleSuffix
    ppr (HsIntPrim st i)    = pprWithSourceText st (pprPrimInt i)
    ppr (HsWordPrim st w)   = pprWithSourceText st (pprPrimWord w)
    ppr (HsInt64Prim st i)  = pp_st_suffix st primInt64Suffix  (pprPrimInt64 i)
    ppr (HsWord64Prim st w) = pp_st_suffix st primWord64Suffix (pprPrimWord64 w)

pp_st_suffix :: SourceText -> SDoc -> SDoc -> SDoc
pp_st_suffix NoSourceText         _ doc = doc
pp_st_suffix (SourceText st) suffix _   = text st <> suffix
192

193
-- in debug mode, print the expression that it's resolved to, too
194
instance (OutputableBndrId id) => Outputable (HsOverLit id) where
195 196
  ppr (OverLit {ol_val=val, ol_witness=witness})
        = ppr val <+> (ifPprDebug (parens (pprExpr witness)))
197 198

instance Outputable OverLitVal where
199
  ppr (HsIntegral i)     = pprWithSourceText (il_text i) (integer (il_value i))
200
  ppr (HsFractional f)   = ppr f
Alan Zimmerman's avatar
Alan Zimmerman committed
201
  ppr (HsIsString st s)  = pprWithSourceText st (pprHsString s)
202 203 204 205 206 207 208 209 210 211

-- | 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
-- primitive and not wrapped in constructors if they are boxed). This happens
-- mainly for too reasons:
--  * We do not want to expose their internal representation
--  * The warnings become too messy
pmPprHsLit :: HsLit -> SDoc
pmPprHsLit (HsChar _ c)       = pprHsChar c
pmPprHsLit (HsCharPrim _ c)   = pprHsChar c
Alan Zimmerman's avatar
Alan Zimmerman committed
212
pmPprHsLit (HsString st s)    = pprWithSourceText st (pprHsString s)
213
pmPprHsLit (HsStringPrim _ s) = pprHsBytes s
214
pmPprHsLit (HsInt i)          = integer (il_value i)
215 216 217 218 219 220 221 222
pmPprHsLit (HsIntPrim _ i)    = integer i
pmPprHsLit (HsWordPrim _ w)   = integer w
pmPprHsLit (HsInt64Prim _ i)  = integer i
pmPprHsLit (HsWord64Prim _ w) = integer w
pmPprHsLit (HsInteger _ i _)  = integer i
pmPprHsLit (HsRat f _)        = ppr f
pmPprHsLit (HsFloatPrim f)    = ppr f
pmPprHsLit (HsDoublePrim d)   = ppr d