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,
63 Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
64 RuleMatchInfo(..), isConLike, isFunLike,
66 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
67 neverInlinePragma, dfunInlinePragma,
68 isDefaultInlinePragma, isInlinePragma, inlinePragmaSpec, inlinePragmaSat,
69 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
70 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
72 SuccessFlag(..), succeeded, failed, successIf
78 import Data.Data hiding (Fixity)
81 %************************************************************************
83 \subsection[Arity]{Arity}
85 %************************************************************************
91 %************************************************************************
93 \subsection[FunctionOrData]{FunctionOrData}
95 %************************************************************************
98 data FunctionOrData = IsFunction | IsData
99 deriving (Eq, Ord, Data, Typeable)
101 instance Outputable FunctionOrData where
102 ppr IsFunction = text "(function)"
103 ppr IsData = text "(data)"
107 %************************************************************************
109 \subsection[Version]{Module and identifier version numbers}
111 %************************************************************************
116 bumpVersion :: Version -> Version
119 initialVersion :: Version
123 %************************************************************************
127 %************************************************************************
131 -- reason/explanation from a WARNING or DEPRECATED pragma
132 data WarningTxt = WarningTxt [FastString]
133 | DeprecatedTxt [FastString]
134 deriving (Eq, Data, Typeable)
136 instance Outputable WarningTxt where
137 ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
138 ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
139 doubleQuotes (vcat (map ftext ds))
142 %************************************************************************
144 \subsection{Implicit parameter identity}
146 %************************************************************************
148 The @IPName@ type is here because it is used in TypeRep (i.e. very
149 early in the hierarchy), but also in HsSyn.
152 newtype IPName name = IPName name -- ?x
153 deriving( Eq, Ord, Data, Typeable )
154 -- Ord is used in the IP name cache finite map
155 -- (used in HscTypes.OrigIParamCache)
157 ipNameName :: IPName name -> name
158 ipNameName (IPName n) = n
160 mapIPName :: (a->b) -> IPName a -> IPName b
161 mapIPName f (IPName n) = IPName (f n)
163 instance Outputable name => Outputable (IPName name) where
164 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
167 %************************************************************************
171 %************************************************************************
174 type RuleName = FastString
177 %************************************************************************
179 \subsection[Fixity]{Fixity info}
181 %************************************************************************
184 ------------------------
185 data Fixity = Fixity Int FixityDirection
186 deriving (Data, Typeable)
188 instance Outputable Fixity where
189 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
191 instance Eq Fixity where -- Used to determine if two fixities conflict
192 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
194 ------------------------
195 data FixityDirection = InfixL | InfixR | InfixN
196 deriving (Eq, Data, Typeable)
198 instance Outputable FixityDirection where
199 ppr InfixL = ptext (sLit "infixl")
200 ppr InfixR = ptext (sLit "infixr")
201 ppr InfixN = ptext (sLit "infix")
203 ------------------------
206 defaultFixity :: Fixity
207 defaultFixity = Fixity maxPrecedence InfixL
209 negateFixity, funTyFixity :: Fixity
211 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
212 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
220 @(compareFixity op1 op2)@ tells which way to arrange appication, or
221 whether there's an error.
224 compareFixity :: Fixity -> Fixity
225 -> (Bool, -- Error please
226 Bool) -- Associate to the right: a op1 (b op2 c)
227 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
228 = case prec1 `compare` prec2 of
231 EQ -> case (dir1, dir2) of
232 (InfixR, InfixR) -> right
233 (InfixL, InfixL) -> left
236 right = (False, True)
237 left = (False, False)
238 error_please = (True, False)
242 %************************************************************************
244 \subsection[Top-level/local]{Top-level/not-top level flag}
246 %************************************************************************
253 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
255 isNotTopLevel NotTopLevel = True
256 isNotTopLevel TopLevel = False
258 isTopLevel TopLevel = True
259 isTopLevel NotTopLevel = False
261 instance Outputable TopLevelFlag where
262 ppr TopLevel = ptext (sLit "<TopLevel>")
263 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
267 %************************************************************************
269 Top-level/not-top level flag
271 %************************************************************************
277 deriving( Eq, Data, Typeable )
279 isBoxed :: Boxity -> Bool
281 isBoxed Unboxed = False
285 %************************************************************************
287 Recursive/Non-Recursive flag
289 %************************************************************************
292 data RecFlag = Recursive
294 deriving( Eq, Data, Typeable )
296 isRec :: RecFlag -> Bool
297 isRec Recursive = True
298 isRec NonRecursive = False
300 isNonRec :: RecFlag -> Bool
301 isNonRec Recursive = False
302 isNonRec NonRecursive = True
304 boolToRecFlag :: Bool -> RecFlag
305 boolToRecFlag True = Recursive
306 boolToRecFlag False = NonRecursive
308 instance Outputable RecFlag where
309 ppr Recursive = ptext (sLit "Recursive")
310 ppr NonRecursive = ptext (sLit "NonRecursive")
313 %************************************************************************
315 Instance overlap flag
317 %************************************************************************
321 = NoOverlap -- This instance must not overlap another
323 | OverlapOk -- Silently ignore this instance if you find a
324 -- more specific one that matches the constraint
325 -- you are trying to resolve
327 -- Example: constraint (Foo [Int])
328 -- instances (Foo [Int])
330 -- (Foo [a]) OverlapOk
331 -- Since the second instance has the OverlapOk flag,
332 -- the first instance will be chosen (otherwise
333 -- its ambiguous which to choose)
335 | Incoherent -- Like OverlapOk, but also ignore this instance
336 -- if it doesn't match the constraint you are
337 -- trying to resolve, but could match if the type variables
338 -- in the constraint were instantiated
340 -- Example: constraint (Foo [b])
341 -- instances (Foo [Int]) Incoherent
343 -- Without the Incoherent flag, we'd complain that
344 -- instantiating 'b' would change which instance
348 instance Outputable OverlapFlag where
349 ppr NoOverlap = empty
350 ppr OverlapOk = ptext (sLit "[overlap ok]")
351 ppr Incoherent = ptext (sLit "[incoherent]")
355 %************************************************************************
359 %************************************************************************
362 data TupCon = TupCon Boxity Arity
364 instance Eq TupCon where
365 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
367 tupleParens :: Boxity -> SDoc -> SDoc
368 tupleParens Boxed p = parens p
369 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
372 %************************************************************************
374 \subsection[Generic]{Generic flag}
376 %************************************************************************
378 This is the "Embedding-Projection pair" datatype, it contains
379 two pieces of code (normally either RenamedExpr's or Id's)
380 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
381 represents functions of type
390 T and Tring are arbitrary, but typically T is the 'main' type while
391 Tring is the 'representation' type. (This just helps us remember
392 whether to use 'from' or 'to'.
395 data EP a = EP { fromEP :: a, -- :: T -> Tring
396 toEP :: a } -- :: Tring -> T
399 Embedding-projection pairs are used in several places:
401 First of all, each type constructor has an EP associated with it, the
402 code in EP converts (datatype T) from T to Tring and back again.
404 Secondly, when we are filling in Generic methods (in the typechecker,
405 tcMethodBinds), we are constructing bimaps by induction on the structure
406 of the type of the method signature.
409 %************************************************************************
411 \subsection{Occurrence information}
413 %************************************************************************
415 This data type is used exclusively by the simplifier, but it appears in a
416 SubstResult, which is currently defined in VarEnv, which is pretty near
417 the base of the module hierarchy. So it seemed simpler to put the
418 defn of OccInfo here, safely at the bottom
421 -- | Identifier occurrence information
423 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
425 | IAmDead -- ^ Marks unused variables. Sometimes useful for
426 -- lambda and case-bound variables.
431 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
433 -- | This identifier breaks a loop of mutually recursive functions. The field
434 -- marks whether it is only a loop breaker due to a reference in a rule
435 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
436 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
437 -- See OccurAnal Note [Weak loop breakers]
439 type RulesOnly = Bool
442 Note [LoopBreaker OccInfo]
443 ~~~~~~~~~~~~~~~~~~~~~~~~~~
444 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
445 analyser in two ways:
446 (a) to mark loop-breakers in a group of recursive
447 definitions (hence the name)
448 (b) to mark binders that must not be inlined in this phase
449 (perhaps it has a NOINLINE pragma)
450 Things with (IAmLoopBreaker False) do not get an unfolding
451 pinned on to them, so they are completely opaque.
453 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
457 isNoOcc :: OccInfo -> Bool
458 isNoOcc NoOccInfo = True
461 seqOccInfo :: OccInfo -> ()
462 seqOccInfo occ = occ `seq` ()
465 type InterestingCxt = Bool -- True <=> Function: is applied
466 -- Data value: scrutinised by a case with
467 -- at least one non-DEFAULT branch
470 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
471 -- Substituting a redex for this occurrence is
472 -- dangerous because it might duplicate work.
473 insideLam, notInsideLam :: InsideLam
478 type OneBranch = Bool -- True <=> Occurs in only one case branch
479 -- so no code-duplication issue to worry about
480 oneBranch, notOneBranch :: OneBranch
484 isLoopBreaker :: OccInfo -> Bool
485 isLoopBreaker (IAmALoopBreaker _) = True
486 isLoopBreaker _ = False
488 isNonRuleLoopBreaker :: OccInfo -> Bool
489 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
490 isNonRuleLoopBreaker _ = False
492 nonRuleLoopBreaker :: OccInfo
493 nonRuleLoopBreaker = IAmALoopBreaker False
495 isDeadOcc :: OccInfo -> Bool
496 isDeadOcc IAmDead = True
499 isOneOcc :: OccInfo -> Bool
500 isOneOcc (OneOcc {}) = True
503 zapFragileOcc :: OccInfo -> OccInfo
504 zapFragileOcc (OneOcc {}) = NoOccInfo
505 zapFragileOcc occ = occ
509 instance Outputable OccInfo where
510 -- only used for debugging; never parsed. KSW 1999-07
511 ppr NoOccInfo = empty
512 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
513 ppr IAmDead = ptext (sLit "Dead")
514 ppr (OneOcc inside_lam one_branch int_cxt)
515 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
517 pp_lam | inside_lam = char 'L'
519 pp_br | one_branch = empty
520 | otherwise = char '*'
521 pp_args | int_cxt = char '!'
524 instance Show OccInfo where
525 showsPrec p occ = showsPrecSDoc p (ppr occ)
528 %************************************************************************
530 Strictness indication
532 %************************************************************************
534 The strictness annotations on types in data type declarations
535 e.g. data T = MkT !Int !(Bool,Bool)
538 -------------------------
539 -- HsBang describes what the *programmer* wrote
540 -- This info is retained in the DataCon.dcStrictMarks field
541 data HsBang = HsNoBang
545 | HsUnpack -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
547 | HsUnpackFailed -- An UNPACK pragma that we could not make
548 -- use of, because the type isn't unboxable;
549 -- equivalant to HsStrict except for checkValidDataCon
550 deriving (Eq, Data, Typeable)
552 instance Outputable HsBang where
554 ppr HsStrict = char '!'
555 ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
556 ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
558 isBanged :: HsBang -> Bool
559 isBanged HsNoBang = False
562 isMarkedUnboxed :: HsBang -> Bool
563 isMarkedUnboxed HsUnpack = True
564 isMarkedUnboxed _ = False
566 -------------------------
567 -- StrictnessMark is internal only, used to indicate strictness
568 -- of the DataCon *worker* fields
569 data StrictnessMark = MarkedStrict | NotMarkedStrict
571 instance Outputable StrictnessMark where
572 ppr MarkedStrict = ptext (sLit "!")
573 ppr NotMarkedStrict = empty
575 isMarkedStrict :: StrictnessMark -> Bool
576 isMarkedStrict NotMarkedStrict = False
577 isMarkedStrict _ = True -- All others are strict
581 %************************************************************************
583 Default method specfication
585 %************************************************************************
587 The DefMethSpec enumeration just indicates what sort of default method
588 is used for a class. It is generated from source code, and present in
589 interface files; it is converted to Class.DefMeth before begin put in a
593 data DefMethSpec = NoDM -- No default method
594 | VanillaDM -- Default method given with polymorphic code
595 | GenericDM -- Default method given with generic code
597 instance Outputable DefMethSpec where
599 ppr VanillaDM = ptext (sLit "{- Has default method -}")
600 ppr GenericDM = ptext (sLit "{- Has generic default method -}")
603 %************************************************************************
605 \subsection{Success flag}
607 %************************************************************************
610 data SuccessFlag = Succeeded | Failed
612 instance Outputable SuccessFlag where
613 ppr Succeeded = ptext (sLit "Succeeded")
614 ppr Failed = ptext (sLit "Failed")
616 successIf :: Bool -> SuccessFlag
617 successIf True = Succeeded
618 successIf False = Failed
620 succeeded, failed :: SuccessFlag -> Bool
621 succeeded Succeeded = True
622 succeeded Failed = False
624 failed Succeeded = False
629 %************************************************************************
631 \subsection{Activation}
633 %************************************************************************
635 When a rule or inlining is active
638 type CompilerPhase = Int -- Compilation phase
639 -- Phases decrease towards zero
640 -- Zero is the last phase
642 data Activation = NeverActive
644 | ActiveBefore CompilerPhase -- Active only *before* this phase
645 | ActiveAfter CompilerPhase -- Active in this phase and later
646 deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
648 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
650 deriving( Eq, Data, Typeable, Show )
651 -- Show needed for Lexer.x
653 data InlinePragma -- Note [InlinePragma]
655 { inl_inline :: InlineSpec
657 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
658 -- explicit (non-type, non-dictionary) args
659 -- That is, inl_sat describes the number of *source-code*
660 -- arguments the thing must be applied to. We add on the
661 -- number of implicit, dictionary arguments when making
662 -- the InlineRule, and don't look at inl_sat further
664 , inl_act :: Activation -- Says during which phases inlining is allowed
666 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
667 } deriving( Eq, Data, Typeable )
669 data InlineSpec -- What the user's INLINE pragama looked like
674 deriving( Eq, Data, Typeable, Show )
675 -- Show needed for Lexer.x
680 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
683 If you write nothing at all, you get defaultInlinePragma:
685 inl_act = AlwaysActive
688 It's not possible to get that combination by *writing* something, so
689 if an Id has defaultInlinePragma it means the user didn't specify anything.
691 If inl_inline = True, then the Id should have an InlineRule unfolding.
693 Note [CONLIKE pragma]
694 ~~~~~~~~~~~~~~~~~~~~~
695 The ConLike constructor of a RuleMatchInfo is aimed at the following.
697 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
698 g b bs = let x = b:bs in ..x...x...(r x)...
699 Now, the rule applies to the (r x) term, because GHC "looks through"
700 the definition of 'x' to see that it is (b:bs).
703 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
704 g v = let x = f v in ..x...x...(r x)...
705 Normally the (r x) would *not* match the rule, because GHC would be
706 scared about duplicating the redex (f v), so it does not "look
707 through" the bindings.
709 However the CONLIKE modifier says to treat 'f' like a constructor in
710 this situation, and "look through" the unfolding for x. So (r x)
711 fires, yielding (f (v+1)).
713 This is all controlled with a user-visible pragma:
714 {-# NOINLINE CONLIKE [1] f #-}
716 The main effects of CONLIKE are:
718 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
719 CONLIKE thing like constructors, by ANF-ing them
721 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
722 additionally spots applications of CONLIKE functions
724 - A CoreUnfolding has a field that caches exprIsExpandable
726 - The rule matcher consults this field. See
727 Note [Expanding variables] in Rules.lhs.
730 isConLike :: RuleMatchInfo -> Bool
731 isConLike ConLike = True
734 isFunLike :: RuleMatchInfo -> Bool
735 isFunLike FunLike = True
738 isInlineSpec :: InlineSpec -> Bool
739 isInlineSpec Inline = True
740 isInlineSpec Inlinable = True
741 isInlineSpec _ = False
743 isEmptyInlineSpec :: InlineSpec -> Bool
744 isEmptyInlineSpec EmptyInlineSpec = True
745 isEmptyInlineSpec _ = False
747 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
749 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
751 , inl_inline = EmptyInlineSpec
752 , inl_sat = Nothing }
754 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
755 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
757 inlinePragmaSpec :: InlinePragma -> InlineSpec
758 inlinePragmaSpec = inl_inline
760 -- A DFun has an always-active inline activation so that
761 -- exprIsConApp_maybe can "see" its unfolding
762 -- (However, its actual Unfolding is a DFunUnfolding, which is
763 -- never inlined other than via exprIsConApp_maybe.)
764 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
765 , inl_rule = ConLike }
767 isDefaultInlinePragma :: InlinePragma -> Bool
768 isDefaultInlinePragma (InlinePragma { inl_act = activation
769 , inl_rule = match_info
770 , inl_inline = inline })
771 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
773 isInlinePragma :: InlinePragma -> Bool
774 isInlinePragma prag = isInlineSpec (inl_inline prag)
776 inlinePragmaSat :: InlinePragma -> Maybe Arity
777 inlinePragmaSat = inl_sat
779 inlinePragmaActivation :: InlinePragma -> Activation
780 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
782 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
783 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
785 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
786 setInlinePragmaActivation prag activation = prag { inl_act = activation }
788 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
789 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
791 instance Outputable Activation where
792 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
793 ppr NeverActive = brackets (ptext (sLit "NEVER"))
794 ppr (ActiveBefore n) = brackets (char '~' <> int n)
795 ppr (ActiveAfter n) = brackets (int n)
797 instance Outputable RuleMatchInfo where
798 ppr ConLike = ptext (sLit "CONLIKE")
799 ppr FunLike = ptext (sLit "FUNLIKE")
801 instance Outputable InlineSpec where
802 ppr Inline = ptext (sLit "INLINE")
803 ppr NoInline = ptext (sLit "NOINLINE")
804 ppr Inlinable = ptext (sLit "INLINABLE")
805 ppr EmptyInlineSpec = empty
807 instance Outputable InlinePragma where
808 ppr (InlinePragma { inl_inline = inline, inl_act = activation
809 , inl_rule = info, inl_sat = mb_arity })
810 = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
812 pp_act Inline AlwaysActive = empty
813 pp_act NoInline NeverActive = empty
814 pp_act _ act = ppr act
816 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
818 pp_info | isFunLike info = empty
819 | otherwise = ppr info
821 isActive :: CompilerPhase -> Activation -> Bool
822 isActive _ NeverActive = False
823 isActive _ AlwaysActive = True
824 isActive p (ActiveAfter n) = p <= n
825 isActive p (ActiveBefore n) = p > n
827 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
828 isNeverActive NeverActive = True
829 isNeverActive _ = False
831 isAlwaysActive AlwaysActive = True
832 isAlwaysActive _ = False
834 isEarlyActive AlwaysActive = True
835 isEarlyActive (ActiveBefore {}) = True
836 isEarlyActive _ = False