X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchLit.lhs;h=2cdab30bf8b162c0059b9182b1eab6385bdfb7b7;hb=1ee08bbe86b03ba74a9be309a84602b34e41cbb4;hp=d7e8ba64d8f565963c73ca8ddb911c5b03678f01;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git

diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index d7e8ba6..2cdab30 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -87,6 +87,7 @@ dsOverLit :: HsOverLit Id -> DsM CoreExpr
 -- (an expression for) the literal value itself
 dsOverLit (HsIntegral   _ lit) = dsExpr lit
 dsOverLit (HsFractional _ lit) = dsExpr lit
+dsOverLit (HsIsString   _ lit) = dsExpr lit
 \end{code}
 
 \begin{code}
@@ -109,6 +110,8 @@ hsOverLitKey (HsIntegral i _) False   = MachInt i
 hsOverLitKey (HsIntegral i _) True    = MachInt (-i)
 hsOverLitKey (HsFractional r _) False = MachFloat r
 hsOverLitKey (HsFractional r _) True  = MachFloat (-r)
+hsOverLitKey (HsIsString s _)  False  = MachStr s
+-- negated string should never happen
 \end{code}
 
 %************************************************************************
@@ -140,6 +143,7 @@ tidyNPat over_lit mb_neg eq lit_ty
   | isIntTy    lit_ty = mk_con_pat intDataCon    (HsIntPrim int_val)
   | isFloatTy  lit_ty = mk_con_pat floatDataCon  (HsFloatPrim  rat_val)
   | isDoubleTy lit_ty = mk_con_pat doubleDataCon (HsDoublePrim rat_val)
+--  | isStringTy lit_ty = mk_con_pat stringDataCon (HsStringPrim str_val)
   | otherwise	      = NPat over_lit mb_neg eq lit_ty
   where
     mk_con_pat :: DataCon -> HsLit -> Pat Id
@@ -158,6 +162,11 @@ tidyNPat over_lit mb_neg eq lit_ty
     rat_val = case neg_lit of
 		HsIntegral   i _ -> fromInteger i
 		HsFractional f _ -> f
+	
+    str_val :: FastString
+    str_val = case neg_lit of
+		HsIsString   s _ -> s
+		_                -> error "tidyNPat"
 \end{code}