Split the Id related functions out from Var into Id, document Var and some of Id

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

diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs
index cdfc28c..8fcf5ca 100644 (file)
--- a/compiler/basicTypes/BasicTypes.lhs
+++ b/compiler/basicTypes/BasicTypes.lhs
@@ -19,7 +19,7 @@ module BasicTypes(
 
        Arity, 
        
-       DeprecTxt,
+       WarningTxt(..),
 
        Fixity(..), FixityDirection(..),
        defaultFixity, maxPrecedence, 
@@ -30,6 +30,8 @@ module BasicTypes(
 
        RecFlag(..), isRec, isNonRec, boolToRecFlag,
 
+       RuleName,
+
        TopLevelFlag(..), isTopLevel, isNotTopLevel,
 
        OverlapFlag(..), 
@@ -56,8 +58,6 @@ module BasicTypes(
        SuccessFlag(..), succeeded, failed, successIf
    ) where
 
-#include "HsVersions.h"
-
 import FastString
 import Outputable
 \end{code}
@@ -97,7 +97,14 @@ initialVersion = 1
 
 
 \begin{code}
-type DeprecTxt = FastString    -- reason/explanation for deprecation
+-- reason/explanation from a WARNING or DEPRECATED pragma
+data WarningTxt = WarningTxt FastString
+                | DeprecatedTxt FastString
+    deriving Eq
+
+instance Outputable WarningTxt where
+    ppr (WarningTxt    w) =                        doubleQuotes (ftext w)
+    ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)
 \end{code}
 
 %************************************************************************
@@ -124,6 +131,15 @@ instance Outputable name => Outputable (IPName name) where
     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+               Rules
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type RuleName = FastString
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -146,9 +162,9 @@ data FixityDirection = InfixL | InfixR | InfixN
                     deriving(Eq)
 
 instance Outputable FixityDirection where
-    ppr InfixL = ptext SLIT("infixl")
-    ppr InfixR = ptext SLIT("infixr")
-    ppr InfixN = ptext SLIT("infix")
+    ppr InfixL = ptext (sLit "infixl")
+    ppr InfixR = ptext (sLit "infixr")
+    ppr InfixN = ptext (sLit "infix")
 
 ------------------------
 maxPrecedence :: Int
@@ -209,8 +225,8 @@ isTopLevel TopLevel = True
 isTopLevel NotTopLevel  = False
 
 instance Outputable TopLevelFlag where
-  ppr TopLevel    = ptext SLIT("<TopLevel>")
-  ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
+  ppr TopLevel    = ptext (sLit "<TopLevel>")
+  ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
 \end{code}
 
 
@@ -256,8 +272,8 @@ boolToRecFlag True  = Recursive
 boolToRecFlag False = NonRecursive
 
 instance Outputable RecFlag where
-  ppr Recursive    = ptext SLIT("Recursive")
-  ppr NonRecursive = ptext SLIT("NonRecursive")
+  ppr Recursive    = ptext (sLit "Recursive")
+  ppr NonRecursive = ptext (sLit "NonRecursive")
 \end{code}
 
 %************************************************************************
@@ -296,8 +312,8 @@ data OverlapFlag
 
 instance Outputable OverlapFlag where
    ppr NoOverlap  = empty
-   ppr OverlapOk  = ptext SLIT("[overlap ok]")
-   ppr Incoherent = ptext SLIT("[incoherent]")
+   ppr OverlapOk  = ptext (sLit "[overlap ok]")
+   ppr Incoherent = ptext (sLit "[incoherent]")
 
 \end{code}
 
@@ -315,7 +331,7 @@ instance Eq TupCon where
    
 tupleParens :: Boxity -> SDoc -> SDoc
 tupleParens Boxed   p = parens p
-tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
+tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
 \end{code}
 
 %************************************************************************
@@ -367,17 +383,20 @@ the base of the module hierarchy.  So it seemed simpler to put the
 defn of OccInfo here, safely at the bottom
 
 \begin{code}
+-- | Identifier occurrence information
 data OccInfo 
-  = NoOccInfo          -- Many occurrences, or unknown
+  = NoOccInfo          -- ^ There are many occurrences, or unknown occurences
 
-  | IAmDead            -- Marks unused variables.  Sometimes useful for
+  | IAmDead            -- ^ Marks unused variables.  Sometimes useful for
                        -- lambda and case-bound variables.
 
-  | OneOcc             -- Occurs exactly once, not inside a rule
+  | OneOcc
        !InsideLam
        !OneBranch
-       !InterestingCxt
+       !InterestingCxt -- ^ Occurs exactly once, not inside a rule
 
+  -- | This identifier breaks a loop of mutually recursive functions. The field
+  -- marks whether it is only a loop breaker due to a reference in a rule
   | IAmALoopBreaker    -- Note [LoopBreaker OccInfo]
        !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
                        --          See OccurAnal Note [Weak loop breakers]
@@ -452,10 +471,10 @@ isFragileOcc _              = False
 instance Outputable OccInfo where
   -- only used for debugging; never parsed.  KSW 1999-07
   ppr NoOccInfo           = empty
-  ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
-  ppr IAmDead             = ptext SLIT("Dead")
+  ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
+  ppr IAmDead             = ptext (sLit "Dead")
   ppr (OneOcc inside_lam one_branch int_cxt)
-       = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
+       = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
        where
          pp_lam | inside_lam = char 'L'
                 | otherwise  = empty
@@ -493,9 +512,9 @@ isMarkedStrict NotMarkedStrict = False
 isMarkedStrict _               = True   -- All others are strict
 
 instance Outputable StrictnessMark where
-  ppr MarkedStrict     = ptext SLIT("!")
-  ppr MarkedUnboxed    = ptext SLIT("!!")
-  ppr NotMarkedStrict  = ptext SLIT("_")
+  ppr MarkedStrict     = ptext (sLit "!")
+  ppr MarkedUnboxed    = ptext (sLit "!!")
+  ppr NotMarkedStrict  = ptext (sLit "_")
 \end{code}
 
 
@@ -509,8 +528,8 @@ instance Outputable StrictnessMark where
 data SuccessFlag = Succeeded | Failed
 
 instance Outputable SuccessFlag where
-    ppr Succeeded = ptext SLIT("Succeeded")
-    ppr Failed    = ptext SLIT("Failed")
+    ppr Succeeded = ptext (sLit "Succeeded")
+    ppr Failed    = ptext (sLit "Failed")
 
 successIf :: Bool -> SuccessFlag
 successIf True  = Succeeded
@@ -558,18 +577,18 @@ alwaysInlineSpec  = Inline AlwaysActive True      -- INLINE always
 neverInlineSpec   = Inline NeverActive  False  -- NOINLINE 
 
 instance Outputable Activation where
-   ppr NeverActive      = ptext SLIT("NEVER")
-   ppr AlwaysActive     = ptext SLIT("ALWAYS")
+   ppr NeverActive      = ptext (sLit "NEVER")
+   ppr AlwaysActive     = ptext (sLit "ALWAYS")
    ppr (ActiveBefore n) = brackets (char '~' <> int n)
    ppr (ActiveAfter n)  = brackets (int n)
     
 instance Outputable InlineSpec where
    ppr (Inline act is_inline)  
-       | is_inline = ptext SLIT("INLINE")
+       | is_inline = ptext (sLit "INLINE")
                      <> case act of
                            AlwaysActive -> empty
                            _            -> ppr act
-       | otherwise = ptext SLIT("NOINLINE")
+       | otherwise = ptext (sLit "NOINLINE")
                      <> case act of
                            NeverActive  -> empty
                            _            -> ppr act