diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 4840d4056fbc943e6fa1350a1267363a41ffd6e9..49f35e0c9191f5d53209ab2ce1da8bf270ab608f 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -107,7 +107,7 @@ module CmdLineOpts (
 	opt_SimplCaseOfCase,
 	opt_SimplCaseMerge,
 	opt_SimplPedanticBottoms,
-	opt_SimplStrictFP,
+	opt_SimplExcessPrecision,
 
 	-- Unfolding control
 	opt_UF_HiFileThreshold,
@@ -446,7 +446,7 @@ opt_SimplDoLambdaEtaExpansion	= lookUp SLIT("-fdo-lambda-eta-expansion")
 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)
diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs
index 0b543188e9d11ef8a7da1d37bb38de8d18d1832d..2b6ccf98aca02971aede945d130b67818cf767d9 100644
--- a/ghc/compiler/prelude/PrelRules.lhs
+++ b/ghc/compiler/prelude/PrelRules.lhs
@@ -37,7 +37,7 @@ import Unique		( unpackCStringFoldrIdKey, hasKey )
 import Bits		( Bits(..) )
 import Word		( Word64 )
 import Outputable
-import CmdLineOpts      ( opt_SimplStrictFP )
+import CmdLineOpts      ( opt_SimplExcessPrecision )
 \end{code}
 
 
@@ -286,9 +286,7 @@ intResult name result
 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)
@@ -298,13 +296,13 @@ oneLit :: (Literal -> Maybe (RuleName, CoreExpr)) -> RuleFun
 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 (MachFloat  f) | opt_SimplStrictFP =
+convFloating (MachFloat  f) | not opt_SimplExcessPrecision =
    MachFloat  (toRational ((fromRational f) :: Float ))
-convFloating (MachDouble d) | opt_SimplStrictFP =
+convFloating (MachDouble d) | not opt_SimplExcessPrecision =
    MachDouble (toRational ((fromRational d) :: Double))
 convFloating l = l
 
diff --git a/ghc/docs/users_guide/using.sgml b/ghc/docs/users_guide/using.sgml
index ba80d60b3e37e0f1f39abc206fee9e230f796a6c..42c1a564293e4bb4de8eb7cd68a64fb9db9a3e59 100644
--- a/ghc/docs/users_guide/using.sgml
+++ b/ghc/docs/users_guide/using.sgml
@@ -2204,15 +2204,14 @@ We have not played with <Option>-fsemi-tagging</Option> enough to recommend it.
 </ListItem>
 </VarListEntry>
 <VarListEntry>
-<Term><Option>-fstrictfp</Option>:</Term>
+<Term><Option>-fexcess-precision</Option>:</Term>
 <ListItem>
 <Para>
-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>
diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 63d2a76a6e1e0a5ea0c242e5b4107e35e6f2bdea..630dd99ca34ef722481716b632d0b0a502ce3ecc 100644
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -253,6 +253,7 @@ GLOBAL_VAR(static,              False,          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)
@@ -1525,6 +1526,8 @@ run_phase cc_phase basename input_fn output_fn
 
 	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
@@ -1537,6 +1540,7 @@ run_phase cc_phase basename input_fn output_fn
 #ifdef mingw32_TARGET_OS
                    ++ [" -mno-cygwin"]
 #endif
+		   ++ (if excessPrecision then [] else [ "-ffloat-store" ])
 		   ++ include_paths
 		   ++ pkg_extra_cc_opts
 --		   ++ [">", ccout]
@@ -1902,8 +1906,8 @@ opts =
   ,  ( "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) )