X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FMatchLit.lhs;h=0bd25389376c8a77ecd5e7961239fce2aa47dcc2;hp=be112e09a782cdb6dc49eaa6c66b3c4f5306977d;hb=c648345e3d82c0c40333bfd8ddea2633e21b08dc;hpb=e79e580be5d3d7caed73dec9e5a72b244cd1cc39 diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index be112e0..0bd2538 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -33,6 +33,7 @@ import Literal import SrcLoc import Data.Ratio import Outputable +import BasicTypes import Util import FastString \end{code} @@ -64,8 +65,8 @@ dsLit (HsStringPrim s) = return (Lit (MachStr s)) dsLit (HsCharPrim c) = return (Lit (MachChar c)) dsLit (HsIntPrim i) = return (Lit (MachInt i)) dsLit (HsWordPrim w) = return (Lit (MachWord w)) -dsLit (HsFloatPrim f) = return (Lit (MachFloat f)) -dsLit (HsDoublePrim d) = return (Lit (MachDouble d)) +dsLit (HsFloatPrim f) = return (Lit (MachFloat (fl_value f))) +dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d))) dsLit (HsChar c) = return (mkCharExpr c) dsLit (HsString str) = mkStringExprFS str @@ -73,8 +74,8 @@ dsLit (HsInteger i _) = mkIntegerExpr i dsLit (HsInt i) = return (mkIntExpr i) dsLit (HsRat r ty) = do - num <- mkIntegerExpr (numerator r) - denom <- mkIntegerExpr (denominator r) + num <- mkIntegerExpr (numerator (fl_value r)) + denom <- mkIntegerExpr (denominator (fl_value r)) return (mkConApp ratio_data_con [Type integer_ty, num, denom]) where (ratio_data_con, integer_ty) @@ -112,8 +113,8 @@ 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 -hsLitKey (HsDoublePrim d) = MachDouble d +hsLitKey (HsFloatPrim f) = MachFloat (fl_value f) +hsLitKey (HsDoublePrim d) = MachDouble (fl_value d) hsLitKey (HsString s) = MachStr s hsLitKey l = pprPanic "hsLitKey" (ppr l) @@ -124,8 +125,8 @@ hsOverLitKey (OverLit { ol_val = l }) neg = litValKey l neg litValKey :: OverLitVal -> Bool -> Literal litValKey (HsIntegral i) False = MachInt i litValKey (HsIntegral i) True = MachInt (-i) -litValKey (HsFractional r) False = MachFloat r -litValKey (HsFractional r) True = MachFloat (-r) +litValKey (HsFractional r) False = MachFloat (fl_value r) +litValKey (HsFractional r) True = MachFloat (negate (fl_value r)) litValKey (HsIsString s) neg = ASSERT( not neg) MachStr s \end{code} @@ -186,12 +187,12 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _ (Just _, HsIntegral i) -> Just (-i) _ -> Nothing - mb_rat_lit :: Maybe Rational + mb_rat_lit :: Maybe FractionalLit mb_rat_lit = case (mb_neg, val) of - (Nothing, HsIntegral i) -> Just (fromInteger i) - (Just _, HsIntegral i) -> Just (fromInteger (-i)) + (Nothing, HsIntegral i) -> Just (integralFractionalLit (fromInteger i)) + (Just _, HsIntegral i) -> Just (integralFractionalLit (fromInteger (-i))) (Nothing, HsFractional f) -> Just f - (Just _, HsFractional f) -> Just (-f) + (Just _, HsFractional f) -> Just (negateFractionalLit f) _ -> Nothing mb_str_lit :: Maybe FastString