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,
69 isInlinePragma, isInlinablePragma, isAnyInlinePragma,
70 inlinePragmaSpec, inlinePragmaSat,
71 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
72 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
74 SuccessFlag(..), succeeded, failed, successIf
80 import Data.Data hiding (Fixity)
83 %************************************************************************
85 \subsection[Arity]{Arity}
87 %************************************************************************
93 %************************************************************************
95 \subsection[FunctionOrData]{FunctionOrData}
97 %************************************************************************
100 data FunctionOrData = IsFunction | IsData
101 deriving (Eq, Ord, Data, Typeable)
103 instance Outputable FunctionOrData where
104 ppr IsFunction = text "(function)"
105 ppr IsData = text "(data)"
109 %************************************************************************
111 \subsection[Version]{Module and identifier version numbers}
113 %************************************************************************
118 bumpVersion :: Version -> Version
121 initialVersion :: Version
125 %************************************************************************
129 %************************************************************************
133 -- reason/explanation from a WARNING or DEPRECATED pragma
134 data WarningTxt = WarningTxt [FastString]
135 | DeprecatedTxt [FastString]
136 deriving (Eq, Data, Typeable)
138 instance Outputable WarningTxt where
139 ppr (WarningTxt ws) = doubleQuotes (vcat (map ftext ws))
140 ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
141 doubleQuotes (vcat (map ftext ds))
144 %************************************************************************
146 \subsection{Implicit parameter identity}
148 %************************************************************************
150 The @IPName@ type is here because it is used in TypeRep (i.e. very
151 early in the hierarchy), but also in HsSyn.
154 newtype IPName name = IPName name -- ?x
155 deriving( Eq, Ord, Data, Typeable )
156 -- Ord is used in the IP name cache finite map
157 -- (used in HscTypes.OrigIParamCache)
159 ipNameName :: IPName name -> name
160 ipNameName (IPName n) = n
162 mapIPName :: (a->b) -> IPName a -> IPName b
163 mapIPName f (IPName n) = IPName (f n)
165 instance Outputable name => Outputable (IPName name) where
166 ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
169 %************************************************************************
173 %************************************************************************
176 type RuleName = FastString
179 %************************************************************************
181 \subsection[Fixity]{Fixity info}
183 %************************************************************************
186 ------------------------
187 data Fixity = Fixity Int FixityDirection
188 deriving (Data, Typeable)
190 instance Outputable Fixity where
191 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
193 instance Eq Fixity where -- Used to determine if two fixities conflict
194 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
196 ------------------------
197 data FixityDirection = InfixL | InfixR | InfixN
198 deriving (Eq, Data, Typeable)
200 instance Outputable FixityDirection where
201 ppr InfixL = ptext (sLit "infixl")
202 ppr InfixR = ptext (sLit "infixr")
203 ppr InfixN = ptext (sLit "infix")
205 ------------------------
208 defaultFixity :: Fixity
209 defaultFixity = Fixity maxPrecedence InfixL
211 negateFixity, funTyFixity :: Fixity
213 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
214 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
222 @(compareFixity op1 op2)@ tells which way to arrange appication, or
223 whether there's an error.
226 compareFixity :: Fixity -> Fixity
227 -> (Bool, -- Error please
228 Bool) -- Associate to the right: a op1 (b op2 c)
229 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
230 = case prec1 `compare` prec2 of
233 EQ -> case (dir1, dir2) of
234 (InfixR, InfixR) -> right
235 (InfixL, InfixL) -> left
238 right = (False, True)
239 left = (False, False)
240 error_please = (True, False)
244 %************************************************************************
246 \subsection[Top-level/local]{Top-level/not-top level flag}
248 %************************************************************************
255 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
257 isNotTopLevel NotTopLevel = True
258 isNotTopLevel TopLevel = False
260 isTopLevel TopLevel = True
261 isTopLevel NotTopLevel = False
263 instance Outputable TopLevelFlag where
264 ppr TopLevel = ptext (sLit "<TopLevel>")
265 ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
269 %************************************************************************
271 Top-level/not-top level flag
273 %************************************************************************
279 deriving( Eq, Data, Typeable )
281 isBoxed :: Boxity -> Bool
283 isBoxed Unboxed = False
287 %************************************************************************
289 Recursive/Non-Recursive flag
291 %************************************************************************
294 data RecFlag = Recursive
296 deriving( Eq, Data, Typeable )
298 isRec :: RecFlag -> Bool
299 isRec Recursive = True
300 isRec NonRecursive = False
302 isNonRec :: RecFlag -> Bool
303 isNonRec Recursive = False
304 isNonRec NonRecursive = True
306 boolToRecFlag :: Bool -> RecFlag
307 boolToRecFlag True = Recursive
308 boolToRecFlag False = NonRecursive
310 instance Outputable RecFlag where
311 ppr Recursive = ptext (sLit "Recursive")
312 ppr NonRecursive = ptext (sLit "NonRecursive")
315 %************************************************************************
317 Instance overlap flag
319 %************************************************************************
323 = NoOverlap -- This instance must not overlap another
325 | OverlapOk -- Silently ignore this instance if you find a
326 -- more specific one that matches the constraint
327 -- you are trying to resolve
329 -- Example: constraint (Foo [Int])
330 -- instances (Foo [Int])
332 -- (Foo [a]) OverlapOk
333 -- Since the second instance has the OverlapOk flag,
334 -- the first instance will be chosen (otherwise
335 -- its ambiguous which to choose)
337 | Incoherent -- Like OverlapOk, but also ignore this instance
338 -- if it doesn't match the constraint you are
339 -- trying to resolve, but could match if the type variables
340 -- in the constraint were instantiated
342 -- Example: constraint (Foo [b])
343 -- instances (Foo [Int]) Incoherent
345 -- Without the Incoherent flag, we'd complain that
346 -- instantiating 'b' would change which instance
350 instance Outputable OverlapFlag where
351 ppr NoOverlap = empty
352 ppr OverlapOk = ptext (sLit "[overlap ok]")
353 ppr Incoherent = ptext (sLit "[incoherent]")
357 %************************************************************************
361 %************************************************************************
364 data TupCon = TupCon Boxity Arity
366 instance Eq TupCon where
367 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
369 tupleParens :: Boxity -> SDoc -> SDoc
370 tupleParens Boxed p = parens p
371 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
374 %************************************************************************
376 \subsection[Generic]{Generic flag}
378 %************************************************************************
380 This is the "Embedding-Projection pair" datatype, it contains
381 two pieces of code (normally either RenamedExpr's or Id's)
382 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
383 represents functions of type
392 T and Tring are arbitrary, but typically T is the 'main' type while
393 Tring is the 'representation' type. (This just helps us remember
394 whether to use 'from' or 'to'.
397 data EP a = EP { fromEP :: a, -- :: T -> Tring
398 toEP :: a } -- :: Tring -> T
401 Embedding-projection pairs are used in several places:
403 First of all, each type constructor has an EP associated with it, the
404 code in EP converts (datatype T) from T to Tring and back again.
406 Secondly, when we are filling in Generic methods (in the typechecker,
407 tcMethodBinds), we are constructing bimaps by induction on the structure
408 of the type of the method signature.
411 %************************************************************************
413 \subsection{Occurrence information}
415 %************************************************************************
417 This data type is used exclusively by the simplifier, but it appears in a
418 SubstResult, which is currently defined in VarEnv, which is pretty near
419 the base of the module hierarchy. So it seemed simpler to put the
420 defn of OccInfo here, safely at the bottom
423 -- | Identifier occurrence information
425 = NoOccInfo -- ^ There are many occurrences, or unknown occurences
427 | IAmDead -- ^ Marks unused variables. Sometimes useful for
428 -- lambda and case-bound variables.
433 !InterestingCxt -- ^ Occurs exactly once, not inside a rule
435 -- | This identifier breaks a loop of mutually recursive functions. The field
436 -- marks whether it is only a loop breaker due to a reference in a rule
437 | IAmALoopBreaker -- Note [LoopBreaker OccInfo]
438 !RulesOnly -- True <=> This is a weak or rules-only loop breaker
439 -- See OccurAnal Note [Weak loop breakers]
441 type RulesOnly = Bool
444 Note [LoopBreaker OccInfo]
445 ~~~~~~~~~~~~~~~~~~~~~~~~~~
446 An OccInfo of (IAmLoopBreaker False) is used by the occurrence
447 analyser in two ways:
448 (a) to mark loop-breakers in a group of recursive
449 definitions (hence the name)
450 (b) to mark binders that must not be inlined in this phase
451 (perhaps it has a NOINLINE pragma)
452 Things with (IAmLoopBreaker False) do not get an unfolding
453 pinned on to them, so they are completely opaque.
455 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
459 isNoOcc :: OccInfo -> Bool
460 isNoOcc NoOccInfo = True
463 seqOccInfo :: OccInfo -> ()
464 seqOccInfo occ = occ `seq` ()
467 type InterestingCxt = Bool -- True <=> Function: is applied
468 -- Data value: scrutinised by a case with
469 -- at least one non-DEFAULT branch
472 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
473 -- Substituting a redex for this occurrence is
474 -- dangerous because it might duplicate work.
475 insideLam, notInsideLam :: InsideLam
480 type OneBranch = Bool -- True <=> Occurs in only one case branch
481 -- so no code-duplication issue to worry about
482 oneBranch, notOneBranch :: OneBranch
486 isLoopBreaker :: OccInfo -> Bool
487 isLoopBreaker (IAmALoopBreaker _) = True
488 isLoopBreaker _ = False
490 isNonRuleLoopBreaker :: OccInfo -> Bool
491 isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
492 isNonRuleLoopBreaker _ = False
494 nonRuleLoopBreaker :: OccInfo
495 nonRuleLoopBreaker = IAmALoopBreaker False
497 isDeadOcc :: OccInfo -> Bool
498 isDeadOcc IAmDead = True
501 isOneOcc :: OccInfo -> Bool
502 isOneOcc (OneOcc {}) = True
505 zapFragileOcc :: OccInfo -> OccInfo
506 zapFragileOcc (OneOcc {}) = NoOccInfo
507 zapFragileOcc occ = occ
511 instance Outputable OccInfo where
512 -- only used for debugging; never parsed. KSW 1999-07
513 ppr NoOccInfo = empty
514 ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
515 ppr IAmDead = ptext (sLit "Dead")
516 ppr (OneOcc inside_lam one_branch int_cxt)
517 = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
519 pp_lam | inside_lam = char 'L'
521 pp_br | one_branch = empty
522 | otherwise = char '*'
523 pp_args | int_cxt = char '!'
526 instance Show OccInfo where
527 showsPrec p occ = showsPrecSDoc p (ppr occ)
530 %************************************************************************
532 Strictness indication
534 %************************************************************************
536 The strictness annotations on types in data type declarations
537 e.g. data T = MkT !Int !(Bool,Bool)
540 -------------------------
541 -- HsBang describes what the *programmer* wrote
542 -- This info is retained in the DataCon.dcStrictMarks field
543 data HsBang = HsNoBang
547 | HsUnpack -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
549 | HsUnpackFailed -- An UNPACK pragma that we could not make
550 -- use of, because the type isn't unboxable;
551 -- equivalant to HsStrict except for checkValidDataCon
552 deriving (Eq, Data, Typeable)
554 instance Outputable HsBang where
556 ppr HsStrict = char '!'
557 ppr HsUnpack = ptext (sLit "{-# UNPACK #-} !")
558 ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
560 isBanged :: HsBang -> Bool
561 isBanged HsNoBang = False
564 isMarkedUnboxed :: HsBang -> Bool
565 isMarkedUnboxed HsUnpack = True
566 isMarkedUnboxed _ = False
568 -------------------------
569 -- StrictnessMark is internal only, used to indicate strictness
570 -- of the DataCon *worker* fields
571 data StrictnessMark = MarkedStrict | NotMarkedStrict
573 instance Outputable StrictnessMark where
574 ppr MarkedStrict = ptext (sLit "!")
575 ppr NotMarkedStrict = empty
577 isMarkedStrict :: StrictnessMark -> Bool
578 isMarkedStrict NotMarkedStrict = False
579 isMarkedStrict _ = True -- All others are strict
583 %************************************************************************
585 Default method specfication
587 %************************************************************************
589 The DefMethSpec enumeration just indicates what sort of default method
590 is used for a class. It is generated from source code, and present in
591 interface files; it is converted to Class.DefMeth before begin put in a
595 data DefMethSpec = NoDM -- No default method
596 | VanillaDM -- Default method given with polymorphic code
597 | GenericDM -- Default method given with generic code
599 instance Outputable DefMethSpec where
601 ppr VanillaDM = ptext (sLit "{- Has default method -}")
602 ppr GenericDM = ptext (sLit "{- Has generic default method -}")
605 %************************************************************************
607 \subsection{Success flag}
609 %************************************************************************
612 data SuccessFlag = Succeeded | Failed
614 instance Outputable SuccessFlag where
615 ppr Succeeded = ptext (sLit "Succeeded")
616 ppr Failed = ptext (sLit "Failed")
618 successIf :: Bool -> SuccessFlag
619 successIf True = Succeeded
620 successIf False = Failed
622 succeeded, failed :: SuccessFlag -> Bool
623 succeeded Succeeded = True
624 succeeded Failed = False
626 failed Succeeded = False
631 %************************************************************************
633 \subsection{Activation}
635 %************************************************************************
637 When a rule or inlining is active
640 type CompilerPhase = Int -- Compilation phase
641 -- Phases decrease towards zero
642 -- Zero is the last phase
644 data Activation = NeverActive
646 | ActiveBefore CompilerPhase -- Active only *before* this phase
647 | ActiveAfter CompilerPhase -- Active in this phase and later
648 deriving( Eq, Data, Typeable ) -- Eq used in comparing rules in HsDecls
650 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
652 deriving( Eq, Data, Typeable, Show )
653 -- Show needed for Lexer.x
655 data InlinePragma -- Note [InlinePragma]
657 { inl_inline :: InlineSpec
659 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
660 -- explicit (non-type, non-dictionary) args
661 -- That is, inl_sat describes the number of *source-code*
662 -- arguments the thing must be applied to. We add on the
663 -- number of implicit, dictionary arguments when making
664 -- the InlineRule, and don't look at inl_sat further
666 , inl_act :: Activation -- Says during which phases inlining is allowed
668 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
669 } deriving( Eq, Data, Typeable )
671 data InlineSpec -- What the user's INLINE pragama looked like
676 deriving( Eq, Data, Typeable, Show )
677 -- Show needed for Lexer.x
682 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
685 If you write nothing at all, you get defaultInlinePragma:
687 inl_act = AlwaysActive
690 It's not possible to get that combination by *writing* something, so
691 if an Id has defaultInlinePragma it means the user didn't specify anything.
693 If inl_inline = True, then the Id should have an InlineRule unfolding.
695 Note [CONLIKE pragma]
696 ~~~~~~~~~~~~~~~~~~~~~
697 The ConLike constructor of a RuleMatchInfo is aimed at the following.
699 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
700 g b bs = let x = b:bs in ..x...x...(r x)...
701 Now, the rule applies to the (r x) term, because GHC "looks through"
702 the definition of 'x' to see that it is (b:bs).
705 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
706 g v = let x = f v in ..x...x...(r x)...
707 Normally the (r x) would *not* match the rule, because GHC would be
708 scared about duplicating the redex (f v), so it does not "look
709 through" the bindings.
711 However the CONLIKE modifier says to treat 'f' like a constructor in
712 this situation, and "look through" the unfolding for x. So (r x)
713 fires, yielding (f (v+1)).
715 This is all controlled with a user-visible pragma:
716 {-# NOINLINE CONLIKE [1] f #-}
718 The main effects of CONLIKE are:
720 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
721 CONLIKE thing like constructors, by ANF-ing them
723 - New function coreUtils.exprIsExpandable is like exprIsCheap, but
724 additionally spots applications of CONLIKE functions
726 - A CoreUnfolding has a field that caches exprIsExpandable
728 - The rule matcher consults this field. See
729 Note [Expanding variables] in Rules.lhs.
732 isConLike :: RuleMatchInfo -> Bool
733 isConLike ConLike = True
736 isFunLike :: RuleMatchInfo -> Bool
737 isFunLike FunLike = True
740 isEmptyInlineSpec :: InlineSpec -> Bool
741 isEmptyInlineSpec EmptyInlineSpec = True
742 isEmptyInlineSpec _ = False
744 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
746 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
748 , inl_inline = EmptyInlineSpec
749 , inl_sat = Nothing }
751 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
752 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
754 inlinePragmaSpec :: InlinePragma -> InlineSpec
755 inlinePragmaSpec = inl_inline
757 -- A DFun has an always-active inline activation so that
758 -- exprIsConApp_maybe can "see" its unfolding
759 -- (However, its actual Unfolding is a DFunUnfolding, which is
760 -- never inlined other than via exprIsConApp_maybe.)
761 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
762 , inl_rule = ConLike }
764 isDefaultInlinePragma :: InlinePragma -> Bool
765 isDefaultInlinePragma (InlinePragma { inl_act = activation
766 , inl_rule = match_info
767 , inl_inline = inline })
768 = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
770 isInlinePragma :: InlinePragma -> Bool
771 isInlinePragma prag = case inl_inline prag of
775 isInlinablePragma :: InlinePragma -> Bool
776 isInlinablePragma prag = case inl_inline prag of
780 isAnyInlinePragma :: InlinePragma -> Bool
781 -- INLINE or INLINABLE
782 isAnyInlinePragma prag = case inl_inline prag of
787 inlinePragmaSat :: InlinePragma -> Maybe Arity
788 inlinePragmaSat = inl_sat
790 inlinePragmaActivation :: InlinePragma -> Activation
791 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
793 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
794 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
796 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
797 setInlinePragmaActivation prag activation = prag { inl_act = activation }
799 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
800 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
802 instance Outputable Activation where
803 ppr AlwaysActive = brackets (ptext (sLit "ALWAYS"))
804 ppr NeverActive = brackets (ptext (sLit "NEVER"))
805 ppr (ActiveBefore n) = brackets (char '~' <> int n)
806 ppr (ActiveAfter n) = brackets (int n)
808 instance Outputable RuleMatchInfo where
809 ppr ConLike = ptext (sLit "CONLIKE")
810 ppr FunLike = ptext (sLit "FUNLIKE")
812 instance Outputable InlineSpec where
813 ppr Inline = ptext (sLit "INLINE")
814 ppr NoInline = ptext (sLit "NOINLINE")
815 ppr Inlinable = ptext (sLit "INLINABLE")
816 ppr EmptyInlineSpec = empty
818 instance Outputable InlinePragma where
819 ppr (InlinePragma { inl_inline = inline, inl_act = activation
820 , inl_rule = info, inl_sat = mb_arity })
821 = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
823 pp_act Inline AlwaysActive = empty
824 pp_act NoInline NeverActive = empty
825 pp_act _ act = ppr act
827 pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
829 pp_info | isFunLike info = empty
830 | otherwise = ppr info
832 isActive :: CompilerPhase -> Activation -> Bool
833 isActive _ NeverActive = False
834 isActive _ AlwaysActive = True
835 isActive p (ActiveAfter n) = p <= n
836 isActive p (ActiveBefore n) = p > n
838 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
839 isNeverActive NeverActive = True
840 isNeverActive _ = False
842 isAlwaysActive AlwaysActive = True
843 isAlwaysActive _ = False
845 isEarlyActive AlwaysActive = True
846 isEarlyActive (ActiveBefore {}) = True
847 isEarlyActive _ = False