X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsLit.lhs;h=def1e352db337d5fec2321d870310577ef886c04;hp=c110ba4c6886aa1605063d64b8d3e1d99489807b;hb=3391a03562d4056de7b16cd0f632e6c43ae44cca;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/hsSyn/HsLit.lhs b/compiler/hsSyn/HsLit.lhs index c110ba4..def1e35 100644 --- a/compiler/hsSyn/HsLit.lhs +++ b/compiler/hsSyn/HsLit.lhs @@ -5,22 +5,20 @@ \section[HsLit]{Abstract syntax: source-language literals} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details +{-# LANGUAGE DeriveDataTypeable #-} module HsLit where #include "HsVersions.h" -import {-# SOURCE #-} HsExpr( SyntaxExpr ) +import {-# SOURCE #-} HsExpr( SyntaxExpr, pprExpr ) +import BasicTypes ( FractionalLit(..) ) +import HsTypes ( PostTcType ) import Type ( Type ) import Outputable import FastString -import Ratio ( Rational ) + +import Data.Data \end{code} @@ -40,12 +38,14 @@ data HsLit | HsInt Integer -- Genuinely an Int; arises from TcGenDeriv, -- and from TRANSLATION | HsIntPrim Integer -- Unboxed Int + | HsWordPrim Integer -- Unboxed Word | HsInteger Integer Type -- Genuinely an integer; arises only from TRANSLATION -- (overloaded literals are done with HsOverLit) | HsRat Rational Type -- Genuinely a rational; arises only from TRANSLATION -- (overloaded literals are done with HsOverLit) | HsFloatPrim Rational -- Unboxed Float | HsDoublePrim Rational -- Unboxed Double + deriving (Data, Typeable) instance Eq HsLit where (HsChar x1) == (HsChar x2) = x1==x2 @@ -54,41 +54,84 @@ instance Eq HsLit where (HsStringPrim x1) == (HsStringPrim x2) = x1==x2 (HsInt x1) == (HsInt x2) = x1==x2 (HsIntPrim x1) == (HsIntPrim x2) = x1==x2 + (HsWordPrim x1) == (HsWordPrim 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 - lit1 == lit2 = False + _ == _ = False data HsOverLit id -- An overloaded literal - = HsIntegral Integer (SyntaxExpr id) -- Integer-looking literals; - | HsFractional Rational (SyntaxExpr id) -- Frac-looking literals - | HsIsString FastString (SyntaxExpr id) -- String-looking literals - -- Before type checking, the SyntaxExpr is 'fromInteger' or 'fromRational' - -- After type checking, it is (fromInteger 3) or lit_78; that is, - -- the expression that should replace the literal. - -- This is unusual, because we're replacing 'fromInteger' with a call - -- to fromInteger. Reason: it allows commoning up of the fromInteger - -- calls, which wouldn't be possible if the desguarar made the application + = OverLit { + ol_val :: OverLitVal, + ol_rebindable :: Bool, -- Note [ol_rebindable] + ol_witness :: SyntaxExpr id, -- Note [Overloaded literal witnesses] + ol_type :: PostTcType } + deriving (Data, Typeable) + +data OverLitVal + = HsIntegral !Integer -- Integer-looking literals; + | HsFractional !FractionalLit -- Frac-looking literals + | HsIsString !FastString -- String-looking literals + deriving (Data, Typeable) + +overLitType :: HsOverLit a -> Type +overLitType = ol_type +\end{code} + +Note [ol_rebindable] +~~~~~~~~~~~~~~~~~~~~ +The ol_rebindable field is True if this literal is actually +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 +Note [Overloaded literal witnesses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +*Before* type checking, the SyntaxExpr in an HsOverLit is the +name of the coercion function, 'fromInteger' or 'fromRational'. +*After* type checking, it is a witness for the literal, such as + (fromInteger 3) or lit_78 +This witness should replace the literal. + +This dual role is unusual, because we're replacing 'fromInteger' with +a call to fromInteger. Reason: it allows commoning up of the fromInteger +calls, which wouldn't be possible if the desguarar made the application. + +The PostTcType in each branch records the type the overload literal is +found to have. + +\begin{code} -- Comparison operations are needed when grouping literals -- for compiling pattern-matching (module MatchLit) instance Eq (HsOverLit id) where - (HsIntegral i1 _) == (HsIntegral i2 _) = i1 == i2 - (HsFractional f1 _) == (HsFractional f2 _) = f1 == f2 - (HsIsString s1 _) == (HsIsString s2 _) = s1 == s2 - l1 == l2 = False + (OverLit {ol_val = val1}) == (OverLit {ol_val=val2}) = val1 == val2 + +instance Eq OverLitVal where + (HsIntegral i1) == (HsIntegral i2) = i1 == i2 + (HsFractional f1) == (HsFractional f2) = f1 == f2 + (HsIsString s1) == (HsIsString s2) = s1 == s2 + _ == _ = False instance Ord (HsOverLit id) where - compare (HsIntegral i1 _) (HsIntegral i2 _) = i1 `compare` i2 - compare (HsIntegral _ _) (HsFractional _ _) = LT - compare (HsIntegral _ _) (HsIsString _ _) = LT - compare (HsFractional f1 _) (HsFractional f2 _) = f1 `compare` f2 - compare (HsFractional f1 _) (HsIntegral _ _) = GT - compare (HsFractional f1 _) (HsIsString _ _) = LT - compare (HsIsString s1 _) (HsIsString s2 _) = s1 `compare` s2 - compare (HsIsString s1 _) (HsIntegral _ _) = GT - compare (HsIsString s1 _) (HsFractional _ _) = GT + compare (OverLit {ol_val=val1}) (OverLit {ol_val=val2}) = val1 `compare` val2 + +instance Ord OverLitVal where + compare (HsIntegral i1) (HsIntegral i2) = i1 `compare` i2 + compare (HsIntegral _) (HsFractional _) = LT + compare (HsIntegral _) (HsIsString _) = LT + compare (HsFractional f1) (HsFractional f2) = f1 `compare` f2 + compare (HsFractional _) (HsIntegral _) = GT + compare (HsFractional _) (HsIsString _) = LT + compare (HsIsString s1) (HsIsString s2) = s1 `compare` s2 + compare (HsIsString _) (HsIntegral _) = GT + compare (HsIsString _) (HsFractional _) = GT \end{code} \begin{code} @@ -104,9 +147,15 @@ instance Outputable HsLit where ppr (HsFloatPrim f) = rational f <> char '#' ppr (HsDoublePrim d) = rational d <> text "##" ppr (HsIntPrim i) = integer i <> char '#' + ppr (HsWordPrim w) = integer w <> text "##" + +-- in debug mode, print the expression that it's resolved to, too +instance OutputableBndr id => Outputable (HsOverLit id) where + ppr (OverLit {ol_val=val, ol_witness=witness}) + = ppr val <+> (ifPprDebug (parens (pprExpr witness))) -instance Outputable (HsOverLit id) where - ppr (HsIntegral i _) = integer i - ppr (HsFractional f _) = rational f - ppr (HsIsString s _) = pprHsString s +instance Outputable OverLitVal where + ppr (HsIntegral i) = integer i + ppr (HsFractional f) = text (fl_text f) + ppr (HsIsString s) = pprHsString s \end{code}