Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/70c641642d3c3d55e4f8f76b49e3f82fb9f81a20 >--------------------------------------------------------------- commit 70c641642d3c3d55e4f8f76b49e3f82fb9f81a20 Author: Ian Lynagh <[email protected]> Date: Tue Oct 9 23:41:44 2012 +0100 Make -fexcess-precision a fully-dynamic flag It used to be part-dynamic, part-static. >--------------------------------------------------------------- compiler/main/StaticFlagParser.hs | 13 ++----------- compiler/main/StaticFlags.hs | 5 ----- compiler/prelude/PrelRules.lhs | 33 ++++++++++++++++----------------- 3 files changed, 18 insertions(+), 33 deletions(-) diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs index 8397cce..e2414f7 100644 --- a/compiler/main/StaticFlagParser.hs +++ b/compiler/main/StaticFlagParser.hs @@ -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" ] diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 69de53e..49f0ff7 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -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") diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index aa4156b..d1a2efd 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
