From 2869e22f31ff45ac4693551dcc311d5219dc8347 Mon Sep 17 00:00:00 2001
From: panne <unknown>
Date: Sun, 16 Jul 2000 21:10:48 +0000
Subject: [PATCH] [project @ 2000-07-16 21:10:48 by panne] This commit tries to
fix the discrepancies between the results of floating point calculations
during runtime and compile time, see e.g.
fptools/ghc/tests/numeric/should_run/arith008.hs. Part of the story was the
fact that floating point values are represented as Rationals in GHC and
therefore never lost precision, at least for the operations for which
constant folding is done. To compensate for this, before and after floating
point operations the operands are temporarily converted to/from Float/Double.
This is wrong, because host architecture and target architecture are confused
this way, but in a non-cross-compiling scenario it works.
---
ghc/compiler/prelude/PrelRules.lhs | 23 +++++++++++++++++++----
1 file changed, 19 insertions(+), 4 deletions(-)
diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs
index 801095e7d9e2..0b543188e9d1 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}
--
GitLab