X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FCheck.lhs;h=59c102f88446560a4538be428e2db07a9e3482e5;hp=cc00536e85aebd21a7e7a97600ef7281053b2d18;hb=2d4d636af091b8da27466b5cf90011395a9c2f66;hpb=ca53c38335cdc671f0b1e0949aa1514fc3fd72a5 diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index cc00536..59c102f 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -30,6 +30,7 @@ import Type import SrcLoc import UniqSet import Util +import BasicTypes import Outputable import FastString \end{code} @@ -436,14 +437,14 @@ get_lit :: Pat id -> Maybe HsLit -- It doesn't matter which one, because they will only be compared -- with other HsLits gotten in the same way get_lit (LitPat lit) = Just lit -get_lit (NPat (OverLit { ol_val = HsIntegral i}) mb _) = Just (HsIntPrim (mb_neg mb i)) -get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg mb f)) +get_lit (NPat (OverLit { ol_val = HsIntegral i}) mb _) = Just (HsIntPrim (mb_neg negate mb i)) +get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg negateFractionalLit mb f)) get_lit (NPat (OverLit { ol_val = HsIsString s }) _ _) = Just (HsStringPrim s) get_lit _ = Nothing -mb_neg :: Num a => Maybe b -> a -> a -mb_neg Nothing v = v -mb_neg (Just _) v = -v +mb_neg :: (a -> a) -> Maybe b -> a -> a +mb_neg _ Nothing v = v +mb_neg negate (Just _) v = negate v get_unused_cons :: [Pat Id] -> [DataCon] get_unused_cons used_cons = ASSERT( not (null used_cons) ) unused_cons @@ -643,7 +644,7 @@ might_fail_pat (ConPatOut { pat_args = ps }) = any might_fail_lpat (hsConPatArgs -- Finally the ones that are sure to succeed, or which are covered by the checking algorithm might_fail_pat (LazyPat _) = False -- Always succeeds -might_fail_pat _ = False -- VarPat, WildPat, LitPat, NPat, TypePat +might_fail_pat _ = False -- VarPat, WildPat, LitPat, NPat -------------- might_fail_lpat :: LPat Id -> Bool