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
18 Version, bumpVersion, initialVersion,
24 Fixity(..), FixityDirection(..),
25 defaultFixity, maxPrecedence,
26 negateFixity, funTyFixity,
29 IPName(..), ipNameName, mapIPName,
31 RecFlag(..), isRec, isNonRec, boolToRecFlag,
35 TopLevelFlag(..), isTopLevel, isNotTopLevel,
41 TupCon(..), tupleParens,
43 OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
44 isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
46 InsideLam, insideLam, notInsideLam,
47 OneBranch, oneBranch, notOneBranch,
52 StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
55 Activation(..), isActive, isNeverActive, isAlwaysActive,
56 InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
58 SuccessFlag(..), succeeded, failed, successIf
65 %************************************************************************
67 \subsection[Arity]{Arity}
69 %************************************************************************
76 %************************************************************************
78 \subsection[Version]{Module and identifier version numbers}
80 %************************************************************************
85 bumpVersion :: Version -> Version
88 initialVersion :: Version
92 %************************************************************************
96 %************************************************************************
100 -- reason/explanation from a WARNING or DEPRECATED pragma
101 data WarningTxt = WarningTxt FastString
102 | DeprecatedTxt FastString
105 instance Outputable WarningTxt where
106 ppr (WarningTxt w) = doubleQuotes (ftext w)
107 ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d)
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
134 %************************************************************************
138 %************************************************************************
141 type RuleName = FastString
144 %************************************************************************
146 \subsection[Fixity]{Fixity info}
148 %************************************************************************
151 ------------------------
152 data Fixity = Fixity Int FixityDirection
154 instance Outputable Fixity where
155 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
157 instance Eq Fixity where -- Used to determine if two fixities conflict
158 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
160 ------------------------
161 data FixityDirection = InfixL | InfixR | InfixN
164 instance Outputable FixityDirection where
165 ppr InfixL = ptext (sLit "infixl")
166 ppr InfixR = ptext (sLit "infixr")
167 ppr InfixN = ptext (sLit "infix")
169 ------------------------
172 defaultFixity :: Fixity
173 defaultFixity = Fixity maxPrecedence InfixL
175 negateFixity, funTyFixity :: Fixity
177 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
178 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
186 @(compareFixity op1 op2)@ tells which way to arrange appication, or
187 whether there's an error.
190 compareFixity :: Fixity -> Fixity
191 -> (Bool, -- Error please
192 Bool) -- Associate to the right: a op1 (b op2 c)
193 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
194 = case prec1 `compare` prec2 of
197 EQ -> case (dir1, dir2) of
198 (InfixR, InfixR) -> right
199 (InfixL, InfixL) -> left
202 right = (False, True)
203 left = (False, False)
204 error_please = (True, False)
208 %************************************************************************
210 \subsection[Top-level/local]{Top-level/not-top level flag}
212 %************************************************************************
219 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
221 isNotTopLevel NotTopLevel = True
222 isNotTopLevel TopLevel = False
224 isTopLevel TopLevel = True
225 isTopLevel NotTopLevel = False
227 instance Outputable TopLevelFlag where
228 ppr TopLevel = ptext (sLit "<TopLevel>")
229 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
233 %************************************************************************
235 Top-level/not-top level flag
237 %************************************************************************
245 isBoxed :: Boxity -> Bool
247 isBoxed Unboxed = False
251 %************************************************************************
253 Recursive/Non-Recursive flag
255 %************************************************************************
258 data RecFlag = Recursive
262 isRec :: RecFlag -> Bool
263 isRec Recursive = True
264 isRec NonRecursive = False
266 isNonRec :: RecFlag -> Bool
267 isNonRec Recursive = False
268 isNonRec NonRecursive = True
270 boolToRecFlag :: Bool -> RecFlag
271 boolToRecFlag True = Recursive
272 boolToRecFlag False = NonRecursive
274 instance Outputable RecFlag where
275 ppr Recursive = ptext (sLit "Recursive")
276 ppr NonRecursive = ptext (sLit "NonRecursive")
279 %************************************************************************
281 Instance overlap flag
283 %************************************************************************
287 = NoOverlap -- This instance must not overlap another
289 | OverlapOk -- Silently ignore this instance if you find a
290 -- more specific one that matches the constraint
291 -- you are trying to resolve
293 -- Example: constraint (Foo [Int])
294 -- instances (Foo [Int])
295 -- (Foo [a]) OverlapOk
296 -- Since the second instance has the OverlapOk flag,
297 -- the first instance will be chosen (otherwise
298 -- its ambiguous which to choose)
300 | Incoherent -- Like OverlapOk, but also ignore this instance
301 -- if it doesn't match the constraint you are
302 -- trying to resolve, but could match if the type variables
303 -- in the constraint were instantiated
305 -- Example: constraint (Foo [b])
306 -- instances (Foo [Int]) Incoherent
308 -- Without the Incoherent flag, we'd complain that
309 -- instantiating 'b' would change which instance
313 instance Outputable OverlapFlag where
314 ppr NoOverlap = empty
315 ppr OverlapOk = ptext (sLit "[overlap ok]")
316 ppr Incoherent = ptext (sLit "[incoherent]")
320 %************************************************************************
324 %************************************************************************
327 data TupCon = TupCon Boxity Arity
329 instance Eq TupCon where
330 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
332 tupleParens :: Boxity -> SDoc -> SDoc
333 tupleParens Boxed p = parens p
334 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
337 %************************************************************************
339 \subsection[Generic]{Generic flag}
341 %************************************************************************
343 This is the "Embedding-Projection pair" datatype, it contains
344 two pieces of code (normally either RenamedExpr's or Id's)
345 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
346 represents functions of type
355 T and Tring are arbitrary, but typically T is the 'main' type while
356 Tring is the 'representation' type. (This just helps us remember
357 whether to use 'from' or 'to'.
360 data EP a = EP { fromEP :: a, -- :: T -> Tring
361 toEP :: a } -- :: Tring -> T
364 Embedding-projection pairs are used in several places:
366 First of all, each type constructor has an EP associated with it, the
367 code in EP converts (datatype T) from T to Tring and back again.
369 Secondly, when we are filling in Generic methods (in the typechecker,
370 tcMethodBinds), we are constructing bimaps by induction on the structure
371 of the type of the method signature.
374 %************************************************************************
376 \subsection{Occurrence information}
378 %************************************************************************
380 This data type is used exclusively by the simplifier, but it appears in a
381 SubstResult, which is currently defined in VarEnv, which is pretty near
382 the base of the module hierarchy. So it seemed simpler to put the
383 defn of OccInfo here, safely at the bottom
386 -- | Identifier occurrence information
388 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
390 | IAmDead -- ^ Marks unused variables. Sometimes useful for
391 -- lambda and case-bound variables.
396 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
398 -- | This identifier breaks a loop of mutually recursive functions. The field
399 -- marks whether it is only a loop breaker due to a reference in a rule
400 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
401 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
402 -- See OccurAnal Note [Weak loop breakers]
404 type RulesOnly = Bool
407 Note [LoopBreaker OccInfo]
408 ~~~~~~~~~~~~~~~~~~~~~~~~~~
409 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
410 analyser in two ways:
411 (a) to mark loop-breakers in a group of recursive
412 definitions (hence the name)
413 (b) to mark binders that must not be inlined in this phase
414 (perhaps it has a NOINLINE pragma)
415 Things with (IAmLoopBreaker False) do not get an unfolding
416 pinned on to them, so they are completely opaque.
418 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
422 isNoOcc :: OccInfo -> Bool
423 isNoOcc NoOccInfo = True
426 seqOccInfo :: OccInfo -> ()
427 seqOccInfo occ = occ `seq` ()
430 type InterestingCxt = Bool -- True <=> Function: is applied
431 -- Data value: scrutinised by a case with
432 -- at least one non-DEFAULT branch
435 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
436 -- Substituting a redex for this occurrence is
437 -- dangerous because it might duplicate work.
438 insideLam, notInsideLam :: InsideLam
443 type OneBranch = Bool -- True <=> Occurs in only one case branch
444 -- so no code-duplication issue to worry about
445 oneBranch, notOneBranch :: OneBranch
449 isLoopBreaker :: OccInfo -> Bool
450 isLoopBreaker (IAmALoopBreaker _) = True
451 isLoopBreaker _ = False
453 isNonRuleLoopBreaker :: OccInfo -> Bool
454 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
455 isNonRuleLoopBreaker _ = False
457 isDeadOcc :: OccInfo -> Bool
458 isDeadOcc IAmDead = True
461 isOneOcc :: OccInfo -> Bool
462 isOneOcc (OneOcc _ _ _) = True
465 isFragileOcc :: OccInfo -> Bool
466 isFragileOcc (OneOcc _ _ _) = True
467 isFragileOcc _ = False
471 instance Outputable OccInfo where
472 -- only used for debugging; never parsed. KSW 1999-07
473 ppr NoOccInfo = empty
474 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
475 ppr IAmDead = ptext (sLit "Dead")
476 ppr (OneOcc inside_lam one_branch int_cxt)
477 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
479 pp_lam | inside_lam = char 'L'
481 pp_br | one_branch = empty
482 | otherwise = char '*'
483 pp_args | int_cxt = char '!'
486 instance Show OccInfo where
487 showsPrec p occ = showsPrecSDoc p (ppr occ)
490 %************************************************************************
492 \subsection{Strictness indication}
494 %************************************************************************
496 The strictness annotations on types in data type declarations
497 e.g. data T = MkT !Int !(Bool,Bool)
500 data StrictnessMark -- Used in interface decls only
506 isMarkedUnboxed :: StrictnessMark -> Bool
507 isMarkedUnboxed MarkedUnboxed = True
508 isMarkedUnboxed _ = False
510 isMarkedStrict :: StrictnessMark -> Bool
511 isMarkedStrict NotMarkedStrict = False
512 isMarkedStrict _ = True -- All others are strict
514 instance Outputable StrictnessMark where
515 ppr MarkedStrict = ptext (sLit "!")
516 ppr MarkedUnboxed = ptext (sLit "!!")
517 ppr NotMarkedStrict = ptext (sLit "_")
521 %************************************************************************
523 \subsection{Success flag}
525 %************************************************************************
528 data SuccessFlag = Succeeded | Failed
530 instance Outputable SuccessFlag where
531 ppr Succeeded = ptext (sLit "Succeeded")
532 ppr Failed = ptext (sLit "Failed")
534 successIf :: Bool -> SuccessFlag
535 successIf True = Succeeded
536 successIf False = Failed
538 succeeded, failed :: SuccessFlag -> Bool
539 succeeded Succeeded = True
540 succeeded Failed = False
542 failed Succeeded = False
547 %************************************************************************
549 \subsection{Activation}
551 %************************************************************************
553 When a rule or inlining is active
556 type CompilerPhase = Int -- Compilation phase
557 -- Phases decrease towards zero
558 -- Zero is the last phase
560 data Activation = NeverActive
562 | ActiveBefore CompilerPhase -- Active only *before* this phase
563 | ActiveAfter CompilerPhase -- Active in this phase and later
564 deriving( Eq ) -- Eq used in comparing rules in HsDecls
568 Activation -- Says during which phases inlining is allowed
569 Bool -- True <=> make the RHS look small, so that when inlining
570 -- is enabled, it will definitely actually happen
573 defaultInlineSpec, alwaysInlineSpec, neverInlineSpec :: InlineSpec
575 defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
576 alwaysInlineSpec = Inline AlwaysActive True -- INLINE always
577 neverInlineSpec = Inline NeverActive False -- NOINLINE
579 instance Outputable Activation where
580 ppr NeverActive = ptext (sLit "NEVER")
581 ppr AlwaysActive = ptext (sLit "ALWAYS")
582 ppr (ActiveBefore n) = brackets (char '~' <> int n)
583 ppr (ActiveAfter n) = brackets (int n)
585 instance Outputable InlineSpec where
586 ppr (Inline act is_inline)
587 | is_inline = ptext (sLit "INLINE")
589 AlwaysActive -> empty
591 | otherwise = ptext (sLit "NOINLINE")
596 isActive :: CompilerPhase -> Activation -> Bool
597 isActive _ NeverActive = False
598 isActive _ AlwaysActive = True
599 isActive p (ActiveAfter n) = p <= n
600 isActive p (ActiveBefore n) = p > n
602 isNeverActive, isAlwaysActive :: Activation -> Bool
603 isNeverActive NeverActive = True
604 isNeverActive _ = False
606 isAlwaysActive AlwaysActive = True
607 isAlwaysActive _ = False