Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc
[ghc.git] / compiler / hsSyn / HsLit.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5 \section[HsLit]{Abstract syntax: source-language literals}
6
7 \begin{code}
8 {-# OPTIONS -fno-warn-tabs #-}
9 -- The above warning supression flag is a temporary kludge.
10 -- While working on this module you are encouraged to remove it and
11 -- detab the module (please do the detabbing in a separate patch). See
12 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
13 -- for details
14
15 {-# LANGUAGE DeriveDataTypeable #-}
16
17 module HsLit where
18
19 #include "HsVersions.h"
20
21 import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
22 import BasicTypes ( FractionalLit(..) )
23 import Type     ( Type, Kind )
24 import Outputable
25 import FastString
26
27 import Data.ByteString (ByteString)
28 import Data.Data
29 \end{code}
30
31
32 %************************************************************************
33 %*                                                                      *
34 \subsection{Annotating the syntax}
35 %*                                                                      *
36 %************************************************************************
37
38 \begin{code}
39 type PostTcKind = Kind
40 type PostTcType = Type          -- Used for slots in the abstract syntax
41                                 -- where we want to keep slot for a type
42                                 -- to be added by the type checker...but
43                                 -- before typechecking it's just bogus
44
45 placeHolderType :: PostTcType   -- Used before typechecking
46 placeHolderType  = panic "Evaluated the place holder for a PostTcType"
47
48 placeHolderKind :: PostTcKind   -- Used before typechecking
49 placeHolderKind  = panic "Evaluated the place holder for a PostTcKind"
50 \end{code}
51
52 %************************************************************************
53 %*                                                                      *
54 \subsection[HsLit]{Literals}
55 %*                                                                      *
56 %************************************************************************
57
58
59 \begin{code}
60 data HsLit
61   = HsChar          Char                -- Character
62   | HsCharPrim      Char                -- Unboxed character
63   | HsString        FastString          -- String
64   | HsStringPrim    ByteString          -- Packed bytes
65   | HsInt           Integer             -- Genuinely an Int; arises from TcGenDeriv, 
66                                         --      and from TRANSLATION
67   | HsIntPrim       Integer             -- literal Int#
68   | HsWordPrim      Integer             -- literal Word#
69   | HsInt64Prim     Integer             -- literal Int64#
70   | HsWord64Prim    Integer             -- literal Word64#
71   | HsInteger       Integer  Type       -- Genuinely an integer; arises only from TRANSLATION
72                                         --      (overloaded literals are done with HsOverLit)
73   | HsRat           FractionalLit Type  -- Genuinely a rational; arises only from TRANSLATION
74                                         --      (overloaded literals are done with HsOverLit)
75   | HsFloatPrim     FractionalLit       -- Unboxed Float
76   | HsDoublePrim    FractionalLit       -- Unboxed Double
77   deriving (Data, Typeable)
78
79 instance Eq HsLit where
80   (HsChar x1)       == (HsChar x2)       = x1==x2
81   (HsCharPrim x1)   == (HsCharPrim x2)   = x1==x2
82   (HsString x1)     == (HsString x2)     = x1==x2
83   (HsStringPrim x1) == (HsStringPrim x2) = x1==x2
84   (HsInt x1)        == (HsInt x2)        = x1==x2
85   (HsIntPrim x1)    == (HsIntPrim x2)    = x1==x2
86   (HsWordPrim x1)   == (HsWordPrim x2)   = x1==x2
87   (HsInt64Prim x1)  == (HsInt64Prim x2)  = x1==x2
88   (HsWord64Prim x1) == (HsWord64Prim x2) = x1==x2
89   (HsInteger x1 _)  == (HsInteger x2 _)  = x1==x2
90   (HsRat x1 _)      == (HsRat x2 _)      = x1==x2
91   (HsFloatPrim x1)  == (HsFloatPrim x2)  = x1==x2
92   (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
93   _                 == _                 = False
94
95 data HsOverLit id       -- An overloaded literal
96   = OverLit {
97         ol_val :: OverLitVal, 
98         ol_rebindable :: Bool,          -- Note [ol_rebindable]
99         ol_witness :: SyntaxExpr id,    -- Note [Overloaded literal witnesses]
100         ol_type :: PostTcType }
101   deriving (Data, Typeable)
102
103 data OverLitVal
104   = HsIntegral   !Integer       -- Integer-looking literals;
105   | HsFractional !FractionalLit -- Frac-looking literals
106   | HsIsString   !FastString    -- String-looking literals
107   deriving (Data, Typeable)
108
109 overLitType :: HsOverLit a -> Type
110 overLitType = ol_type
111 \end{code}
112
113 Note [ol_rebindable]
114 ~~~~~~~~~~~~~~~~~~~~
115 The ol_rebindable field is True if this literal is actually 
116 using rebindable syntax.  Specifically:
117
118   False iff ol_witness is the standard one
119   True  iff ol_witness is non-standard
120
121 Equivalently it's True if
122   a) RebindableSyntax is on
123   b) the witness for fromInteger/fromRational/fromString
124      that happens to be in scope isn't the standard one
125
126 Note [Overloaded literal witnesses]
127 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
128 *Before* type checking, the SyntaxExpr in an HsOverLit is the
129 name of the coercion function, 'fromInteger' or 'fromRational'.
130 *After* type checking, it is a witness for the literal, such as
131         (fromInteger 3) or lit_78
132 This witness should replace the literal.
133
134 This dual role is unusual, because we're replacing 'fromInteger' with 
135 a call to fromInteger.  Reason: it allows commoning up of the fromInteger
136 calls, which wouldn't be possible if the desguarar made the application.
137
138 The PostTcType in each branch records the type the overload literal is
139 found to have.
140
141 \begin{code}
142 -- Comparison operations are needed when grouping literals
143 -- for compiling pattern-matching (module MatchLit)
144 instance Eq (HsOverLit id) where
145   (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
146
147 instance Eq OverLitVal where
148   (HsIntegral i1)   == (HsIntegral i2)   = i1 == i2
149   (HsFractional f1) == (HsFractional f2) = f1 == f2
150   (HsIsString s1)   == (HsIsString s2)   = s1 == s2
151   _                 == _                 = False
152
153 instance Ord (HsOverLit id) where
154   compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
155
156 instance Ord OverLitVal where
157   compare (HsIntegral i1)   (HsIntegral i2)   = i1 `compare` i2
158   compare (HsIntegral _)    (HsFractional _)  = LT
159   compare (HsIntegral _)    (HsIsString _)    = LT
160   compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
161   compare (HsFractional _)  (HsIntegral _)    = GT
162   compare (HsFractional _)  (HsIsString _)    = LT
163   compare (HsIsString s1)   (HsIsString s2)   = s1 `compare` s2
164   compare (HsIsString _)    (HsIntegral _)    = GT
165   compare (HsIsString _)    (HsFractional _)  = GT
166 \end{code}
167
168 \begin{code}
169 instance Outputable HsLit where
170         -- Use "show" because it puts in appropriate escapes
171     ppr (HsChar c)       = pprHsChar c
172     ppr (HsCharPrim c)   = pprHsChar c <> char '#'
173     ppr (HsString s)     = pprHsString s
174     ppr (HsStringPrim s) = pprHsBytes s <> char '#'
175     ppr (HsInt i)        = integer i
176     ppr (HsInteger i _)  = integer i
177     ppr (HsRat f _)      = ppr f
178     ppr (HsFloatPrim f)  = ppr f <> char '#'
179     ppr (HsDoublePrim d) = ppr d <> text "##"
180     ppr (HsIntPrim i)    = integer i  <> char '#'
181     ppr (HsWordPrim w)   = integer w  <> text "##"
182     ppr (HsInt64Prim i)  = integer i  <> text "L#"
183     ppr (HsWord64Prim w) = integer w  <> text "L##"
184
185 -- in debug mode, print the expression that it's resolved to, too
186 instance OutputableBndr id => Outputable (HsOverLit id) where
187   ppr (OverLit {ol_val=val, ol_witness=witness}) 
188         = ppr val <+> (ifPprDebug (parens (pprExpr witness)))
189
190 instance Outputable OverLitVal where
191   ppr (HsIntegral i)   = integer i 
192   ppr (HsFractional f) = ppr f
193   ppr (HsIsString s)   = pprHsString s
194 \end{code}