Strictfp-like behaviour is the default now, which can be switched off
via -fexcess-precision. (Has anybody a better name for this option?)
opt_SimplCaseOfCase,
opt_SimplCaseMerge,
opt_SimplPedanticBottoms,
opt_SimplCaseOfCase,
opt_SimplCaseMerge,
opt_SimplPedanticBottoms,
+ opt_SimplExcessPrecision,
-- Unfolding control
opt_UF_HiFileThreshold,
-- Unfolding control
opt_UF_HiFileThreshold,
opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case")
opt_SimplCaseMerge = lookUp SLIT("-fcase-merge")
opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms")
opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case")
opt_SimplCaseMerge = lookUp SLIT("-fcase-merge")
opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms")
-opt_SimplStrictFP = lookUp SLIT("-fstrictfp")
+opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision")
-- Unfolding control
opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (45::Int)
-- Unfolding control
opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (45::Int)
import Bits ( Bits(..) )
import Word ( Word64 )
import Outputable
import Bits ( Bits(..) )
import Word ( Word64 )
import Outputable
-import CmdLineOpts ( opt_SimplStrictFP )
+import CmdLineOpts ( opt_SimplExcessPrecision )
type RuleFun = [CoreExpr] -> Maybe (RuleName, CoreExpr)
or_rule :: RuleFun -> RuleFun -> RuleFun
type RuleFun = [CoreExpr] -> Maybe (RuleName, CoreExpr)
or_rule :: RuleFun -> RuleFun -> RuleFun
-or_rule r1 r2 args = case r1 args of
- Just stuff -> Just stuff
- Nothing -> r2 args
+or_rule r1 r2 args = maybe (r2 args) Just (r1 args) -- i.e.: r1 args `mplus` r2 args
twoLits :: (Literal -> Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun
twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2)
twoLits :: (Literal -> Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun
twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2)
oneLit rule [Lit l1] = rule (convFloating l1)
oneLit rule other = Nothing
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 :-).
+-- When excess precision is not 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 :: Literal -> Literal
-convFloating (MachFloat f) | opt_SimplStrictFP =
+convFloating (MachFloat f) | not opt_SimplExcessPrecision =
MachFloat (toRational ((fromRational f) :: Float ))
MachFloat (toRational ((fromRational f) :: Float ))
-convFloating (MachDouble d) | opt_SimplStrictFP =
+convFloating (MachDouble d) | not opt_SimplExcessPrecision =
MachDouble (toRational ((fromRational d) :: Double))
convFloating l = l
MachDouble (toRational ((fromRational d) :: Double))
convFloating l = l
</ListItem>
</VarListEntry>
<VarListEntry>
</ListItem>
</VarListEntry>
<VarListEntry>
-<Term><Option>-fstrictfp</Option>:</Term>
+<Term><Option>-fexcess-precision</Option>:</Term>
-This option has an effect similar to Java's <Literal>strictfp</Literal>
-modifier: When it is not given, intermediate floating point values can
-have a <Emphasis>greater</Emphasis> precision/range than the final type.
-Generally this is a good thing, but some programs may rely on the exact
-precision/range of <Literal>Float</Literal>/<Literal>Double</Literal>
-values and should use this option for their compilation.
+When this option is given, intermediate floating point values can have
+a <Emphasis>greater</Emphasis> precision/range than the final type.
+Generally this is a good thing, but some programs may rely on the
+exact precision/range of <Literal>Float</Literal>/<Literal>Double</Literal>
+values and should not use this option for their compilation.
</Para>
</ListItem>
</VarListEntry>
</Para>
</ListItem>
</VarListEntry>
#endif
GLOBAL_VAR(collect_ghc_timing, False, Bool)
GLOBAL_VAR(do_asm_mangling, True, Bool)
#endif
GLOBAL_VAR(collect_ghc_timing, False, Bool)
GLOBAL_VAR(do_asm_mangling, True, Bool)
+GLOBAL_VAR(excess_precision, False, Bool)
-----------------------------------------------------------------------------
-- Splitting object files (for libraries)
-----------------------------------------------------------------------------
-- Splitting object files (for libraries)
pkg_extra_cc_opts <- getPackageExtraCcOpts
pkg_extra_cc_opts <- getPackageExtraCcOpts
+ excessPrecision <- readIORef excess_precision
+
run_something "C Compiler"
(unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
++ md_c_flags
run_something "C Compiler"
(unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
++ md_c_flags
#ifdef mingw32_TARGET_OS
++ [" -mno-cygwin"]
#endif
#ifdef mingw32_TARGET_OS
++ [" -mno-cygwin"]
#endif
+ ++ (if excessPrecision then [] else [ "-ffloat-store" ])
++ include_paths
++ pkg_extra_cc_opts
-- ++ [">", ccout]
++ include_paths
++ pkg_extra_cc_opts
-- ++ [">", ccout]
, ( "fusagesp" , NoArg (do writeIORef opt_UsageSPInf True
add opt_C "-fusagesp-on") )
, ( "fusagesp" , NoArg (do writeIORef opt_UsageSPInf True
add opt_C "-fusagesp-on") )
- , ( "fstrictfp" , NoArg (do add opt_C "-fstrictfp"
- add opt_c "-ffloat-store"))
+ , ( "fexcess-precision" , NoArg (do writeIORef excess_precision True
+ add opt_C "-fexcess-precision"))
-- flags that are "active negatives"
, ( "fno-implicit-prelude" , PassFlag (add opt_C) )
-- flags that are "active negatives"
, ( "fno-implicit-prelude" , PassFlag (add opt_C) )