Commit 70c64164 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Make -fexcess-precision a fully-dynamic flag

It used to be part-dynamic, part-static.
parent e731cb13
......@@ -18,7 +18,7 @@ module StaticFlagParser (
#include "HsVersions.h"
import qualified StaticFlags as SF
import StaticFlags ( v_opt_C_ready, opt_SimplExcessPrecision )
import StaticFlags ( v_opt_C_ready )
import CmdLineParser
import SrcLoc
import Util
......@@ -65,15 +65,7 @@ parseStaticFlagsFull flagsAvailable args = do
-- see sanity code in staticOpts
writeIORef v_opt_C_ready True
-- HACK: -fexcess-precision is both a static and a dynamic flag. If
-- the static flag parser has slurped it, we must return it as a
-- leftover too. ToDo: make -fexcess-precision dynamic only.
let excess_prec
| opt_SimplExcessPrecision = map (mkGeneralLocated "in excess_prec")
["-fexcess-precision"]
| otherwise = []
return (excess_prec ++ leftover, warns)
return (leftover, warns)
flagsStatic :: [Flag IO]
-- All the static flags should appear in this list. It describes how each
......@@ -122,7 +114,6 @@ isStaticFlag f =
"fruntime-types",
"fno-opt-coercion",
"fno-flat-cache",
"fexcess-precision",
"fhardwire-lib-paths",
"fcpr-off"
]
......
......@@ -35,7 +35,6 @@ module StaticFlags (
-- optimisation opts
opt_NoStateHack,
opt_CprOff,
opt_SimplExcessPrecision,
opt_NoOptCoercion,
opt_NoFlatCache,
......@@ -177,10 +176,6 @@ opt_CprOff :: Bool
opt_CprOff = lookUp (fsLit "-fcpr-off")
-- Switch off CPR analysis in the new demand analyser
-- Simplifier switches
opt_SimplExcessPrecision :: Bool
opt_SimplExcessPrecision = lookUp (fsLit "-fexcess-precision")
opt_NoOptCoercion :: Bool
opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion")
......
......@@ -42,7 +42,6 @@ import Maybes ( orElse )
import Name ( Name, nameOccName )
import Outputable
import FastString
import StaticFlags ( opt_SimplExcessPrecision )
import BasicTypes
import DynFlags
import Platform
......@@ -284,9 +283,9 @@ cmpOp cmp = go
negOp :: DynFlags -> Literal -> Maybe CoreExpr -- Negate
negOp _ (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational
negOp _ (MachFloat f) = Just (mkFloatVal (-f))
negOp dflags (MachFloat f) = Just (mkFloatVal dflags (-f))
negOp _ (MachDouble 0.0) = Nothing
negOp _ (MachDouble d) = Just (mkDoubleVal (-d))
negOp dflags (MachDouble d) = Just (mkDoubleVal dflags (-d))
negOp dflags (MachInt i) = intResult dflags (-i)
negOp _ _ = Nothing
......@@ -329,16 +328,16 @@ wordShiftOp2 _ _ _ _ = Nothing
floatOp2 :: (Rational -> Rational -> Rational)
-> DynFlags -> Literal -> Literal
-> Maybe (Expr CoreBndr)
floatOp2 op _ (MachFloat f1) (MachFloat f2)
= Just (mkFloatVal (f1 `op` f2))
floatOp2 op dflags (MachFloat f1) (MachFloat f2)
= Just (mkFloatVal dflags (f1 `op` f2))
floatOp2 _ _ _ _ = Nothing
--------------------------
doubleOp2 :: (Rational -> Rational -> Rational)
-> DynFlags -> Literal -> Literal
-> Maybe (Expr CoreBndr)
doubleOp2 op _ (MachDouble f1) (MachDouble f2)
= Just (mkDoubleVal (f1 `op` f2))
doubleOp2 op dflags (MachDouble f1) (MachDouble f2)
= Just (mkDoubleVal dflags (f1 `op` f2))
doubleOp2 _ _ _ _ = Nothing
--------------------------
......@@ -518,13 +517,13 @@ unaryLit :: (DynFlags -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
unaryLit op = do
dflags <- getDynFlags
[Lit l] <- getArgs
liftMaybe $ op dflags (convFloating l)
liftMaybe $ op dflags (convFloating dflags l)
binaryLit :: (DynFlags -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr
binaryLit op = do
dflags <- getDynFlags
[Lit l1, Lit l2] <- getArgs
liftMaybe $ op dflags (convFloating l1) (convFloating l2)
liftMaybe $ op dflags (convFloating dflags l1) (convFloating dflags l2)
leftIdentity :: Literal -> RuleM CoreExpr
leftIdentity id_lit = leftIdentityDynFlags (const id_lit)
......@@ -580,12 +579,12 @@ nonZeroLit n = getLiteral n >>= guard . not . isZeroLit
-- 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) | not opt_SimplExcessPrecision =
convFloating :: DynFlags -> Literal -> Literal
convFloating dflags (MachFloat f) | not (dopt Opt_ExcessPrecision dflags) =
MachFloat (toRational (fromRational f :: Float ))
convFloating (MachDouble d) | not opt_SimplExcessPrecision =
convFloating dflags (MachDouble d) | not (dopt Opt_ExcessPrecision dflags) =
MachDouble (toRational (fromRational d :: Double))
convFloating l = l
convFloating _ l = l
guardFloatDiv :: RuleM ()
guardFloatDiv = do
......@@ -616,10 +615,10 @@ mkIntVal :: DynFlags -> Integer -> Expr CoreBndr
mkIntVal dflags i = Lit (mkMachInt dflags i)
mkWordVal :: DynFlags -> Integer -> Expr CoreBndr
mkWordVal dflags w = Lit (mkMachWord dflags w)
mkFloatVal :: Rational -> Expr CoreBndr
mkFloatVal f = Lit (convFloating (MachFloat f))
mkDoubleVal :: Rational -> Expr CoreBndr
mkDoubleVal d = Lit (convFloating (MachDouble d))
mkFloatVal :: DynFlags -> Rational -> Expr CoreBndr
mkFloatVal dflags f = Lit (convFloating dflags (MachFloat f))
mkDoubleVal :: DynFlags -> Rational -> Expr CoreBndr
mkDoubleVal dflags d = Lit (convFloating dflags (MachDouble d))
matchPrimOpId :: PrimOp -> Id -> RuleM ()
matchPrimOpId op id = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment