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, isInlinablePragma,
69 inlinePragmaSpec, inlinePragmaSat,
70 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
71 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
73 SuccessFlag(..), succeeded, failed, successIf
79 import Data.Data hiding (Fixity)
82 %************************************************************************
84 \subsection[Arity]{Arity}
86 %************************************************************************
92 %************************************************************************
94 \subsection[FunctionOrData]{FunctionOrData}
96 %************************************************************************
99 data FunctionOrData = IsFunction | IsData
100 deriving (Eq, Ord, Data, Typeable)
102 instance Outputable FunctionOrData where
103 ppr IsFunction = text "(function)"
104 ppr IsData = text "(data)"
108 %************************************************************************
110 \subsection[Version]{Module and identifier version numbers}
112 %************************************************************************
117 bumpVersion :: Version -> Version
120 initialVersion :: Version
124 %************************************************************************
128 %************************************************************************
132 -- reason/explanation from a WARNING or DEPRECATED pragma
133 data WarningTxt = WarningTxt [FastString]
134 | DeprecatedTxt [FastString]
135 deriving (Eq, Data, Typeable)
137 instance Outputable WarningTxt where
138 ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
139 ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
140 doubleQuotes (vcat (map ftext ds))
143 %************************************************************************
145 \subsection{Implicit parameter identity}
147 %************************************************************************
149 The @IPName@ type is here because it is used in TypeRep (i.e. very
150 early in the hierarchy), but also in HsSyn.
153 newtype IPName name = IPName name -- ?x
154 deriving( Eq, Ord, Data, Typeable )
155 -- Ord is used in the IP name cache finite map
156 -- (used in HscTypes.OrigIParamCache)
158 ipNameName :: IPName name -> name
159 ipNameName (IPName n) = n
161 mapIPName :: (a->b) -> IPName a -> IPName b
162 mapIPName f (IPName n) = IPName (f n)
164 instance Outputable name => Outputable (IPName name) where
165 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
168 %************************************************************************
172 %************************************************************************
175 type RuleName = FastString
178 %************************************************************************
180 \subsection[Fixity]{Fixity info}
182 %************************************************************************
185 ------------------------
186 data Fixity = Fixity Int FixityDirection
187 deriving (Data, Typeable)
189 instance Outputable Fixity where
190 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
192 instance Eq Fixity where -- Used to determine if two fixities conflict
193 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
195 ------------------------
196 data FixityDirection = InfixL | InfixR | InfixN
197 deriving (Eq, Data, Typeable)
199 instance Outputable FixityDirection where
200 ppr InfixL = ptext (sLit "infixl")
201 ppr InfixR = ptext (sLit "infixr")
202 ppr InfixN = ptext (sLit "infix")
204 ------------------------
207 defaultFixity :: Fixity
208 defaultFixity = Fixity maxPrecedence InfixL
210 negateFixity, funTyFixity :: Fixity
212 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
213 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
221 @(compareFixity op1 op2)@ tells which way to arrange appication, or
222 whether there's an error.
225 compareFixity :: Fixity -> Fixity
226 -> (Bool, -- Error please
227 Bool) -- Associate to the right: a op1 (b op2 c)
228 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
229 = case prec1 `compare` prec2 of
232 EQ -> case (dir1, dir2) of
233 (InfixR, InfixR) -> right
234 (InfixL, InfixL) -> left
237 right = (False, True)
238 left = (False, False)
239 error_please = (True, False)
243 %************************************************************************
245 \subsection[Top-level/local]{Top-level/not-top level flag}
247 %************************************************************************
254 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
256 isNotTopLevel NotTopLevel = True
257 isNotTopLevel TopLevel = False
259 isTopLevel TopLevel = True
260 isTopLevel NotTopLevel = False
262 instance Outputable TopLevelFlag where
263 ppr TopLevel = ptext (sLit "<TopLevel>")
264 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
268 %************************************************************************
270 Top-level/not-top level flag
272 %************************************************************************
278 deriving( Eq, Data, Typeable )
280 isBoxed :: Boxity -> Bool
282 isBoxed Unboxed = False
286 %************************************************************************
288 Recursive/Non-Recursive flag
290 %************************************************************************
293 data RecFlag = Recursive
295 deriving( Eq, Data, Typeable )
297 isRec :: RecFlag -> Bool
298 isRec Recursive = True
299 isRec NonRecursive = False
301 isNonRec :: RecFlag -> Bool
302 isNonRec Recursive = False
303 isNonRec NonRecursive = True
305 boolToRecFlag :: Bool -> RecFlag
306 boolToRecFlag True = Recursive
307 boolToRecFlag False = NonRecursive
309 instance Outputable RecFlag where
310 ppr Recursive = ptext (sLit "Recursive")
311 ppr NonRecursive = ptext (sLit "NonRecursive")
314 %************************************************************************
316 Instance overlap flag
318 %************************************************************************
322 = NoOverlap -- This instance must not overlap another
324 | OverlapOk -- Silently ignore this instance if you find a
325 -- more specific one that matches the constraint
326 -- you are trying to resolve
328 -- Example: constraint (Foo [Int])
329 -- instances (Foo [Int])
331 -- (Foo [a]) OverlapOk
332 -- Since the second instance has the OverlapOk flag,
333 -- the first instance will be chosen (otherwise
334 -- its ambiguous which to choose)
336 | Incoherent -- Like OverlapOk, but also ignore this instance
337 -- if it doesn't match the constraint you are
338 -- trying to resolve, but could match if the type variables
339 -- in the constraint were instantiated
341 -- Example: constraint (Foo [b])
342 -- instances (Foo [Int]) Incoherent
344 -- Without the Incoherent flag, we'd complain that
345 -- instantiating 'b' would change which instance
349 instance Outputable OverlapFlag where
350 ppr NoOverlap = empty
351 ppr OverlapOk = ptext (sLit "[overlap ok]")
352 ppr Incoherent = ptext (sLit "[incoherent]")
356 %************************************************************************
360 %************************************************************************
363 data TupCon = TupCon Boxity Arity
365 instance Eq TupCon where
366 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
368 tupleParens :: Boxity -> SDoc -> SDoc
369 tupleParens Boxed p = parens p
370 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
373 %************************************************************************
375 \subsection[Generic]{Generic flag}
377 %************************************************************************
379 This is the "Embedding-Projection pair" datatype, it contains
380 two pieces of code (normally either RenamedExpr's or Id's)
381 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
382 represents functions of type
391 T and Tring are arbitrary, but typically T is the 'main' type while
392 Tring is the 'representation' type. (This just helps us remember
393 whether to use 'from' or 'to'.
396 data EP a = EP { fromEP :: a, -- :: T -> Tring
397 toEP :: a } -- :: Tring -> T
400 Embedding-projection pairs are used in several places:
402 First of all, each type constructor has an EP associated with it, the
403 code in EP converts (datatype T) from T to Tring and back again.
405 Secondly, when we are filling in Generic methods (in the typechecker,
406 tcMethodBinds), we are constructing bimaps by induction on the structure
407 of the type of the method signature.
410 %************************************************************************
412 \subsection{Occurrence information}
414 %************************************************************************
416 This data type is used exclusively by the simplifier, but it appears in a
417 SubstResult, which is currently defined in VarEnv, which is pretty near
418 the base of the module hierarchy. So it seemed simpler to put the
419 defn of OccInfo here, safely at the bottom
422 -- | Identifier occurrence information
424 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
426 | IAmDead -- ^ Marks unused variables. Sometimes useful for
427 -- lambda and case-bound variables.
432 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
434 -- | This identifier breaks a loop of mutually recursive functions. The field
435 -- marks whether it is only a loop breaker due to a reference in a rule
436 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
437 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
438 -- See OccurAnal Note [Weak loop breakers]
440 type RulesOnly = Bool
443 Note [LoopBreaker OccInfo]
444 ~~~~~~~~~~~~~~~~~~~~~~~~~~
445 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
446 analyser in two ways:
447 (a) to mark loop-breakers in a group of recursive
448 definitions (hence the name)
449 (b) to mark binders that must not be inlined in this phase
450 (perhaps it has a NOINLINE pragma)
451 Things with (IAmLoopBreaker False) do not get an unfolding
452 pinned on to them, so they are completely opaque.
454 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
458 isNoOcc :: OccInfo -> Bool
459 isNoOcc NoOccInfo = True
462 seqOccInfo :: OccInfo -> ()
463 seqOccInfo occ = occ `seq` ()
466 type InterestingCxt = Bool -- True <=> Function: is applied
467 -- Data value: scrutinised by a case with
468 -- at least one non-DEFAULT branch
471 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
472 -- Substituting a redex for this occurrence is
473 -- dangerous because it might duplicate work.
474 insideLam, notInsideLam :: InsideLam
479 type OneBranch = Bool -- True <=> Occurs in only one case branch
480 -- so no code-duplication issue to worry about
481 oneBranch, notOneBranch :: OneBranch
485 isLoopBreaker :: OccInfo -> Bool
486 isLoopBreaker (IAmALoopBreaker _) = True
487 isLoopBreaker _ = False
489 isNonRuleLoopBreaker :: OccInfo -> Bool
490 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
491 isNonRuleLoopBreaker _ = False
493 nonRuleLoopBreaker :: OccInfo
494 nonRuleLoopBreaker = IAmALoopBreaker False
496 isDeadOcc :: OccInfo -> Bool
497 isDeadOcc IAmDead = True
500 isOneOcc :: OccInfo -> Bool
501 isOneOcc (OneOcc {}) = True
504 zapFragileOcc :: OccInfo -> OccInfo
505 zapFragileOcc (OneOcc {}) = NoOccInfo
506 zapFragileOcc occ = occ
510 instance Outputable OccInfo where
511 -- only used for debugging; never parsed. KSW 1999-07
512 ppr NoOccInfo = empty
513 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
514 ppr IAmDead = ptext (sLit "Dead")
515 ppr (OneOcc inside_lam one_branch int_cxt)
516 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
518 pp_lam | inside_lam = char 'L'
520 pp_br | one_branch = empty
521 | otherwise = char '*'
522 pp_args | int_cxt = char '!'
525 instance Show OccInfo where
526 showsPrec p occ = showsPrecSDoc p (ppr occ)
529 %************************************************************************
531 Strictness indication
533 %************************************************************************
535 The strictness annotations on types in data type declarations
536 e.g. data T = MkT !Int !(Bool,Bool)
539 -------------------------
540 -- HsBang describes what the *programmer* wrote
541 -- This info is retained in the DataCon.dcStrictMarks field
542 data HsBang = HsNoBang
546 | HsUnpack -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
548 | HsUnpackFailed -- An UNPACK pragma that we could not make
549 -- use of, because the type isn't unboxable;
550 -- equivalant to HsStrict except for checkValidDataCon
551 deriving (Eq, Data, Typeable)
553 instance Outputable HsBang where
555 ppr HsStrict = char '!'
556 ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
557 ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
559 isBanged :: HsBang -> Bool
560 isBanged HsNoBang = False
563 isMarkedUnboxed :: HsBang -> Bool
564 isMarkedUnboxed HsUnpack = True
565 isMarkedUnboxed _ = False
567 -------------------------
568 -- StrictnessMark is internal only, used to indicate strictness
569 -- of the DataCon *worker* fields
570 data StrictnessMark = MarkedStrict | NotMarkedStrict
572 instance Outputable StrictnessMark where
573 ppr MarkedStrict = ptext (sLit "!")
574 ppr NotMarkedStrict = empty
576 isMarkedStrict :: StrictnessMark -> Bool
577 isMarkedStrict NotMarkedStrict = False
578 isMarkedStrict _ = True -- All others are strict
582 %************************************************************************
584 Default method specfication
586 %************************************************************************
588 The DefMethSpec enumeration just indicates what sort of default method
589 is used for a class. It is generated from source code, and present in
590 interface files; it is converted to Class.DefMeth before begin put in a
594 data DefMethSpec = NoDM -- No default method
595 | VanillaDM -- Default method given with polymorphic code
596 | GenericDM -- Default method given with generic code
598 instance Outputable DefMethSpec where
600 ppr VanillaDM = ptext (sLit "{- Has default method -}")
601 ppr GenericDM = ptext (sLit "{- Has generic default method -}")
604 %************************************************************************
606 \subsection{Success flag}
608 %************************************************************************
611 data SuccessFlag = Succeeded | Failed
613 instance Outputable SuccessFlag where
614 ppr Succeeded = ptext (sLit "Succeeded")
615 ppr Failed = ptext (sLit "Failed")
617 successIf :: Bool -> SuccessFlag
618 successIf True = Succeeded
619 successIf False = Failed
621 succeeded, failed :: SuccessFlag -> Bool
622 succeeded Succeeded = True
623 succeeded Failed = False
625 failed Succeeded = False
630 %************************************************************************
632 \subsection{Activation}
634 %************************************************************************
636 When a rule or inlining is active
639 type CompilerPhase = Int -- Compilation phase
640 -- Phases decrease towards zero
641 -- Zero is the last phase
643 data Activation = NeverActive
645 | ActiveBefore CompilerPhase -- Active only *before* this phase
646 | ActiveAfter CompilerPhase -- Active in this phase and later
647 deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
649 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
651 deriving( Eq, Data, Typeable, Show )
652 -- Show needed for Lexer.x
654 data InlinePragma -- Note [InlinePragma]
656 { inl_inline :: InlineSpec
658 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
659 -- explicit (non-type, non-dictionary) args
660 -- That is, inl_sat describes the number of *source-code*
661 -- arguments the thing must be applied to. We add on the
662 -- number of implicit, dictionary arguments when making
663 -- the InlineRule, and don't look at inl_sat further
665 , inl_act :: Activation -- Says during which phases inlining is allowed
667 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
668 } deriving( Eq, Data, Typeable )
670 data InlineSpec -- What the user's INLINE pragama looked like
675 deriving( Eq, Data, Typeable, Show )
676 -- Show needed for Lexer.x
681 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
684 If you write nothing at all, you get defaultInlinePragma:
686 inl_act = AlwaysActive
689 It's not possible to get that combination by *writing* something, so
690 if an Id has defaultInlinePragma it means the user didn't specify anything.
692 If inl_inline = True, then the Id should have an InlineRule unfolding.
694 Note [CONLIKE pragma]
695 ~~~~~~~~~~~~~~~~~~~~~
696 The ConLike constructor of a RuleMatchInfo is aimed at the following.
698 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
699 g b bs = let x = b:bs in ..x...x...(r x)...
700 Now, the rule applies to the (r x) term, because GHC "looks through"
701 the definition of 'x' to see that it is (b:bs).
704 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
705 g v = let x = f v in ..x...x...(r x)...
706 Normally the (r x) would *not* match the rule, because GHC would be
707 scared about duplicating the redex (f v), so it does not "look
708 through" the bindings.
710 However the CONLIKE modifier says to treat 'f' like a constructor in
711 this situation, and "look through" the unfolding for x. So (r x)
712 fires, yielding (f (v+1)).
714 This is all controlled with a user-visible pragma:
715 {-# NOINLINE CONLIKE [1] f #-}
717 The main effects of CONLIKE are:
719 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
720 CONLIKE thing like constructors, by ANF-ing them
722 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
723 additionally spots applications of CONLIKE functions
725 - A CoreUnfolding has a field that caches exprIsExpandable
727 - The rule matcher consults this field. See
728 Note [Expanding variables] in Rules.lhs.
731 isConLike :: RuleMatchInfo -> Bool
732 isConLike ConLike = True
735 isFunLike :: RuleMatchInfo -> Bool
736 isFunLike FunLike = True
739 isInlineSpec :: InlineSpec -> Bool
740 isInlineSpec Inline = True
741 isInlineSpec Inlinable = True
742 isInlineSpec _ = False
744 isEmptyInlineSpec :: InlineSpec -> Bool
745 isEmptyInlineSpec EmptyInlineSpec = True
746 isEmptyInlineSpec _ = False
748 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
750 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
752 , inl_inline = EmptyInlineSpec
753 , inl_sat = Nothing }
755 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
756 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
758 inlinePragmaSpec :: InlinePragma -> InlineSpec
759 inlinePragmaSpec = inl_inline
761 -- A DFun has an always-active inline activation so that
762 -- exprIsConApp_maybe can "see" its unfolding
763 -- (However, its actual Unfolding is a DFunUnfolding, which is
764 -- never inlined other than via exprIsConApp_maybe.)
765 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
766 , inl_rule = ConLike }
768 isDefaultInlinePragma :: InlinePragma -> Bool
769 isDefaultInlinePragma (InlinePragma { inl_act = activation
770 , inl_rule = match_info
771 , inl_inline = inline })
772 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
774 isInlinePragma :: InlinePragma -> Bool
775 isInlinePragma prag = isInlineSpec (inl_inline prag)
777 isInlinablePragma :: InlinePragma -> Bool
778 isInlinablePragma prag = case inl_inline prag of
782 inlinePragmaSat :: InlinePragma -> Maybe Arity
783 inlinePragmaSat = inl_sat
785 inlinePragmaActivation :: InlinePragma -> Activation
786 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
788 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
789 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
791 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
792 setInlinePragmaActivation prag activation = prag { inl_act = activation }
794 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
795 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
797 instance Outputable Activation where
798 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
799 ppr NeverActive = brackets (ptext (sLit "NEVER"))
800 ppr (ActiveBefore n) = brackets (char '~' <> int n)
801 ppr (ActiveAfter n) = brackets (int n)
803 instance Outputable RuleMatchInfo where
804 ppr ConLike = ptext (sLit "CONLIKE")
805 ppr FunLike = ptext (sLit "FUNLIKE")
807 instance Outputable InlineSpec where
808 ppr Inline = ptext (sLit "INLINE")
809 ppr NoInline = ptext (sLit "NOINLINE")
810 ppr Inlinable = ptext (sLit "INLINABLE")
811 ppr EmptyInlineSpec = empty
813 instance Outputable InlinePragma where
814 ppr (InlinePragma { inl_inline = inline, inl_act = activation
815 , inl_rule = info, inl_sat = mb_arity })
816 = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
818 pp_act Inline AlwaysActive = empty
819 pp_act NoInline NeverActive = empty
820 pp_act _ act = ppr act
822 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
824 pp_info | isFunLike info = empty
825 | otherwise = ppr info
827 isActive :: CompilerPhase -> Activation -> Bool
828 isActive _ NeverActive = False
829 isActive _ AlwaysActive = True
830 isActive p (ActiveAfter n) = p <= n
831 isActive p (ActiveBefore n) = p > n
833 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
834 isNeverActive NeverActive = True
835 isNeverActive _ = False
837 isAlwaysActive AlwaysActive = True
838 isAlwaysActive _ = False
840 isEarlyActive AlwaysActive = True
841 isEarlyActive (ActiveBefore {}) = True
842 isEarlyActive _ = False