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 {-# LANGUAGE DeriveDataTypeable #-}
20 Version, bumpVersion, initialVersion,
28 Fixity(..), FixityDirection(..),
29 defaultFixity, maxPrecedence,
30 negateFixity, funTyFixity,
33 IPName(..), ipNameName, mapIPName,
35 RecFlag(..), isRec, isNonRec, boolToRecFlag,
39 TopLevelFlag(..), isTopLevel, isNotTopLevel,
45 TupCon(..), tupleParens,
47 OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
48 isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
51 InsideLam, insideLam, notInsideLam,
52 OneBranch, oneBranch, notOneBranch,
57 HsBang(..), isBanged, isMarkedUnboxed,
58 StrictnessMark(..), isMarkedStrict,
61 Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
62 RuleMatchInfo(..), isConLike, isFunLike,
63 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma,
64 isDefaultInlinePragma, isInlinePragma, inlinePragmaSat,
65 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
66 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
68 SuccessFlag(..), succeeded, failed, successIf
74 import Data.Data hiding (Fixity)
77 %************************************************************************
79 \subsection[Arity]{Arity}
81 %************************************************************************
87 %************************************************************************
89 \subsection[FunctionOrData]{FunctionOrData}
91 %************************************************************************
94 data FunctionOrData = IsFunction | IsData
95 deriving (Eq, Ord, Data, Typeable)
97 instance Outputable FunctionOrData where
98 ppr IsFunction = text "(function)"
99 ppr IsData = text "(data)"
103 %************************************************************************
105 \subsection[Version]{Module and identifier version numbers}
107 %************************************************************************
112 bumpVersion :: Version -> Version
115 initialVersion :: Version
119 %************************************************************************
123 %************************************************************************
127 -- reason/explanation from a WARNING or DEPRECATED pragma
128 data WarningTxt = WarningTxt [FastString]
129 | DeprecatedTxt [FastString]
130 deriving (Eq, Data, Typeable)
132 instance Outputable WarningTxt where
133 ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
134 ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
135 doubleQuotes (vcat (map ftext ds))
138 %************************************************************************
140 \subsection{Implicit parameter identity}
142 %************************************************************************
144 The @IPName@ type is here because it is used in TypeRep (i.e. very
145 early in the hierarchy), but also in HsSyn.
148 newtype IPName name = IPName name -- ?x
149 deriving( Eq, Ord, Data, Typeable )
150 -- Ord is used in the IP name cache finite map
151 -- (used in HscTypes.OrigIParamCache)
153 ipNameName :: IPName name -> name
154 ipNameName (IPName n) = n
156 mapIPName :: (a->b) -> IPName a -> IPName b
157 mapIPName f (IPName n) = IPName (f n)
159 instance Outputable name => Outputable (IPName name) where
160 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
163 %************************************************************************
167 %************************************************************************
170 type RuleName = FastString
173 %************************************************************************
175 \subsection[Fixity]{Fixity info}
177 %************************************************************************
180 ------------------------
181 data Fixity = Fixity Int FixityDirection
182 deriving (Data, Typeable)
184 instance Outputable Fixity where
185 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
187 instance Eq Fixity where -- Used to determine if two fixities conflict
188 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
190 ------------------------
191 data FixityDirection = InfixL | InfixR | InfixN
192 deriving (Eq, Data, Typeable)
194 instance Outputable FixityDirection where
195 ppr InfixL = ptext (sLit "infixl")
196 ppr InfixR = ptext (sLit "infixr")
197 ppr InfixN = ptext (sLit "infix")
199 ------------------------
202 defaultFixity :: Fixity
203 defaultFixity = Fixity maxPrecedence InfixL
205 negateFixity, funTyFixity :: Fixity
207 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
208 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
216 @(compareFixity op1 op2)@ tells which way to arrange appication, or
217 whether there's an error.
220 compareFixity :: Fixity -> Fixity
221 -> (Bool, -- Error please
222 Bool) -- Associate to the right: a op1 (b op2 c)
223 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
224 = case prec1 `compare` prec2 of
227 EQ -> case (dir1, dir2) of
228 (InfixR, InfixR) -> right
229 (InfixL, InfixL) -> left
232 right = (False, True)
233 left = (False, False)
234 error_please = (True, False)
238 %************************************************************************
240 \subsection[Top-level/local]{Top-level/not-top level flag}
242 %************************************************************************
249 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
251 isNotTopLevel NotTopLevel = True
252 isNotTopLevel TopLevel = False
254 isTopLevel TopLevel = True
255 isTopLevel NotTopLevel = False
257 instance Outputable TopLevelFlag where
258 ppr TopLevel = ptext (sLit "<TopLevel>")
259 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
263 %************************************************************************
265 Top-level/not-top level flag
267 %************************************************************************
273 deriving( Eq, Data, Typeable )
275 isBoxed :: Boxity -> Bool
277 isBoxed Unboxed = False
281 %************************************************************************
283 Recursive/Non-Recursive flag
285 %************************************************************************
288 data RecFlag = Recursive
290 deriving( Eq, Data, Typeable )
292 isRec :: RecFlag -> Bool
293 isRec Recursive = True
294 isRec NonRecursive = False
296 isNonRec :: RecFlag -> Bool
297 isNonRec Recursive = False
298 isNonRec NonRecursive = True
300 boolToRecFlag :: Bool -> RecFlag
301 boolToRecFlag True = Recursive
302 boolToRecFlag False = NonRecursive
304 instance Outputable RecFlag where
305 ppr Recursive = ptext (sLit "Recursive")
306 ppr NonRecursive = ptext (sLit "NonRecursive")
309 %************************************************************************
311 Instance overlap flag
313 %************************************************************************
317 = NoOverlap -- This instance must not overlap another
319 | OverlapOk -- Silently ignore this instance if you find a
320 -- more specific one that matches the constraint
321 -- you are trying to resolve
323 -- Example: constraint (Foo [Int])
324 -- instances (Foo [Int])
325 -- (Foo [a]) OverlapOk
326 -- Since the second instance has the OverlapOk flag,
327 -- the first instance will be chosen (otherwise
328 -- its ambiguous which to choose)
330 | Incoherent -- Like OverlapOk, but also ignore this instance
331 -- if it doesn't match the constraint you are
332 -- trying to resolve, but could match if the type variables
333 -- in the constraint were instantiated
335 -- Example: constraint (Foo [b])
336 -- instances (Foo [Int]) Incoherent
338 -- Without the Incoherent flag, we'd complain that
339 -- instantiating 'b' would change which instance
343 instance Outputable OverlapFlag where
344 ppr NoOverlap = empty
345 ppr OverlapOk = ptext (sLit "[overlap ok]")
346 ppr Incoherent = ptext (sLit "[incoherent]")
350 %************************************************************************
354 %************************************************************************
357 data TupCon = TupCon Boxity Arity
359 instance Eq TupCon where
360 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
362 tupleParens :: Boxity -> SDoc -> SDoc
363 tupleParens Boxed p = parens p
364 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
367 %************************************************************************
369 \subsection[Generic]{Generic flag}
371 %************************************************************************
373 This is the "Embedding-Projection pair" datatype, it contains
374 two pieces of code (normally either RenamedExpr's or Id's)
375 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
376 represents functions of type
385 T and Tring are arbitrary, but typically T is the 'main' type while
386 Tring is the 'representation' type. (This just helps us remember
387 whether to use 'from' or 'to'.
390 data EP a = EP { fromEP :: a, -- :: T -> Tring
391 toEP :: a } -- :: Tring -> T
394 Embedding-projection pairs are used in several places:
396 First of all, each type constructor has an EP associated with it, the
397 code in EP converts (datatype T) from T to Tring and back again.
399 Secondly, when we are filling in Generic methods (in the typechecker,
400 tcMethodBinds), we are constructing bimaps by induction on the structure
401 of the type of the method signature.
404 %************************************************************************
406 \subsection{Occurrence information}
408 %************************************************************************
410 This data type is used exclusively by the simplifier, but it appears in a
411 SubstResult, which is currently defined in VarEnv, which is pretty near
412 the base of the module hierarchy. So it seemed simpler to put the
413 defn of OccInfo here, safely at the bottom
416 -- | Identifier occurrence information
418 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
420 | IAmDead -- ^ Marks unused variables. Sometimes useful for
421 -- lambda and case-bound variables.
426 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
428 -- | This identifier breaks a loop of mutually recursive functions. The field
429 -- marks whether it is only a loop breaker due to a reference in a rule
430 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
431 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
432 -- See OccurAnal Note [Weak loop breakers]
434 type RulesOnly = Bool
437 Note [LoopBreaker OccInfo]
438 ~~~~~~~~~~~~~~~~~~~~~~~~~~
439 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
440 analyser in two ways:
441 (a) to mark loop-breakers in a group of recursive
442 definitions (hence the name)
443 (b) to mark binders that must not be inlined in this phase
444 (perhaps it has a NOINLINE pragma)
445 Things with (IAmLoopBreaker False) do not get an unfolding
446 pinned on to them, so they are completely opaque.
448 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
452 isNoOcc :: OccInfo -> Bool
453 isNoOcc NoOccInfo = True
456 seqOccInfo :: OccInfo -> ()
457 seqOccInfo occ = occ `seq` ()
460 type InterestingCxt = Bool -- True <=> Function: is applied
461 -- Data value: scrutinised by a case with
462 -- at least one non-DEFAULT branch
465 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
466 -- Substituting a redex for this occurrence is
467 -- dangerous because it might duplicate work.
468 insideLam, notInsideLam :: InsideLam
473 type OneBranch = Bool -- True <=> Occurs in only one case branch
474 -- so no code-duplication issue to worry about
475 oneBranch, notOneBranch :: OneBranch
479 isLoopBreaker :: OccInfo -> Bool
480 isLoopBreaker (IAmALoopBreaker _) = True
481 isLoopBreaker _ = False
483 isNonRuleLoopBreaker :: OccInfo -> Bool
484 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
485 isNonRuleLoopBreaker _ = False
487 nonRuleLoopBreaker :: OccInfo
488 nonRuleLoopBreaker = IAmALoopBreaker False
490 isDeadOcc :: OccInfo -> Bool
491 isDeadOcc IAmDead = True
494 isOneOcc :: OccInfo -> Bool
495 isOneOcc (OneOcc {}) = True
498 zapFragileOcc :: OccInfo -> OccInfo
499 zapFragileOcc (OneOcc {}) = NoOccInfo
500 zapFragileOcc occ = occ
504 instance Outputable OccInfo where
505 -- only used for debugging; never parsed. KSW 1999-07
506 ppr NoOccInfo = empty
507 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
508 ppr IAmDead = ptext (sLit "Dead")
509 ppr (OneOcc inside_lam one_branch int_cxt)
510 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
512 pp_lam | inside_lam = char 'L'
514 pp_br | one_branch = empty
515 | otherwise = char '*'
516 pp_args | int_cxt = char '!'
519 instance Show OccInfo where
520 showsPrec p occ = showsPrecSDoc p (ppr occ)
523 %************************************************************************
525 \subsection{Strictness indication}
527 %************************************************************************
529 The strictness annotations on types in data type declarations
530 e.g. data T = MkT !Int !(Bool,Bool)
533 -------------------------
534 -- HsBang describes what the *programmer* wrote
535 -- This info is retained in the DataCon.dcStrictMarks field
536 data HsBang = HsNoBang
540 | HsUnpack -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
542 | HsUnpackFailed -- An UNPACK pragma that we could not make
543 -- use of, because the type isn't unboxable;
544 -- equivalant to HsStrict except for checkValidDataCon
545 deriving (Eq, Data, Typeable)
547 instance Outputable HsBang where
549 ppr HsStrict = char '!'
550 ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
551 ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
553 isBanged :: HsBang -> Bool
554 isBanged HsNoBang = False
557 isMarkedUnboxed :: HsBang -> Bool
558 isMarkedUnboxed HsUnpack = True
559 isMarkedUnboxed _ = False
561 -------------------------
562 -- StrictnessMark is internal only, used to indicate strictness
563 -- of the DataCon *worker* fields
564 data StrictnessMark = MarkedStrict | NotMarkedStrict
566 instance Outputable StrictnessMark where
567 ppr MarkedStrict = ptext (sLit "!")
568 ppr NotMarkedStrict = empty
570 isMarkedStrict :: StrictnessMark -> Bool
571 isMarkedStrict NotMarkedStrict = False
572 isMarkedStrict _ = True -- All others are strict
576 %************************************************************************
578 \subsection{Success flag}
580 %************************************************************************
583 data SuccessFlag = Succeeded | Failed
585 instance Outputable SuccessFlag where
586 ppr Succeeded = ptext (sLit "Succeeded")
587 ppr Failed = ptext (sLit "Failed")
589 successIf :: Bool -> SuccessFlag
590 successIf True = Succeeded
591 successIf False = Failed
593 succeeded, failed :: SuccessFlag -> Bool
594 succeeded Succeeded = True
595 succeeded Failed = False
597 failed Succeeded = False
602 %************************************************************************
604 \subsection{Activation}
606 %************************************************************************
608 When a rule or inlining is active
611 type CompilerPhase = Int -- Compilation phase
612 -- Phases decrease towards zero
613 -- Zero is the last phase
615 data Activation = NeverActive
617 | ActiveBefore CompilerPhase -- Active only *before* this phase
618 | ActiveAfter CompilerPhase -- Active in this phase and later
619 deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
621 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
623 deriving( Eq, Data, Typeable )
625 data InlinePragma -- Note [InlinePragma]
627 { inl_inline :: Bool -- True <=> INLINE,
628 -- False <=> no pragma at all, or NOINLINE
629 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
630 -- explicit (non-type, non-dictionary) args
631 , inl_act :: Activation -- Says during which phases inlining is allowed
632 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
633 } deriving( Eq, Data, Typeable )
638 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
641 If you write nothing at all, you get defaultInlinePragma:
643 inl_act = AlwaysActive
646 It's not possible to get that combination by *writing* something, so
647 if an Id has defaultInlinePragma it means the user didn't specify anything.
649 If inl_inline = True, then the Id should have an InlineRule unfolding.
651 Note [CONLIKE pragma]
652 ~~~~~~~~~~~~~~~~~~~~~
653 The ConLike constructor of a RuleMatchInfo is aimed at the following.
655 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
656 g b bs = let x = b:bs in ..x...x...(r x)...
657 Now, the rule applies to the (r x) term, because GHC "looks through"
658 the definition of 'x' to see that it is (b:bs).
661 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
662 g v = let x = f v in ..x...x...(r x)...
663 Normally the (r x) would *not* match the rule, because GHC would be
664 scared about duplicating the redex (f v), so it does not "look
665 through" the bindings.
667 However the CONLIKE modifier says to treat 'f' like a constructor in
668 this situation, and "look through" the unfolding for x. So (r x)
669 fires, yielding (f (v+1)).
671 This is all controlled with a user-visible pragma:
672 {-# NOINLINE CONLIKE [1] f #-}
674 The main effects of CONLIKE are:
676 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
677 CONLIKE thing like constructors, by ANF-ing them
679 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
680 additionally spots applications of CONLIKE functions
682 - A CoreUnfolding has a field that caches exprIsExpandable
684 - The rule matcher consults this field. See
685 Note [Expanding variables] in Rules.lhs.
688 isConLike :: RuleMatchInfo -> Bool
689 isConLike ConLike = True
692 isFunLike :: RuleMatchInfo -> Bool
693 isFunLike FunLike = True
696 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
698 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
701 , inl_sat = Nothing }
703 alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
704 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
706 -- A DFun has an always-active inline activation so that
707 -- exprIsConApp_maybe can "see" its unfolding
708 -- (However, its actual Unfolding is a DFunUnfolding, which is
709 -- never inlined other than via exprIsConApp_maybe.)
710 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
711 , inl_rule = ConLike }
713 isDefaultInlinePragma :: InlinePragma -> Bool
714 isDefaultInlinePragma (InlinePragma { inl_act = activation
715 , inl_rule = match_info
716 , inl_inline = inline })
717 = not inline && isAlwaysActive activation && isFunLike match_info
719 isInlinePragma :: InlinePragma -> Bool
720 isInlinePragma prag = inl_inline prag
722 inlinePragmaSat :: InlinePragma -> Maybe Arity
723 inlinePragmaSat = inl_sat
725 inlinePragmaActivation :: InlinePragma -> Activation
726 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
728 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
729 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
731 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
732 setInlinePragmaActivation prag activation = prag { inl_act = activation }
734 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
735 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
737 instance Outputable Activation where
738 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
739 ppr NeverActive = brackets (ptext (sLit "NEVER"))
740 ppr (ActiveBefore n) = brackets (char '~' <> int n)
741 ppr (ActiveAfter n) = brackets (int n)
743 instance Outputable RuleMatchInfo where
744 ppr ConLike = ptext (sLit "CONLIKE")
745 ppr FunLike = ptext (sLit "FUNLIKE")
747 instance Outputable InlinePragma where
748 ppr (InlinePragma { inl_inline = inline, inl_act = activation
749 , inl_rule = info, inl_sat = mb_arity })
750 = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info
752 pp_inl_act (False, AlwaysActive) = empty -- defaultInlinePragma
753 pp_inl_act (False, NeverActive) = ptext (sLit "NOINLINE")
754 pp_inl_act (False, act) = ptext (sLit "NOINLINE") <> ppr act
755 pp_inl_act (True, AlwaysActive) = ptext (sLit "INLINE")
756 pp_inl_act (True, act) = ptext (sLit "INLINE") <> ppr act
758 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
760 pp_info | isFunLike info = empty
761 | otherwise = ppr info
763 isActive :: CompilerPhase -> Activation -> Bool
764 isActive _ NeverActive = False
765 isActive _ AlwaysActive = True
766 isActive p (ActiveAfter n) = p <= n
767 isActive p (ActiveBefore n) = p > n
769 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
770 isNeverActive NeverActive = True
771 isNeverActive _ = False
773 isAlwaysActive AlwaysActive = True
774 isAlwaysActive _ = False
776 isEarlyActive AlwaysActive = True
777 isEarlyActive (ActiveBefore {}) = True
778 isEarlyActive _ = False