Add 123## literals for Word#

[ghc-hetmet.git] / compiler / deSugar / MatchLit.lhs

diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 1cf87ce..31d3c28 100644 (file)
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -66,26 +66,27 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc.
 
 \begin{code}
 dsLit :: HsLit -> DsM CoreExpr
-dsLit (HsStringPrim s) = returnDs (mkLit (MachStr s))
-dsLit (HsCharPrim c)   = returnDs (mkLit (MachChar c))
-dsLit (HsIntPrim i)    = returnDs (mkLit (MachInt i))
-dsLit (HsFloatPrim f)  = returnDs (mkLit (MachFloat f))
-dsLit (HsDoublePrim d) = returnDs (mkLit (MachDouble d))
-
-dsLit (HsChar c)       = returnDs (mkCharExpr c)
+dsLit (HsStringPrim s) = return (mkLit (MachStr s))
+dsLit (HsCharPrim   c) = return (mkLit (MachChar c))
+dsLit (HsIntPrim    i) = return (mkLit (MachInt i))
+dsLit (HsWordPrim   w) = return (mkLit (MachWord w))
+dsLit (HsFloatPrim  f) = return (mkLit (MachFloat f))
+dsLit (HsDoublePrim d) = return (mkLit (MachDouble d))
+
+dsLit (HsChar c)       = return (mkCharExpr c)
 dsLit (HsString str)   = mkStringExprFS str
 dsLit (HsInteger i _)  = mkIntegerExpr i
-dsLit (HsInt i)               = returnDs (mkIntExpr i)
+dsLit (HsInt i)               = return (mkIntExpr i)
 
-dsLit (HsRat r ty)
-  = mkIntegerExpr (numerator r)                `thenDs` \ num ->
-    mkIntegerExpr (denominator r)      `thenDs` \ denom ->
-    returnDs (mkConApp ratio_data_con [Type integer_ty, num, denom])
+dsLit (HsRat r ty) = do
+   num   <- mkIntegerExpr (numerator r)
+   denom <- mkIntegerExpr (denominator r)
+   return (mkConApp ratio_data_con [Type integer_ty, num, denom])
   where
     (ratio_data_con, integer_ty) 
-       = case tcSplitTyConApp ty of
-               (tycon, [i_ty]) -> ASSERT(isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)
-                                  (head (tyConDataCons tycon), i_ty)
+        = case tcSplitTyConApp ty of
+                (tycon, [i_ty]) -> ASSERT(isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)
+                                   (head (tyConDataCons tycon), i_ty)
 
 dsOverLit :: HsOverLit Id -> DsM CoreExpr
 -- Post-typechecker, the SyntaxExpr field of an OverLit contains 
@@ -103,6 +104,7 @@ hsLitKey :: HsLit -> Literal
 -- It only works for primitive types and strings; 
 -- others have been removed by tidy
 hsLitKey (HsIntPrim     i) = mkMachInt  i
+hsLitKey (HsWordPrim    w) = mkMachWord w
 hsLitKey (HsCharPrim    c) = MachChar   c
 hsLitKey (HsStringPrim  s) = MachStr    s
 hsLitKey (HsFloatPrim   f) = MachFloat  f
@@ -128,7 +130,7 @@ hsOverLitKey (HsIsString s _ _)  False  = MachStr s
 \begin{code}
 tidyLitPat :: HsLit -> Pat Id
 -- Result has only the following HsLits:
---     HsIntPrim, HsCharPrim, HsFloatPrim
+--     HsIntPrim, HsWordPrim, HsCharPrim, HsFloatPrim
 --     HsDoublePrim, HsStringPrim, HsString
 --  * HsInteger, HsRat, HsInt can't show up in LitPats
 --  * We get rid of HsChar right here
@@ -145,6 +147,7 @@ tidyLitPat lit = LitPat lit
 tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> SyntaxExpr Id -> Pat Id
 tidyNPat over_lit mb_neg eq 
   | isIntTy    (overLitType over_lit) = mk_con_pat intDataCon    (HsIntPrim int_val)
+  | isWordTy   (overLitType over_lit) = mk_con_pat wordDataCon   (HsWordPrim int_val)
   | isFloatTy  (overLitType over_lit) = mk_con_pat floatDataCon  (HsFloatPrim  rat_val)
   | isDoubleTy (overLitType over_lit) = mk_con_pat doubleDataCon (HsDoublePrim rat_val)
 --  | isStringTy lit_ty = mk_con_pat stringDataCon (HsStringPrim str_val)