Implement auto-specialisation of imported Ids
[ghc.git] / compiler / basicTypes / BasicTypes.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4 %
5 \section[BasicTypes]{Miscellanous types}
6
7 This module defines a miscellaneously collection of very simple
8 types that
9
10 \begin{itemize}
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
14 \end{itemize}
15
16 \begin{code}
17 {-# LANGUAGE DeriveDataTypeable #-}
18
19 module BasicTypes(
20         Version, bumpVersion, initialVersion,
21
22         Arity, 
23
24         FunctionOrData(..),
25         
26         WarningTxt(..),
27
28         Fixity(..), FixityDirection(..),
29         defaultFixity, maxPrecedence, 
30         negateFixity, funTyFixity,
31         compareFixity,
32
33         IPName(..), ipNameName, mapIPName,
34
35         RecFlag(..), isRec, isNonRec, boolToRecFlag,
36
37         RuleName,
38
39         TopLevelFlag(..), isTopLevel, isNotTopLevel,
40
41         OverlapFlag(..), 
42
43         Boxity(..), isBoxed, 
44
45         TupCon(..), tupleParens,
46
47         OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc, 
48         isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
49         nonRuleLoopBreaker,
50
51         InsideLam, insideLam, notInsideLam,
52         OneBranch, oneBranch, notOneBranch,
53         InterestingCxt,
54
55         EP(..),
56
57         HsBang(..), isBanged, isMarkedUnboxed, 
58         StrictnessMark(..), isMarkedStrict,
59
60         DefMethSpec(..),
61
62         CompilerPhase, 
63         Activation(..), isActive, isNeverActive, isAlwaysActive, isEarlyActive,
64         RuleMatchInfo(..), isConLike, isFunLike, 
65         InlineSpec(..), 
66         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, 
67         neverInlinePragma, dfunInlinePragma, 
68         isDefaultInlinePragma, isInlinePragma, isInlinablePragma,
69         inlinePragmaSpec, inlinePragmaSat,
70         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
71         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
72
73         SuccessFlag(..), succeeded, failed, successIf
74    ) where
75
76 import FastString
77 import Outputable
78
79 import Data.Data hiding (Fixity)
80 \end{code}
81
82 %************************************************************************
83 %*                                                                      *
84 \subsection[Arity]{Arity}
85 %*                                                                      *
86 %************************************************************************
87
88 \begin{code}
89 type Arity = Int
90 \end{code}
91
92 %************************************************************************
93 %*                                                                      *
94 \subsection[FunctionOrData]{FunctionOrData}
95 %*                                                                      *
96 %************************************************************************
97
98 \begin{code}
99 data FunctionOrData = IsFunction | IsData
100     deriving (Eq, Ord, Data, Typeable)
101
102 instance Outputable FunctionOrData where
103     ppr IsFunction = text "(function)"
104     ppr IsData     = text "(data)"
105 \end{code}
106
107
108 %************************************************************************
109 %*                                                                      *
110 \subsection[Version]{Module and identifier version numbers}
111 %*                                                                      *
112 %************************************************************************
113
114 \begin{code}
115 type Version = Int
116
117 bumpVersion :: Version -> Version 
118 bumpVersion v = v+1
119
120 initialVersion :: Version
121 initialVersion = 1
122 \end{code}
123
124 %************************************************************************
125 %*                                                                      *
126                 Deprecations
127 %*                                                                      *
128 %************************************************************************
129
130
131 \begin{code}
132 -- reason/explanation from a WARNING or DEPRECATED pragma
133 data WarningTxt = WarningTxt [FastString]
134                 | DeprecatedTxt [FastString]
135     deriving (Eq, Data, Typeable)
136
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))
141 \end{code}
142
143 %************************************************************************
144 %*                                                                      *
145 \subsection{Implicit parameter identity}
146 %*                                                                      *
147 %************************************************************************
148
149 The @IPName@ type is here because it is used in TypeRep (i.e. very
150 early in the hierarchy), but also in HsSyn.
151
152 \begin{code}
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)
157
158 ipNameName :: IPName name -> name
159 ipNameName (IPName n) = n
160
161 mapIPName :: (a->b) -> IPName a -> IPName b
162 mapIPName f (IPName n) = IPName (f n)
163
164 instance Outputable name => Outputable (IPName name) where
165     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
166 \end{code}
167
168 %************************************************************************
169 %*                                                                      *
170                 Rules
171 %*                                                                      *
172 %************************************************************************
173
174 \begin{code}
175 type RuleName = FastString
176 \end{code}
177
178 %************************************************************************
179 %*                                                                      *
180 \subsection[Fixity]{Fixity info}
181 %*                                                                      *
182 %************************************************************************
183
184 \begin{code}
185 ------------------------
186 data Fixity = Fixity Int FixityDirection
187   deriving (Data, Typeable)
188
189 instance Outputable Fixity where
190     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
191
192 instance Eq Fixity where                -- Used to determine if two fixities conflict
193   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
194
195 ------------------------
196 data FixityDirection = InfixL | InfixR | InfixN 
197                      deriving (Eq, Data, Typeable)
198
199 instance Outputable FixityDirection where
200     ppr InfixL = ptext (sLit "infixl")
201     ppr InfixR = ptext (sLit "infixr")
202     ppr InfixN = ptext (sLit "infix")
203
204 ------------------------
205 maxPrecedence :: Int
206 maxPrecedence = 9
207 defaultFixity :: Fixity
208 defaultFixity = Fixity maxPrecedence InfixL
209
210 negateFixity, funTyFixity :: Fixity
211 -- Wired-in fixities
212 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
213 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
214 \end{code}
215
216 Consider
217
218 \begin{verbatim}
219         a `op1` b `op2` c
220 \end{verbatim}
221 @(compareFixity op1 op2)@ tells which way to arrange appication, or
222 whether there's an error.
223
224 \begin{code}
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
230         GT -> left
231         LT -> right
232         EQ -> case (dir1, dir2) of
233                         (InfixR, InfixR) -> right
234                         (InfixL, InfixL) -> left
235                         _                -> error_please
236   where
237     right        = (False, True)
238     left         = (False, False)
239     error_please = (True,  False)
240 \end{code}
241
242
243 %************************************************************************
244 %*                                                                      *
245 \subsection[Top-level/local]{Top-level/not-top level flag}
246 %*                                                                      *
247 %************************************************************************
248
249 \begin{code}
250 data TopLevelFlag
251   = TopLevel
252   | NotTopLevel
253
254 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
255
256 isNotTopLevel NotTopLevel = True
257 isNotTopLevel TopLevel    = False
258
259 isTopLevel TopLevel     = True
260 isTopLevel NotTopLevel  = False
261
262 instance Outputable TopLevelFlag where
263   ppr TopLevel    = ptext (sLit "<TopLevel>")
264   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
265 \end{code}
266
267
268 %************************************************************************
269 %*                                                                      *
270                 Top-level/not-top level flag
271 %*                                                                      *
272 %************************************************************************
273
274 \begin{code}
275 data Boxity
276   = Boxed
277   | Unboxed
278   deriving( Eq, Data, Typeable )
279
280 isBoxed :: Boxity -> Bool
281 isBoxed Boxed   = True
282 isBoxed Unboxed = False
283 \end{code}
284
285
286 %************************************************************************
287 %*                                                                      *
288                 Recursive/Non-Recursive flag
289 %*                                                                      *
290 %************************************************************************
291
292 \begin{code}
293 data RecFlag = Recursive 
294              | NonRecursive
295              deriving( Eq, Data, Typeable )
296
297 isRec :: RecFlag -> Bool
298 isRec Recursive    = True
299 isRec NonRecursive = False
300
301 isNonRec :: RecFlag -> Bool
302 isNonRec Recursive    = False
303 isNonRec NonRecursive = True
304
305 boolToRecFlag :: Bool -> RecFlag
306 boolToRecFlag True  = Recursive
307 boolToRecFlag False = NonRecursive
308
309 instance Outputable RecFlag where
310   ppr Recursive    = ptext (sLit "Recursive")
311   ppr NonRecursive = ptext (sLit "NonRecursive")
312 \end{code}
313
314 %************************************************************************
315 %*                                                                      *
316                 Instance overlap flag
317 %*                                                                      *
318 %************************************************************************
319
320 \begin{code}
321 data OverlapFlag
322   = NoOverlap   -- This instance must not overlap another
323
324   | OverlapOk   -- Silently ignore this instance if you find a 
325                 -- more specific one that matches the constraint
326                 -- you are trying to resolve
327                 --
328                 -- Example: constraint (Foo [Int])
329                 --          instances  (Foo [Int])
330         
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)
335
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
340                 --
341                 -- Example: constraint (Foo [b])
342                 --          instances  (Foo [Int])      Incoherent
343                 --                     (Foo [a])
344                 -- Without the Incoherent flag, we'd complain that
345                 -- instantiating 'b' would change which instance 
346                 -- was chosen
347   deriving( Eq )
348
349 instance Outputable OverlapFlag where
350    ppr NoOverlap  = empty
351    ppr OverlapOk  = ptext (sLit "[overlap ok]")
352    ppr Incoherent = ptext (sLit "[incoherent]")
353
354 \end{code}
355
356 %************************************************************************
357 %*                                                                      *
358                 Tuples
359 %*                                                                      *
360 %************************************************************************
361
362 \begin{code}
363 data TupCon = TupCon Boxity Arity
364
365 instance Eq TupCon where
366   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
367    
368 tupleParens :: Boxity -> SDoc -> SDoc
369 tupleParens Boxed   p = parens p
370 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
371 \end{code}
372
373 %************************************************************************
374 %*                                                                      *
375 \subsection[Generic]{Generic flag}
376 %*                                                                      *
377 %************************************************************************
378
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 
383
384         from :: T -> Tring
385         to   :: Tring -> T
386
387 And we should have 
388
389         to (from x) = x
390
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'.
394
395 \begin{code}
396 data EP a = EP { fromEP :: a,   -- :: T -> Tring
397                  toEP   :: a }  -- :: Tring -> T
398 \end{code}
399
400 Embedding-projection pairs are used in several places:
401
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.
404
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.
408
409
410 %************************************************************************
411 %*                                                                      *
412 \subsection{Occurrence information}
413 %*                                                                      *
414 %************************************************************************
415
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
420
421 \begin{code}
422 -- | Identifier occurrence information
423 data OccInfo 
424   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
425
426   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
427                         -- lambda and case-bound variables.
428
429   | OneOcc
430         !InsideLam
431         !OneBranch
432         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
433
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]
439
440 type RulesOnly = Bool
441 \end{code}
442
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.
453
454 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
455
456
457 \begin{code}
458 isNoOcc :: OccInfo -> Bool
459 isNoOcc NoOccInfo = True
460 isNoOcc _         = False
461
462 seqOccInfo :: OccInfo -> ()
463 seqOccInfo occ = occ `seq` ()
464
465 -----------------
466 type InterestingCxt = Bool      -- True <=> Function: is applied
467                                 --          Data value: scrutinised by a case with
468                                 --                      at least one non-DEFAULT branch
469
470 -----------------
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
475 insideLam    = True
476 notInsideLam = False
477
478 -----------------
479 type OneBranch = Bool   -- True <=> Occurs in only one case branch
480                         --      so no code-duplication issue to worry about
481 oneBranch, notOneBranch :: OneBranch
482 oneBranch    = True
483 notOneBranch = False
484
485 isLoopBreaker :: OccInfo -> Bool
486 isLoopBreaker (IAmALoopBreaker _) = True
487 isLoopBreaker _                   = False
488
489 isNonRuleLoopBreaker :: OccInfo -> Bool
490 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
491 isNonRuleLoopBreaker _                       = False
492
493 nonRuleLoopBreaker :: OccInfo
494 nonRuleLoopBreaker = IAmALoopBreaker False
495
496 isDeadOcc :: OccInfo -> Bool
497 isDeadOcc IAmDead = True
498 isDeadOcc _       = False
499
500 isOneOcc :: OccInfo -> Bool
501 isOneOcc (OneOcc {}) = True
502 isOneOcc _           = False
503
504 zapFragileOcc :: OccInfo -> OccInfo
505 zapFragileOcc (OneOcc {}) = NoOccInfo
506 zapFragileOcc occ         = occ
507 \end{code}
508
509 \begin{code}
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
517         where
518           pp_lam | inside_lam = char 'L'
519                  | otherwise  = empty
520           pp_br  | one_branch = empty
521                  | otherwise  = char '*'
522           pp_args | int_cxt   = char '!'
523                   | otherwise = empty
524
525 instance Show OccInfo where
526   showsPrec p occ = showsPrecSDoc p (ppr occ)
527 \end{code}
528
529 %************************************************************************
530 %*                                                                      *
531                 Strictness indication
532 %*                                                                      *
533 %************************************************************************
534
535 The strictness annotations on types in data type declarations
536 e.g.    data T = MkT !Int !(Bool,Bool)
537
538 \begin{code}
539 -------------------------
540 -- HsBang describes what the *programmer* wrote
541 -- This info is retained in the DataCon.dcStrictMarks field
542 data HsBang = HsNoBang  
543
544             | HsStrict  
545
546             | HsUnpack         -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
547
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)
552
553 instance Outputable HsBang where
554     ppr HsNoBang       = empty
555     ppr HsStrict       = char '!'
556     ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
557     ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
558
559 isBanged :: HsBang -> Bool
560 isBanged HsNoBang = False
561 isBanged _        = True
562
563 isMarkedUnboxed :: HsBang -> Bool
564 isMarkedUnboxed HsUnpack = True
565 isMarkedUnboxed _        = False
566
567 -------------------------
568 -- StrictnessMark is internal only, used to indicate strictness 
569 -- of the DataCon *worker* fields
570 data StrictnessMark = MarkedStrict | NotMarkedStrict    
571
572 instance Outputable StrictnessMark where
573   ppr MarkedStrict     = ptext (sLit "!")
574   ppr NotMarkedStrict  = empty
575
576 isMarkedStrict :: StrictnessMark -> Bool
577 isMarkedStrict NotMarkedStrict = False
578 isMarkedStrict _               = True   -- All others are strict
579 \end{code}
580
581
582 %************************************************************************
583 %*                                                                      *
584                 Default method specfication
585 %*                                                                      *
586 %************************************************************************
587
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 
591 Class object.
592
593 \begin{code}
594 data DefMethSpec = NoDM        -- No default method
595                  | VanillaDM   -- Default method given with polymorphic code
596                  | GenericDM   -- Default method given with generic code
597
598 instance Outputable DefMethSpec where
599   ppr NoDM      = empty
600   ppr VanillaDM = ptext (sLit "{- Has default method -}")
601   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
602 \end{code}
603
604 %************************************************************************
605 %*                                                                      *
606 \subsection{Success flag}
607 %*                                                                      *
608 %************************************************************************
609
610 \begin{code}
611 data SuccessFlag = Succeeded | Failed
612
613 instance Outputable SuccessFlag where
614     ppr Succeeded = ptext (sLit "Succeeded")
615     ppr Failed    = ptext (sLit "Failed")
616
617 successIf :: Bool -> SuccessFlag
618 successIf True  = Succeeded
619 successIf False = Failed
620
621 succeeded, failed :: SuccessFlag -> Bool
622 succeeded Succeeded = True
623 succeeded Failed    = False
624
625 failed Succeeded = False
626 failed Failed    = True
627 \end{code}
628
629
630 %************************************************************************
631 %*                                                                      *
632 \subsection{Activation}
633 %*                                                                      *
634 %************************************************************************
635
636 When a rule or inlining is active
637
638 \begin{code}
639 type CompilerPhase = Int        -- Compilation phase
640                                 -- Phases decrease towards zero
641                                 -- Zero is the last phase
642
643 data Activation = NeverActive
644                 | AlwaysActive
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
648
649 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
650                    | FunLike
651                    deriving( Eq, Data, Typeable, Show )
652         -- Show needed for Lexer.x
653
654 data InlinePragma            -- Note [InlinePragma]
655   = InlinePragma
656       { inl_inline :: InlineSpec
657
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
664
665       , inl_act    :: Activation     -- Says during which phases inlining is allowed
666
667       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
668     } deriving( Eq, Data, Typeable )
669
670 data InlineSpec   -- What the user's INLINE pragama looked like
671   = Inline
672   | Inlinable
673   | NoInline
674   | EmptyInlineSpec
675   deriving( Eq, Data, Typeable, Show )
676         -- Show needed for Lexer.x
677 \end{code}
678
679 Note [InlinePragma]
680 ~~~~~~~~~~~~~~~~~~~
681 This data type mirrors what you can write in an INLINE or NOINLINE pragma in 
682 the source program.
683
684 If you write nothing at all, you get defaultInlinePragma:
685    inl_inline = False
686    inl_act    = AlwaysActive
687    inl_rule   = FunLike
688
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.
691
692 If inl_inline = True, then the Id should have an InlineRule unfolding.
693
694 Note [CONLIKE pragma]
695 ~~~~~~~~~~~~~~~~~~~~~
696 The ConLike constructor of a RuleMatchInfo is aimed at the following.
697 Consider first
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).
702
703 Now consider
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.  
709
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)).
713
714 This is all controlled with a user-visible pragma:
715      {-# NOINLINE CONLIKE [1] f #-}
716
717 The main effects of CONLIKE are:
718
719     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
720       CONLIKE thing like constructors, by ANF-ing them
721
722     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
723       additionally spots applications of CONLIKE functions
724
725     - A CoreUnfolding has a field that caches exprIsExpandable
726
727     - The rule matcher consults this field.  See
728       Note [Expanding variables] in Rules.lhs.
729
730 \begin{code}
731 isConLike :: RuleMatchInfo -> Bool
732 isConLike ConLike = True
733 isConLike _            = False
734
735 isFunLike :: RuleMatchInfo -> Bool
736 isFunLike FunLike = True
737 isFunLike _            = False
738
739 isInlineSpec :: InlineSpec -> Bool
740 isInlineSpec Inline    = True
741 isInlineSpec Inlinable = True
742 isInlineSpec _         = False
743
744 isEmptyInlineSpec :: InlineSpec -> Bool
745 isEmptyInlineSpec EmptyInlineSpec = True
746 isEmptyInlineSpec _               = False
747
748 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
749   :: InlinePragma
750 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
751                                    , inl_rule = FunLike
752                                    , inl_inline = EmptyInlineSpec
753                                    , inl_sat = Nothing }
754
755 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
756 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
757
758 inlinePragmaSpec :: InlinePragma -> InlineSpec
759 inlinePragmaSpec = inl_inline
760
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 }
767
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
773
774 isInlinePragma :: InlinePragma -> Bool
775 isInlinePragma prag = isInlineSpec (inl_inline prag)
776
777 isInlinablePragma :: InlinePragma -> Bool
778 isInlinablePragma prag = case inl_inline prag of
779                            Inlinable -> True
780                            _         -> False
781
782 inlinePragmaSat :: InlinePragma -> Maybe Arity
783 inlinePragmaSat = inl_sat
784
785 inlinePragmaActivation :: InlinePragma -> Activation
786 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
787
788 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
789 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
790
791 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
792 setInlinePragmaActivation prag activation = prag { inl_act = activation }
793
794 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
795 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
796
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)
802
803 instance Outputable RuleMatchInfo where
804    ppr ConLike = ptext (sLit "CONLIKE")
805    ppr FunLike = ptext (sLit "FUNLIKE")
806
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
812
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 
817     where
818       pp_act Inline   AlwaysActive = empty      
819       pp_act NoInline NeverActive  = empty
820       pp_act _        act          = ppr act
821
822       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
823              | otherwise           = empty
824       pp_info | isFunLike info = empty
825               | otherwise      = ppr info
826
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
832
833 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
834 isNeverActive NeverActive = True
835 isNeverActive _           = False
836
837 isAlwaysActive AlwaysActive = True
838 isAlwaysActive _            = False
839
840 isEarlyActive AlwaysActive      = True
841 isEarlyActive (ActiveBefore {}) = True
842 isEarlyActive _                 = False
843 \end{code}
844