ghc/compiler/basicTypes/BasicTypes.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
   3 %
   4 \section[BasicTypes]{Miscellanous types}
   5
   6 This module defines a miscellaneously collection of very simple
   7 types that
   8
   9 \begin{itemize}
  10 \item have no other obvious home
  11 \item don't depend on any other complicated types
  12 \item are used in more than one "part" of the compiler
  13 \end{itemize}
  14
  15 \begin{code}
  16 module BasicTypes(
  17         Version, bumpVersion, initialVersion, bogusVersion,
  18
  19         Arity,
  20
  21         Unused, unused,
  22
  23         Fixity(..), FixityDirection(..),
  24         defaultFixity, maxPrecedence, negateFixity, negatePrecedence,
  25
  26         NewOrData(..),
  27
  28         RecFlag(..), isRec, isNonRec,
  29
  30         TopLevelFlag(..), isTopLevel, isNotTopLevel,
  31
  32         Boxity(..), isBoxed, tupleParens,
  33
  34         OccInfo(..), seqOccInfo, isFragileOcc, isDeadOcc, isLoopBreaker,
  35
  36         InsideLam, insideLam, notInsideLam,
  37         OneBranch, oneBranch, notOneBranch,
  38
  39         EP(..),
  40
  41         StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
  42
  43         CompilerPhase, pprPhase,
  44         Activation(..), isActive, isNeverActive, isAlwaysActive
  45    ) where
  46
  47 #include "HsVersions.h"
  48
  49 import Outputable
  50 \end{code}
  51
  52 %************************************************************************
  53 %*                                                                      *
  54 \subsection[Unused]{Unused}
  55 %*                                                                      *
  56 %************************************************************************
  57
  58 Used as a placeholder in types.
  59
  60 \begin{code}
  61 type Unused = ()
  62
  63 unused :: Unused
  64 unused = error "Unused is used!"
  65 \end{code}
  66
  67
  68 %************************************************************************
  69 %*                                                                      *
  70 \subsection[Arity]{Arity}
  71 %*                                                                      *
  72 %************************************************************************
  73
  74 \begin{code}
  75 type Arity = Int
  76 \end{code}
  77
  78
  79 %************************************************************************
  80 %*                                                                      *
  81 \subsection[Version]{Module and identifier version numbers}
  82 %*                                                                      *
  83 %************************************************************************
  84
  85 \begin{code}
  86 type Version = Int
  87
  88 bogusVersion :: Version -- Shouldn't look at these
  89 bogusVersion = error "bogusVersion"
  90
  91 bumpVersion :: Bool -> Version -> Version
  92 -- Bump if the predicate (typically equality between old and new) is false
  93 bumpVersion False v = v+1
  94 bumpVersion True  v = v
  95
  96 initialVersion :: Version
  97 initialVersion = 1
  98 \end{code}
  99
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 \subsection[Fixity]{Fixity info}
 104 %*                                                                      *
 105 %************************************************************************
 106
 107 \begin{code}
 108 data Fixity = Fixity Int FixityDirection
 109 data FixityDirection = InfixL | InfixR | InfixN
 110                      deriving(Eq)
 111
 112 instance Outputable Fixity where
 113     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
 114
 115 instance Outputable FixityDirection where
 116     ppr InfixL = ptext SLIT("infixl")
 117     ppr InfixR = ptext SLIT("infixr")
 118     ppr InfixN = ptext SLIT("infix")
 119
 120 instance Eq Fixity where                -- Used to determine if two fixities conflict
 121   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
 122
 123 maxPrecedence = (9::Int)
 124 defaultFixity = Fixity maxPrecedence InfixL
 125
 126 negateFixity :: Fixity
 127 negateFixity     = Fixity negatePrecedence InfixL       -- Precedence of unary negate is wired in as infixl 6!
 128
 129 negatePrecedence :: Int
 130 negatePrecedence = 6
 131 \end{code}
 132
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsection[NewType/DataType]{NewType/DataType flag}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 \begin{code}
 141 data NewOrData
 142   = NewType     -- "newtype Blah ..."
 143   | DataType    -- "data Blah ..."
 144   deriving( Eq )        -- Needed because Demand derives Eq
 145 \end{code}
 146
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsection[Top-level/local]{Top-level/not-top level flag}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 \begin{code}
 155 data TopLevelFlag
 156   = TopLevel
 157   | NotTopLevel
 158
 159 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
 160
 161 isNotTopLevel NotTopLevel = True
 162 isNotTopLevel TopLevel    = False
 163
 164 isTopLevel TopLevel     = True
 165 isTopLevel NotTopLevel  = False
 166 \end{code}
 167
 168 %************************************************************************
 169 %*                                                                      *
 170 \subsection[Top-level/local]{Top-level/not-top level flag}
 171 %*                                                                      *
 172 %************************************************************************
 173
 174 \begin{code}
 175 data Boxity
 176   = Boxed
 177   | Unboxed
 178   deriving( Eq )
 179
 180 isBoxed :: Boxity -> Bool
 181 isBoxed Boxed   = True
 182 isBoxed Unboxed = False
 183
 184 tupleParens :: Boxity -> SDoc -> SDoc
 185 tupleParens Boxed   p = parens p
 186 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
 187 \end{code}
 188
 189
 190 %************************************************************************
 191 %*                                                                      *
 192 \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
 193 %*                                                                      *
 194 %************************************************************************
 195
 196 \begin{code}
 197 data RecFlag = Recursive
 198              | NonRecursive
 199
 200 isRec :: RecFlag -> Bool
 201 isRec Recursive    = True
 202 isRec NonRecursive = False
 203
 204 isNonRec :: RecFlag -> Bool
 205 isNonRec Recursive    = False
 206 isNonRec NonRecursive = True
 207 \end{code}
 208
 209 %************************************************************************
 210 %*                                                                      *
 211 \subsection[Generic]{Generic flag}
 212 %*                                                                      *
 213 %************************************************************************
 214
 215 This is the "Embedding-Projection pair" datatype, it contains
 216 two pieces of code (normally either RenamedHsExpr's or Id's)
 217 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
 218 represents functions of type
 219
 220         from :: T -> Tring
 221         to   :: Tring -> T
 222
 223 And we should have
 224
 225         to (from x) = x
 226
 227 T and Tring are arbitrary, but typically T is the 'main' type while
 228 Tring is the 'representation' type.  (This just helps us remember
 229 whether to use 'from' or 'to'.
 230
 231 \begin{code}
 232 data EP a = EP { fromEP :: a,   -- :: T -> Tring
 233                  toEP   :: a }  -- :: Tring -> T
 234 \end{code}
 235
 236 Embedding-projection pairs are used in several places:
 237
 238 First of all, each type constructor has an EP associated with it, the
 239 code in EP converts (datatype T) from T to Tring and back again.
 240
 241 Secondly, when we are filling in Generic methods (in the typechecker,
 242 tcMethodBinds), we are constructing bimaps by induction on the structure
 243 of the type of the method signature.
 244
 245
 246 %************************************************************************
 247 %*                                                                      *
 248 \subsection{Occurrence information}
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 This data type is used exclusively by the simplifier, but it appears in a
 253 SubstResult, which is currently defined in VarEnv, which is pretty near
 254 the base of the module hierarchy.  So it seemed simpler to put the
 255 defn of OccInfo here, safely at the bottom
 256
 257 \begin{code}
 258 data OccInfo
 259   = NoOccInfo
 260
 261   | IAmDead             -- Marks unused variables.  Sometimes useful for
 262                         -- lambda and case-bound variables.
 263
 264   | OneOcc InsideLam
 265
 266            OneBranch
 267
 268   | IAmALoopBreaker     -- Used by the occurrence analyser to mark loop-breakers
 269                         -- in a group of recursive definitions
 270
 271 seqOccInfo :: OccInfo -> ()
 272 seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` ()
 273 seqOccInfo occ                  = ()
 274
 275 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
 276                         -- Substituting a redex for this occurrence is
 277                         -- dangerous because it might duplicate work.
 278 insideLam    = True
 279 notInsideLam = False
 280
 281 type OneBranch = Bool   -- True <=> Occurs in only one case branch
 282                         --      so no code-duplication issue to worry about
 283 oneBranch    = True
 284 notOneBranch = False
 285
 286 isLoopBreaker :: OccInfo -> Bool
 287 isLoopBreaker IAmALoopBreaker = True
 288 isLoopBreaker other           = False
 289
 290 isDeadOcc :: OccInfo -> Bool
 291 isDeadOcc IAmDead = True
 292 isDeadOcc other   = False
 293
 294 isFragileOcc :: OccInfo -> Bool
 295 isFragileOcc (OneOcc _ _) = True
 296 isFragileOcc other        = False
 297 \end{code}
 298
 299 \begin{code}
 300 instance Outputable OccInfo where
 301   -- only used for debugging; never parsed.  KSW 1999-07
 302   ppr NoOccInfo                                   = empty
 303   ppr IAmALoopBreaker                             = ptext SLIT("_Kx")
 304   ppr IAmDead                                     = ptext SLIT("_Kd")
 305   ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
 306                                      | one_branch = ptext SLIT("_Ks")
 307                                      | otherwise  = ptext SLIT("_Ks*")
 308
 309 instance Show OccInfo where
 310   showsPrec p occ = showsPrecSDoc p (ppr occ)
 311 \end{code}
 312
 313 %************************************************************************
 314 %*                                                                      *
 315 \subsection{Strictness indication}
 316 %*                                                                      *
 317 %************************************************************************
 318
 319 The strictness annotations on types in data type declarations
 320 e.g.    data T = MkT !Int !(Bool,Bool)
 321
 322 \begin{code}
 323 data StrictnessMark
 324    = MarkedUserStrict   -- "!"  in a source decl
 325    | MarkedStrict       -- "!"  in an interface decl: strict but not unboxed
 326    | MarkedUnboxed      -- "!!" in an interface decl: unboxed
 327    | NotMarkedStrict    -- No annotation at all
 328    deriving( Eq )
 329
 330 isMarkedUnboxed MarkedUnboxed = True
 331 isMarkedUnboxed other         = False
 332
 333 isMarkedStrict NotMarkedStrict = False
 334 isMarkedStrict other           = True   -- All others are strict
 335
 336 instance Outputable StrictnessMark where
 337   ppr MarkedUserStrict = ptext SLIT("!u")
 338   ppr MarkedStrict     = ptext SLIT("!")
 339   ppr MarkedUnboxed    = ptext SLIT("! !")
 340   ppr NotMarkedStrict  = empty
 341 \end{code}
 342
 343
 344 %************************************************************************
 345 %*                                                                      *
 346 \subsection{Activation}
 347 %*                                                                      *
 348 %************************************************************************
 349
 350 When a rule or inlining is active
 351
 352 \begin{code}
 353 type CompilerPhase = Int        -- Compilation phase
 354                                 -- Phases decrease towards zero
 355                                 -- Zero is the last phase
 356
 357 pprPhase :: CompilerPhase -> SDoc
 358 pprPhase n = brackets (int n)
 359
 360 data Activation = NeverActive
 361                 | AlwaysActive
 362                 | ActiveAfter CompilerPhase     -- Active in this phase and later
 363                 deriving( Eq )                  -- Eq used in comparing rules in HsDecls
 364
 365 instance Outputable Activation where
 366    ppr AlwaysActive    = empty          -- The default
 367    ppr (ActiveAfter n) = pprPhase n
 368    ppr NeverActive     = ptext SLIT("NEVER")
 369
 370 isActive :: CompilerPhase -> Activation -> Bool
 371 isActive p NeverActive     = False
 372 isActive p AlwaysActive    = True
 373 isActive p (ActiveAfter n) = p <= n
 374
 375 isNeverActive, isAlwaysActive :: Activation -> Bool
 376 isNeverActive NeverActive = True
 377 isNeverActive act         = False
 378
 379 isAlwaysActive AlwaysActive = True
 380 isAlwaysActive other        = False
 381 \end{code}