2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
5 \section[BasicTypes]{Miscellanous types}
7 This module defines a miscellaneously collection of very simple
11 \item have no other obvious home
12 \item don't depend on any other complicated types
13 \item are used in more than one "part" of the compiler
17 {-# OPTIONS_GHC -w #-}
18 -- The above warning supression flag is a temporary kludge.
19 -- While working on this module you are encouraged to remove it and fix
20 -- any warnings in the module. See
21 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
25 Version, bumpVersion, initialVersion,
31 Fixity(..), FixityDirection(..),
32 defaultFixity, maxPrecedence,
33 negateFixity, funTyFixity,
36 IPName(..), ipNameName, mapIPName,
38 RecFlag(..), isRec, isNonRec, boolToRecFlag,
40 TopLevelFlag(..), isTopLevel, isNotTopLevel,
46 TupCon(..), tupleParens,
48 OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
49 isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
51 InsideLam, insideLam, notInsideLam,
52 OneBranch, oneBranch, notOneBranch,
57 StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
60 Activation(..), isActive, isNeverActive, isAlwaysActive,
61 InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
63 SuccessFlag(..), succeeded, failed, successIf
66 #include "HsVersions.h"
68 import FastString( FastString )
72 %************************************************************************
74 \subsection[Arity]{Arity}
76 %************************************************************************
83 %************************************************************************
85 \subsection[Version]{Module and identifier version numbers}
87 %************************************************************************
92 bumpVersion :: Version -> Version
95 initialVersion :: Version
99 %************************************************************************
103 %************************************************************************
107 type DeprecTxt = FastString -- reason/explanation for deprecation
110 %************************************************************************
112 \subsection{Implicit parameter identity}
114 %************************************************************************
116 The @IPName@ type is here because it is used in TypeRep (i.e. very
117 early in the hierarchy), but also in HsSyn.
120 newtype IPName name = IPName name -- ?x
121 deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map
122 -- (used in HscTypes.OrigIParamCache)
124 ipNameName :: IPName name -> name
125 ipNameName (IPName n) = n
127 mapIPName :: (a->b) -> IPName a -> IPName b
128 mapIPName f (IPName n) = IPName (f n)
130 instance Outputable name => Outputable (IPName name) where
131 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
135 %************************************************************************
137 \subsection[Fixity]{Fixity info}
139 %************************************************************************
142 ------------------------
143 data Fixity = Fixity Int FixityDirection
145 instance Outputable Fixity where
146 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
148 instance Eq Fixity where -- Used to determine if two fixities conflict
149 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
151 ------------------------
152 data FixityDirection = InfixL | InfixR | InfixN
155 instance Outputable FixityDirection where
156 ppr InfixL = ptext SLIT("infixl")
157 ppr InfixR = ptext SLIT("infixr")
158 ppr InfixN = ptext SLIT("infix")
160 ------------------------
161 maxPrecedence = (9::Int)
162 defaultFixity = Fixity maxPrecedence InfixL
164 negateFixity, funTyFixity :: Fixity
166 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
167 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
175 @(compareFixity op1 op2)@ tells which way to arrange appication, or
176 whether there's an error.
179 compareFixity :: Fixity -> Fixity
180 -> (Bool, -- Error please
181 Bool) -- Associate to the right: a op1 (b op2 c)
182 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
183 = case prec1 `compare` prec2 of
186 EQ -> case (dir1, dir2) of
187 (InfixR, InfixR) -> right
188 (InfixL, InfixL) -> left
191 right = (False, True)
192 left = (False, False)
193 error_please = (True, False)
197 %************************************************************************
199 \subsection[Top-level/local]{Top-level/not-top level flag}
201 %************************************************************************
208 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
210 isNotTopLevel NotTopLevel = True
211 isNotTopLevel TopLevel = False
213 isTopLevel TopLevel = True
214 isTopLevel NotTopLevel = False
216 instance Outputable TopLevelFlag where
217 ppr TopLevel = ptext SLIT("<TopLevel>")
218 ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
222 %************************************************************************
224 Top-level/not-top level flag
226 %************************************************************************
234 isBoxed :: Boxity -> Bool
236 isBoxed Unboxed = False
240 %************************************************************************
242 Recursive/Non-Recursive flag
244 %************************************************************************
247 data RecFlag = Recursive
251 isRec :: RecFlag -> Bool
252 isRec Recursive = True
253 isRec NonRecursive = False
255 isNonRec :: RecFlag -> Bool
256 isNonRec Recursive = False
257 isNonRec NonRecursive = True
259 boolToRecFlag :: Bool -> RecFlag
260 boolToRecFlag True = Recursive
261 boolToRecFlag False = NonRecursive
263 instance Outputable RecFlag where
264 ppr Recursive = ptext SLIT("Recursive")
265 ppr NonRecursive = ptext SLIT("NonRecursive")
268 %************************************************************************
270 Instance overlap flag
272 %************************************************************************
276 = NoOverlap -- This instance must not overlap another
278 | OverlapOk -- Silently ignore this instance if you find a
279 -- more specific one that matches the constraint
280 -- you are trying to resolve
282 -- Example: constraint (Foo [Int])
283 -- instances (Foo [Int])
284 -- (Foo [a]) OverlapOk
285 -- Since the second instance has the OverlapOk flag,
286 -- the first instance will be chosen (otherwise
287 -- its ambiguous which to choose)
289 | Incoherent -- Like OverlapOk, but also ignore this instance
290 -- if it doesn't match the constraint you are
291 -- trying to resolve, but could match if the type variables
292 -- in the constraint were instantiated
294 -- Example: constraint (Foo [b])
295 -- instances (Foo [Int]) Incoherent
297 -- Without the Incoherent flag, we'd complain that
298 -- instantiating 'b' would change which instance
302 instance Outputable OverlapFlag where
303 ppr NoOverlap = empty
304 ppr OverlapOk = ptext SLIT("[overlap ok]")
305 ppr Incoherent = ptext SLIT("[incoherent]")
309 %************************************************************************
313 %************************************************************************
316 data TupCon = TupCon Boxity Arity
318 instance Eq TupCon where
319 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
321 tupleParens :: Boxity -> SDoc -> SDoc
322 tupleParens Boxed p = parens p
323 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
326 %************************************************************************
328 \subsection[Generic]{Generic flag}
330 %************************************************************************
332 This is the "Embedding-Projection pair" datatype, it contains
333 two pieces of code (normally either RenamedExpr's or Id's)
334 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
335 represents functions of type
344 T and Tring are arbitrary, but typically T is the 'main' type while
345 Tring is the 'representation' type. (This just helps us remember
346 whether to use 'from' or 'to'.
349 data EP a = EP { fromEP :: a, -- :: T -> Tring
350 toEP :: a } -- :: Tring -> T
353 Embedding-projection pairs are used in several places:
355 First of all, each type constructor has an EP associated with it, the
356 code in EP converts (datatype T) from T to Tring and back again.
358 Secondly, when we are filling in Generic methods (in the typechecker,
359 tcMethodBinds), we are constructing bimaps by induction on the structure
360 of the type of the method signature.
363 %************************************************************************
365 \subsection{Occurrence information}
367 %************************************************************************
369 This data type is used exclusively by the simplifier, but it appears in a
370 SubstResult, which is currently defined in VarEnv, which is pretty near
371 the base of the module hierarchy. So it seemed simpler to put the
372 defn of OccInfo here, safely at the bottom
376 = NoOccInfo -- Many occurrences, or unknown
378 | IAmDead -- Marks unused variables. Sometimes useful for
379 -- lambda and case-bound variables.
381 | OneOcc -- Occurs exactly once, not inside a rule
386 | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
387 -- in a group of recursive definitions
388 !RulesOnly -- True <=> This loop breaker mentions the other binders
389 -- in its recursive group only in its RULES, not
391 -- See OccurAnal Note [RulesOnly]
393 type RulesOnly = Bool
398 isNoOcc :: OccInfo -> Bool
399 isNoOcc NoOccInfo = True
400 isNoOcc other = False
402 seqOccInfo :: OccInfo -> ()
403 seqOccInfo occ = occ `seq` ()
406 type InterestingCxt = Bool -- True <=> Function: is applied
407 -- Data value: scrutinised by a case with
408 -- at least one non-DEFAULT branch
411 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
412 -- Substituting a redex for this occurrence is
413 -- dangerous because it might duplicate work.
418 type OneBranch = Bool -- True <=> Occurs in only one case branch
419 -- so no code-duplication issue to worry about
423 isLoopBreaker :: OccInfo -> Bool
424 isLoopBreaker (IAmALoopBreaker _) = True
425 isLoopBreaker other = False
427 isNonRuleLoopBreaker :: OccInfo -> Bool
428 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
429 isNonRuleLoopBreaker other = False
431 isDeadOcc :: OccInfo -> Bool
432 isDeadOcc IAmDead = True
433 isDeadOcc other = False
435 isOneOcc (OneOcc _ _ _) = True
436 isOneOcc other = False
438 isFragileOcc :: OccInfo -> Bool
439 isFragileOcc (OneOcc _ _ _) = True
440 isFragileOcc other = False
444 instance Outputable OccInfo where
445 -- only used for debugging; never parsed. KSW 1999-07
446 ppr NoOccInfo = empty
447 ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
448 ppr IAmDead = ptext SLIT("Dead")
449 ppr (OneOcc inside_lam one_branch int_cxt)
450 = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
452 pp_lam | inside_lam = char 'L'
454 pp_br | one_branch = empty
455 | otherwise = char '*'
456 pp_args | int_cxt = char '!'
459 instance Show OccInfo where
460 showsPrec p occ = showsPrecSDoc p (ppr occ)
463 %************************************************************************
465 \subsection{Strictness indication}
467 %************************************************************************
469 The strictness annotations on types in data type declarations
470 e.g. data T = MkT !Int !(Bool,Bool)
473 data StrictnessMark -- Used in interface decls only
479 isMarkedUnboxed MarkedUnboxed = True
480 isMarkedUnboxed other = False
482 isMarkedStrict NotMarkedStrict = False
483 isMarkedStrict other = True -- All others are strict
485 instance Outputable StrictnessMark where
486 ppr MarkedStrict = ptext SLIT("!")
487 ppr MarkedUnboxed = ptext SLIT("!!")
488 ppr NotMarkedStrict = ptext SLIT("_")
492 %************************************************************************
494 \subsection{Success flag}
496 %************************************************************************
499 data SuccessFlag = Succeeded | Failed
501 instance Outputable SuccessFlag where
502 ppr Succeeded = ptext SLIT("Succeeded")
503 ppr Failed = ptext SLIT("Failed")
505 successIf :: Bool -> SuccessFlag
506 successIf True = Succeeded
507 successIf False = Failed
509 succeeded, failed :: SuccessFlag -> Bool
510 succeeded Succeeded = True
511 succeeded Failed = False
513 failed Succeeded = False
518 %************************************************************************
520 \subsection{Activation}
522 %************************************************************************
524 When a rule or inlining is active
527 type CompilerPhase = Int -- Compilation phase
528 -- Phases decrease towards zero
529 -- Zero is the last phase
531 data Activation = NeverActive
533 | ActiveBefore CompilerPhase -- Active only *before* this phase
534 | ActiveAfter CompilerPhase -- Active in this phase and later
535 deriving( Eq ) -- Eq used in comparing rules in HsDecls
539 Activation -- Says during which phases inlining is allowed
540 Bool -- True <=> make the RHS look small, so that when inlining
541 -- is enabled, it will definitely actually happen
544 defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
545 alwaysInlineSpec = Inline AlwaysActive True -- INLINE always
546 neverInlineSpec = Inline NeverActive False -- NOINLINE
548 instance Outputable Activation where
549 ppr AlwaysActive = empty -- The default
550 ppr (ActiveBefore n) = brackets (char '~' <> int n)
551 ppr (ActiveAfter n) = brackets (int n)
552 ppr NeverActive = ptext SLIT("NEVER")
554 instance Outputable InlineSpec where
555 ppr (Inline act True) = ptext SLIT("INLINE") <> ppr act
556 ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
558 isActive :: CompilerPhase -> Activation -> Bool
559 isActive p NeverActive = False
560 isActive p AlwaysActive = True
561 isActive p (ActiveAfter n) = p <= n
562 isActive p (ActiveBefore n) = p > n
564 isNeverActive, isAlwaysActive :: Activation -> Bool
565 isNeverActive NeverActive = True
566 isNeverActive act = False
568 isAlwaysActive AlwaysActive = True
569 isAlwaysActive other = False