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 {-# LANGUAGE DeriveDataTypeable #-}
   9
  10 module HsLit where
  11
  12 #include "HsVersions.h"
  13
  14 import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr )
  15 import HsTypes (PostTcType)
  16 import Type     ( Type )
  17 import Outputable
  18 import FastString
  19
  20 import Data.Data
  21 \end{code}
  22
  23
  24 %************************************************************************
  25 %*                                                                      *
  26 \subsection[HsLit]{Literals}
  27 %*                                                                      *
  28 %************************************************************************
  29
  30
  31 \begin{code}
  32 data HsLit
  33   = HsChar          Char                -- Character
  34   | HsCharPrim      Char                -- Unboxed character
  35   | HsString        FastString          -- String
  36   | HsStringPrim    FastString          -- Packed string
  37   | HsInt           Integer             -- Genuinely an Int; arises from TcGenDeriv,
  38                                         --      and from TRANSLATION
  39   | HsIntPrim       Integer             -- Unboxed Int
  40   | HsWordPrim      Integer             -- Unboxed Word
  41   | HsInteger       Integer  Type       -- Genuinely an integer; arises only from TRANSLATION
  42                                         --      (overloaded literals are done with HsOverLit)
  43   | HsRat           Rational Type       -- Genuinely a rational; arises only from TRANSLATION
  44                                         --      (overloaded literals are done with HsOverLit)
  45   | HsFloatPrim     Rational            -- Unboxed Float
  46   | HsDoublePrim    Rational            -- Unboxed Double
  47   deriving (Data, Typeable)
  48
  49 instance Eq HsLit where
  50   (HsChar x1)       == (HsChar x2)       = x1==x2
  51   (HsCharPrim x1)   == (HsCharPrim x2)   = x1==x2
  52   (HsString x1)     == (HsString x2)     = x1==x2
  53   (HsStringPrim x1) == (HsStringPrim x2) = x1==x2
  54   (HsInt x1)        == (HsInt x2)        = x1==x2
  55   (HsIntPrim x1)    == (HsIntPrim x2)    = x1==x2
  56   (HsWordPrim x1)   == (HsWordPrim x2)   = x1==x2
  57   (HsInteger x1 _)  == (HsInteger x2 _)  = x1==x2
  58   (HsRat x1 _)      == (HsRat x2 _)      = x1==x2
  59   (HsFloatPrim x1)  == (HsFloatPrim x2)  = x1==x2
  60   (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
  61   _                 == _                 = False
  62
  63 data HsOverLit id       -- An overloaded literal
  64   = OverLit {
  65         ol_val :: OverLitVal,
  66         ol_rebindable :: Bool,          -- True <=> rebindable syntax
  67                                         -- False <=> standard syntax
  68         ol_witness :: SyntaxExpr id,    -- Note [Overloaded literal witnesses]
  69         ol_type :: PostTcType }
  70   deriving (Data, Typeable)
  71
  72 data OverLitVal
  73   = HsIntegral   !Integer       -- Integer-looking literals;
  74   | HsFractional !Rational      -- Frac-looking literals
  75   | HsIsString   !FastString    -- String-looking literals
  76   deriving (Data, Typeable)
  77
  78 overLitType :: HsOverLit a -> Type
  79 overLitType = ol_type
  80 \end{code}
  81
  82 Note [Overloaded literal witnesses]
  83 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  84 *Before* type checking, the SyntaxExpr in an HsOverLit is the
  85 name of the coercion function, 'fromInteger' or 'fromRational'.
  86 *After* type checking, it is a witness for the literal, such as
  87         (fromInteger 3) or lit_78
  88 This witness should replace the literal.
  89
  90 This dual role is unusual, because we're replacing 'fromInteger' with
  91 a call to fromInteger.  Reason: it allows commoning up of the fromInteger
  92 calls, which wouldn't be possible if the desguarar made the application
  93
  94 The PostTcType in each branch records the type the overload literal is
  95 found to have.
  96
  97 \begin{code}
  98 -- Comparison operations are needed when grouping literals
  99 -- for compiling pattern-matching (module MatchLit)
 100 instance Eq (HsOverLit id) where
 101   (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2
 102
 103 instance Eq OverLitVal where
 104   (HsIntegral i1)   == (HsIntegral i2)   = i1 == i2
 105   (HsFractional f1) == (HsFractional f2) = f1 == f2
 106   (HsIsString s1)   == (HsIsString s2)   = s1 == s2
 107   _                 == _                 = False
 108
 109 instance Ord (HsOverLit id) where
 110   compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2
 111
 112 instance Ord OverLitVal where
 113   compare (HsIntegral i1)   (HsIntegral i2)   = i1 `compare` i2
 114   compare (HsIntegral _)    (HsFractional _)  = LT
 115   compare (HsIntegral _)    (HsIsString _)    = LT
 116   compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2
 117   compare (HsFractional _)  (HsIntegral _)    = GT
 118   compare (HsFractional _)  (HsIsString _)    = LT
 119   compare (HsIsString s1)   (HsIsString s2)   = s1 `compare` s2
 120   compare (HsIsString _)    (HsIntegral _)    = GT
 121   compare (HsIsString _)    (HsFractional _)  = GT
 122 \end{code}
 123
 124 \begin{code}
 125 instance Outputable HsLit where
 126         -- Use "show" because it puts in appropriate escapes
 127     ppr (HsChar c)       = pprHsChar c
 128     ppr (HsCharPrim c)   = pprHsChar c <> char '#'
 129     ppr (HsString s)     = pprHsString s
 130     ppr (HsStringPrim s) = pprHsString s <> char '#'
 131     ppr (HsInt i)        = integer i
 132     ppr (HsInteger i _)  = integer i
 133     ppr (HsRat f _)      = rational f
 134     ppr (HsFloatPrim f)  = rational f <> char '#'
 135     ppr (HsDoublePrim d) = rational d <> text "##"
 136     ppr (HsIntPrim i)    = integer i  <> char '#'
 137     ppr (HsWordPrim w)   = integer w  <> text "##"
 138
 139 -- in debug mode, print the expression that it's resolved to, too
 140 instance OutputableBndr id => Outputable (HsOverLit id) where
 141   ppr (OverLit {ol_val=val, ol_witness=witness})
 142         = ppr val <+> (ifPprDebug (parens (pprExpr witness)))
 143
 144 instance Outputable OverLitVal where
 145   ppr (HsIntegral i)   = integer i
 146   ppr (HsFractional f) = rational f
 147   ppr (HsIsString s)   = pprHsString s
 148 \end{code}