Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules

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

diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index 3751f95..c8e8e62 100644 (file)
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -1,9 +1,18 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[MatchLit]{Pattern-matching literal patterns}
+
+Pattern-matching literal patterns
 
 \begin{code}
+{-# OPTIONS_GHC -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/WorkingConventions#Warnings
+-- for details
+
 module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey,
                  tidyLitPat, tidyNPat, 
                  matchLiterals, matchNPlusKPats, matchNPats ) where
@@ -17,24 +26,21 @@ import DsMonad
 import DsUtils
 
 import HsSyn
-import Id              ( Id, idType )
+import Id
 import CoreSyn
-import TyCon           ( tyConDataCons )
-import DataCon         ( DataCon )
-import TcType          ( tcSplitTyConApp, isIntegerTy, isIntTy, 
-                         isFloatTy, isDoubleTy, isStringTy )
-import Type            ( Type )
-import PrelNames       ( ratioTyConKey )
-import TysWiredIn      ( stringTy, consDataCon, intDataCon, floatDataCon, doubleDataCon )
-import PrelNames       ( eqStringName )
-import Unique          ( hasKey )
-import Literal         ( mkMachInt, Literal(..) )
-import SrcLoc          ( noLoc )
-import Ratio           ( numerator, denominator )
-import SrcLoc          ( Located(..), unLoc )
+import TyCon
+import DataCon
+import TcType
+import Type
+import PrelNames
+import TysWiredIn
+import Unique
+import Literal
+import SrcLoc
+import Ratio
 import Outputable
-import Util            ( mapAndUnzip )
-import FastString      ( lengthFS, unpackFS )
+import Util
+import FastString
 \end{code}
 
 %************************************************************************
@@ -86,6 +92,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}
@@ -108,6 +115,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}
 
 %************************************************************************
@@ -139,6 +148,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
@@ -157,6 +167,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}
 
 
@@ -173,7 +188,8 @@ matchLiterals :: [Id]
              -> DsM MatchResult
 
 matchLiterals (var:vars) ty sub_groups
-  = do {       -- Deal with each group
+  = ASSERT( all notNull sub_groups )
+    do {       -- Deal with each group
        ; alts <- mapM match_group sub_groups
 
                -- Combine results.  For everything except String