diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs index 801095e7d9e2cbdcaf8803345351daf5baa51a27..0b543188e9d11ef8a7da1d37bb38de8d18d1832d 100644 --- a/ghc/compiler/prelude/PrelRules.lhs +++ b/ghc/compiler/prelude/PrelRules.lhs @@ -3,6 +3,10 @@ % \section[ConFold]{Constant Folder} +Conceptually, constant folding should be parameterized with the kind +of target machine to get identical behaviour during compilation time +and runtime. We cheat a little bit here... + ToDo: check boundaries before folding, e.g. we can fold the Float addition (i1 + i2) only if it results in a valid Float. @@ -33,6 +37,7 @@ import Unique ( unpackCStringFoldrIdKey, hasKey ) import Bits ( Bits(..) ) import Word ( Word64 ) import Outputable +import CmdLineOpts ( opt_SimplStrictFP ) \end{code} @@ -286,21 +291,31 @@ or_rule r1 r2 args = case r1 args of Nothing -> r2 args twoLits :: (Literal -> Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun -twoLits rule [Lit l1, Lit l2] = rule l1 l2 +twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2) twoLits rule other = Nothing oneLit :: (Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun -oneLit rule [Lit l1] = rule l1 +oneLit rule [Lit l1] = rule (convFloating l1) oneLit rule other = Nothing +-- When we strictfp is requested, cut down the precision of the Rational value +-- to that of Float/Double. We confuse host architecture and target architecture +-- here, but it's convenient (and wrong :-). +convFloating :: Literal -> Literal +convFloating (MachFloat f) | opt_SimplStrictFP = + MachFloat (toRational ((fromRational f) :: Float )) +convFloating (MachDouble d) | opt_SimplStrictFP = + MachDouble (toRational ((fromRational d) :: Double)) +convFloating l = l + trueVal = Var trueDataConId falseVal = Var falseDataConId mkIntVal i = Lit (mkMachInt i) mkWordVal w = Lit (mkMachWord w) mkCharVal c = Lit (MachChar c) -mkFloatVal f = Lit (MachFloat f) -mkDoubleVal d = Lit (MachDouble d) +mkFloatVal f = Lit (convFloating (MachFloat f)) +mkDoubleVal d = Lit (convFloating (MachDouble d)) \end{code}