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
630 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
631 -- explicit (non-type, non-dictionary) args
632 -- That is, inl_sat describes the number of *source-code*
633 -- arguments the thing must be applied to. We add on the
634 -- number of implicit, dictionary arguments when making
635 -- the InlineRule, and don't look at inl_sat further
637 , inl_act :: Activation -- Says during which phases inlining is allowed
639 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
640 } deriving( Eq, Data, Typeable )
645 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
648 If you write nothing at all, you get defaultInlinePragma:
650 inl_act = AlwaysActive
653 It's not possible to get that combination by *writing* something, so
654 if an Id has defaultInlinePragma it means the user didn't specify anything.
656 If inl_inline = True, then the Id should have an InlineRule unfolding.
658 Note [CONLIKE pragma]
659 ~~~~~~~~~~~~~~~~~~~~~
660 The ConLike constructor of a RuleMatchInfo is aimed at the following.
662 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
663 g b bs = let x = b:bs in ..x...x...(r x)...
664 Now, the rule applies to the (r x) term, because GHC "looks through"
665 the definition of 'x' to see that it is (b:bs).
668 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
669 g v = let x = f v in ..x...x...(r x)...
670 Normally the (r x) would *not* match the rule, because GHC would be
671 scared about duplicating the redex (f v), so it does not "look
672 through" the bindings.
674 However the CONLIKE modifier says to treat 'f' like a constructor in
675 this situation, and "look through" the unfolding for x. So (r x)
676 fires, yielding (f (v+1)).
678 This is all controlled with a user-visible pragma:
679 {-# NOINLINE CONLIKE [1] f #-}
681 The main effects of CONLIKE are:
683 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
684 CONLIKE thing like constructors, by ANF-ing them
686 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
687 additionally spots applications of CONLIKE functions
689 - A CoreUnfolding has a field that caches exprIsExpandable
691 - The rule matcher consults this field. See
692 Note [Expanding variables] in Rules.lhs.
695 isConLike :: RuleMatchInfo -> Bool
696 isConLike ConLike = True
699 isFunLike :: RuleMatchInfo -> Bool
700 isFunLike FunLike = True
703 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
705 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
708 , inl_sat = Nothing }
710 alwaysInlinePragma = defaultInlinePragma { inl_inline = True }
711 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
713 -- A DFun has an always-active inline activation so that
714 -- exprIsConApp_maybe can "see" its unfolding
715 -- (However, its actual Unfolding is a DFunUnfolding, which is
716 -- never inlined other than via exprIsConApp_maybe.)
717 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
718 , inl_rule = ConLike }
720 isDefaultInlinePragma :: InlinePragma -> Bool
721 isDefaultInlinePragma (InlinePragma { inl_act = activation
722 , inl_rule = match_info
723 , inl_inline = inline })
724 = not inline && isAlwaysActive activation && isFunLike match_info
726 isInlinePragma :: InlinePragma -> Bool
727 isInlinePragma prag = inl_inline prag
729 inlinePragmaSat :: InlinePragma -> Maybe Arity
730 inlinePragmaSat = inl_sat
732 inlinePragmaActivation :: InlinePragma -> Activation
733 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
735 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
736 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
738 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
739 setInlinePragmaActivation prag activation = prag { inl_act = activation }
741 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
742 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
744 instance Outputable Activation where
745 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
746 ppr NeverActive = brackets (ptext (sLit "NEVER"))
747 ppr (ActiveBefore n) = brackets (char '~' <> int n)
748 ppr (ActiveAfter n) = brackets (int n)
750 instance Outputable RuleMatchInfo where
751 ppr ConLike = ptext (sLit "CONLIKE")
752 ppr FunLike = ptext (sLit "FUNLIKE")
754 instance Outputable InlinePragma where
755 ppr (InlinePragma { inl_inline = inline, inl_act = activation
756 , inl_rule = info, inl_sat = mb_arity })
757 = pp_inl_act (inline, activation) <+> pp_sat <+> pp_info
759 pp_inl_act (False, AlwaysActive) = empty -- defaultInlinePragma
760 pp_inl_act (False, NeverActive) = ptext (sLit "NOINLINE")
761 pp_inl_act (False, act) = ptext (sLit "NOINLINE") <> ppr act
762 pp_inl_act (True, AlwaysActive) = ptext (sLit "INLINE")
763 pp_inl_act (True, act) = ptext (sLit "INLINE") <> ppr act
765 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
767 pp_info | isFunLike info = empty
768 | otherwise = ppr info
770 isActive :: CompilerPhase -> Activation -> Bool
771 isActive _ NeverActive = False
772 isActive _ AlwaysActive = True
773 isActive p (ActiveAfter n) = p <= n
774 isActive p (ActiveBefore n) = p > n
776 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
777 isNeverActive NeverActive = True
778 isNeverActive _ = False
780 isAlwaysActive AlwaysActive = True
781 isAlwaysActive _ = False
783 isEarlyActive AlwaysActive = True
784 isEarlyActive (ActiveBefore {}) = True
785 isEarlyActive _ = False