X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=65002d57ced5bf2fb0d6ffab55b38b0eb7951c90;hp=499d7beab472f95f67b531767fc5d730ae4cbd61;hb=6ddfe9b18d4d280676aab2fa797ddbe6f8a09d6b;hpb=f95a95425727fd0086df26f7d47f79c911e04b34

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 499d7be..65002d5 100644
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -59,8 +59,9 @@ module BasicTypes(
 
 	DefMethSpec(..),
 
-	CompilerPhase, 
-	Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
+        CompilerPhase(..), PhaseNum,
+        Activation(..), isActive, isActiveIn,
+        isNeverActive, isAlwaysActive, isEarlyActive,
         RuleMatchInfo(..), isConLike, isFunLike, 
         InlineSpec(..), 
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, 
@@ -71,13 +72,16 @@ module BasicTypes(
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
 
-	SuccessFlag(..), succeeded, failed, successIf
+	SuccessFlag(..), succeeded, failed, successIf,
+	
+	FractionalLit(..), negateFractionalLit, integralFractionalLit
    ) where
 
 import FastString
 import Outputable
 
 import Data.Data hiding (Fixity)
+import Data.Function (on)
 \end{code}
 
 %************************************************************************
@@ -637,14 +641,22 @@ failed Failed    = True
 When a rule or inlining is active
 
 \begin{code}
-type CompilerPhase = Int	-- Compilation phase
-				-- Phases decrease towards zero
-				-- Zero is the last phase
+type PhaseNum = Int  -- Compilation phase
+                     -- Phases decrease towards zero
+                     -- Zero is the last phase
+
+data CompilerPhase
+  = Phase PhaseNum
+  | InitialPhase    -- The first phase -- number = infinity!
+
+instance Outputable CompilerPhase where
+   ppr (Phase n)    = int n
+   ppr InitialPhase = ptext (sLit "InitialPhase")
 
 data Activation = NeverActive
 		| AlwaysActive
-		| ActiveBefore CompilerPhase	-- Active only *before* this phase
-		| ActiveAfter CompilerPhase	-- Active in this phase and later
+                | ActiveBefore PhaseNum -- Active only *before* this phase
+                | ActiveAfter PhaseNum  -- Active in this phase and later
 		deriving( Eq, Data, Typeable )	-- Eq used in comparing rules in HsDecls
 
 data RuleMatchInfo = ConLike 			-- See Note [CONLIKE pragma]
@@ -830,10 +842,16 @@ instance Outputable InlinePragma where
               | otherwise      = ppr info
 
 isActive :: CompilerPhase -> Activation -> Bool
-isActive _ NeverActive      = False
-isActive _ AlwaysActive     = True
-isActive p (ActiveAfter n)  = p <= n
-isActive p (ActiveBefore n) = p >  n
+isActive InitialPhase AlwaysActive      = True
+isActive InitialPhase (ActiveBefore {}) = True
+isActive InitialPhase _                 = False
+isActive (Phase p)    act               = isActiveIn p act
+
+isActiveIn :: PhaseNum -> Activation -> Bool
+isActiveIn _ NeverActive      = False
+isActiveIn _ AlwaysActive     = True
+isActiveIn p (ActiveAfter n)  = p <= n
+isActiveIn p (ActiveBefore n) = p >  n
 
 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
 isNeverActive NeverActive = True
@@ -847,3 +865,35 @@ isEarlyActive (ActiveBefore {}) = True
 isEarlyActive _		        = False
 \end{code}
 
+
+
+\begin{code}
+-- Used (instead of Rational) to represent exactly the floating point literal that we
+-- encountered in the user's source program. This allows us to pretty-print exactly what
+-- the user wrote, which is important e.g. for floating point numbers that can't represented
+-- as Doubles (we used to via Double for pretty-printing). See also #2245.
+data FractionalLit
+  = FL { fl_text :: String         -- How the value was written in the source
+       , fl_value :: Rational      -- Numeric value of the literal
+       }
+  deriving (Data, Typeable)
+
+negateFractionalLit :: FractionalLit -> FractionalLit
+negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value }
+negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value }
+
+integralFractionalLit :: Integer -> FractionalLit
+integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
+
+-- Comparison operations are needed when grouping literals
+-- for compiling pattern-matching (module MatchLit)
+
+instance Eq FractionalLit where
+  (==) = (==) `on` fl_value
+
+instance Ord FractionalLit where
+  compare = compare `on` fl_value
+
+instance Outputable FractionalLit where
+  ppr = text . fl_text
+\end{code}