Use FractionalLit more extensively to improve other pretty printers

[ghc-hetmet.git] / compiler / basicTypes / BasicTypes.lhs

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index 499d7be..65002d5 100644 (file)
--- 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}