Refactoring of the way that inlinings and rules are activated
[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(..), PhaseNum,
63         Activation(..), isActive, isActiveIn,
64         isNeverActive, isAlwaysActive, isEarlyActive,
65         RuleMatchInfo(..), isConLike, isFunLike, 
66         InlineSpec(..), 
67         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, 
68         neverInlinePragma, dfunInlinePragma, 
69         isDefaultInlinePragma, 
70         isInlinePragma, isInlinablePragma, isAnyInlinePragma,
71         inlinePragmaSpec, inlinePragmaSat,
72         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
73         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
74
75         SuccessFlag(..), succeeded, failed, successIf
76    ) where
77
78 import FastString
79 import Outputable
80
81 import Data.Data hiding (Fixity)
82 \end{code}
83
84 %************************************************************************
85 %*                                                                      *
86 \subsection[Arity]{Arity}
87 %*                                                                      *
88 %************************************************************************
89
90 \begin{code}
91 type Arity = Int
92 \end{code}
93
94 %************************************************************************
95 %*                                                                      *
96 \subsection[FunctionOrData]{FunctionOrData}
97 %*                                                                      *
98 %************************************************************************
99
100 \begin{code}
101 data FunctionOrData = IsFunction | IsData
102     deriving (Eq, Ord, Data, Typeable)
103
104 instance Outputable FunctionOrData where
105     ppr IsFunction = text "(function)"
106     ppr IsData     = text "(data)"
107 \end{code}
108
109
110 %************************************************************************
111 %*                                                                      *
112 \subsection[Version]{Module and identifier version numbers}
113 %*                                                                      *
114 %************************************************************************
115
116 \begin{code}
117 type Version = Int
118
119 bumpVersion :: Version -> Version 
120 bumpVersion v = v+1
121
122 initialVersion :: Version
123 initialVersion = 1
124 \end{code}
125
126 %************************************************************************
127 %*                                                                      *
128                 Deprecations
129 %*                                                                      *
130 %************************************************************************
131
132
133 \begin{code}
134 -- reason/explanation from a WARNING or DEPRECATED pragma
135 data WarningTxt = WarningTxt [FastString]
136                 | DeprecatedTxt [FastString]
137     deriving (Eq, Data, Typeable)
138
139 instance Outputable WarningTxt where
140     ppr (WarningTxt    ws) = doubleQuotes (vcat (map ftext ws))
141     ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
142                              doubleQuotes (vcat (map ftext ds))
143 \end{code}
144
145 %************************************************************************
146 %*                                                                      *
147 \subsection{Implicit parameter identity}
148 %*                                                                      *
149 %************************************************************************
150
151 The @IPName@ type is here because it is used in TypeRep (i.e. very
152 early in the hierarchy), but also in HsSyn.
153
154 \begin{code}
155 newtype IPName name = IPName name       -- ?x
156   deriving( Eq, Ord, Data, Typeable )
157   -- Ord is used in the IP name cache finite map
158   -- (used in HscTypes.OrigIParamCache)
159
160 ipNameName :: IPName name -> name
161 ipNameName (IPName n) = n
162
163 mapIPName :: (a->b) -> IPName a -> IPName b
164 mapIPName f (IPName n) = IPName (f n)
165
166 instance Outputable name => Outputable (IPName name) where
167     ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters
168 \end{code}
169
170 %************************************************************************
171 %*                                                                      *
172                 Rules
173 %*                                                                      *
174 %************************************************************************
175
176 \begin{code}
177 type RuleName = FastString
178 \end{code}
179
180 %************************************************************************
181 %*                                                                      *
182 \subsection[Fixity]{Fixity info}
183 %*                                                                      *
184 %************************************************************************
185
186 \begin{code}
187 ------------------------
188 data Fixity = Fixity Int FixityDirection
189   deriving (Data, Typeable)
190
191 instance Outputable Fixity where
192     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
193
194 instance Eq Fixity where                -- Used to determine if two fixities conflict
195   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
196
197 ------------------------
198 data FixityDirection = InfixL | InfixR | InfixN 
199                      deriving (Eq, Data, Typeable)
200
201 instance Outputable FixityDirection where
202     ppr InfixL = ptext (sLit "infixl")
203     ppr InfixR = ptext (sLit "infixr")
204     ppr InfixN = ptext (sLit "infix")
205
206 ------------------------
207 maxPrecedence :: Int
208 maxPrecedence = 9
209 defaultFixity :: Fixity
210 defaultFixity = Fixity maxPrecedence InfixL
211
212 negateFixity, funTyFixity :: Fixity
213 -- Wired-in fixities
214 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
215 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
216 \end{code}
217
218 Consider
219
220 \begin{verbatim}
221         a `op1` b `op2` c
222 \end{verbatim}
223 @(compareFixity op1 op2)@ tells which way to arrange appication, or
224 whether there's an error.
225
226 \begin{code}
227 compareFixity :: Fixity -> Fixity
228               -> (Bool,         -- Error please
229                   Bool)         -- Associate to the right: a op1 (b op2 c)
230 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
231   = case prec1 `compare` prec2 of
232         GT -> left
233         LT -> right
234         EQ -> case (dir1, dir2) of
235                         (InfixR, InfixR) -> right
236                         (InfixL, InfixL) -> left
237                         _                -> error_please
238   where
239     right        = (False, True)
240     left         = (False, False)
241     error_please = (True,  False)
242 \end{code}
243
244
245 %************************************************************************
246 %*                                                                      *
247 \subsection[Top-level/local]{Top-level/not-top level flag}
248 %*                                                                      *
249 %************************************************************************
250
251 \begin{code}
252 data TopLevelFlag
253   = TopLevel
254   | NotTopLevel
255
256 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
257
258 isNotTopLevel NotTopLevel = True
259 isNotTopLevel TopLevel    = False
260
261 isTopLevel TopLevel     = True
262 isTopLevel NotTopLevel  = False
263
264 instance Outputable TopLevelFlag where
265   ppr TopLevel    = ptext (sLit "<TopLevel>")
266   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
267 \end{code}
268
269
270 %************************************************************************
271 %*                                                                      *
272                 Top-level/not-top level flag
273 %*                                                                      *
274 %************************************************************************
275
276 \begin{code}
277 data Boxity
278   = Boxed
279   | Unboxed
280   deriving( Eq, Data, Typeable )
281
282 isBoxed :: Boxity -> Bool
283 isBoxed Boxed   = True
284 isBoxed Unboxed = False
285 \end{code}
286
287
288 %************************************************************************
289 %*                                                                      *
290                 Recursive/Non-Recursive flag
291 %*                                                                      *
292 %************************************************************************
293
294 \begin{code}
295 data RecFlag = Recursive 
296              | NonRecursive
297              deriving( Eq, Data, Typeable )
298
299 isRec :: RecFlag -> Bool
300 isRec Recursive    = True
301 isRec NonRecursive = False
302
303 isNonRec :: RecFlag -> Bool
304 isNonRec Recursive    = False
305 isNonRec NonRecursive = True
306
307 boolToRecFlag :: Bool -> RecFlag
308 boolToRecFlag True  = Recursive
309 boolToRecFlag False = NonRecursive
310
311 instance Outputable RecFlag where
312   ppr Recursive    = ptext (sLit "Recursive")
313   ppr NonRecursive = ptext (sLit "NonRecursive")
314 \end{code}
315
316 %************************************************************************
317 %*                                                                      *
318                 Instance overlap flag
319 %*                                                                      *
320 %************************************************************************
321
322 \begin{code}
323 data OverlapFlag
324   = NoOverlap   -- This instance must not overlap another
325
326   | OverlapOk   -- Silently ignore this instance if you find a 
327                 -- more specific one that matches the constraint
328                 -- you are trying to resolve
329                 --
330                 -- Example: constraint (Foo [Int])
331                 --          instances  (Foo [Int])
332         
333                 --                     (Foo [a])        OverlapOk
334                 -- Since the second instance has the OverlapOk flag,
335                 -- the first instance will be chosen (otherwise 
336                 -- its ambiguous which to choose)
337
338   | Incoherent  -- Like OverlapOk, but also ignore this instance 
339                 -- if it doesn't match the constraint you are
340                 -- trying to resolve, but could match if the type variables
341                 -- in the constraint were instantiated
342                 --
343                 -- Example: constraint (Foo [b])
344                 --          instances  (Foo [Int])      Incoherent
345                 --                     (Foo [a])
346                 -- Without the Incoherent flag, we'd complain that
347                 -- instantiating 'b' would change which instance 
348                 -- was chosen
349   deriving( Eq )
350
351 instance Outputable OverlapFlag where
352    ppr NoOverlap  = empty
353    ppr OverlapOk  = ptext (sLit "[overlap ok]")
354    ppr Incoherent = ptext (sLit "[incoherent]")
355
356 \end{code}
357
358 %************************************************************************
359 %*                                                                      *
360                 Tuples
361 %*                                                                      *
362 %************************************************************************
363
364 \begin{code}
365 data TupCon = TupCon Boxity Arity
366
367 instance Eq TupCon where
368   (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
369    
370 tupleParens :: Boxity -> SDoc -> SDoc
371 tupleParens Boxed   p = parens p
372 tupleParens Unboxed p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
373 \end{code}
374
375 %************************************************************************
376 %*                                                                      *
377 \subsection[Generic]{Generic flag}
378 %*                                                                      *
379 %************************************************************************
380
381 This is the "Embedding-Projection pair" datatype, it contains 
382 two pieces of code (normally either RenamedExpr's or Id's)
383 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
384 represents functions of type 
385
386         from :: T -> Tring
387         to   :: Tring -> T
388
389 And we should have 
390
391         to (from x) = x
392
393 T and Tring are arbitrary, but typically T is the 'main' type while
394 Tring is the 'representation' type.  (This just helps us remember 
395 whether to use 'from' or 'to'.
396
397 \begin{code}
398 data EP a = EP { fromEP :: a,   -- :: T -> Tring
399                  toEP   :: a }  -- :: Tring -> T
400 \end{code}
401
402 Embedding-projection pairs are used in several places:
403
404 First of all, each type constructor has an EP associated with it, the
405 code in EP converts (datatype T) from T to Tring and back again.
406
407 Secondly, when we are filling in Generic methods (in the typechecker, 
408 tcMethodBinds), we are constructing bimaps by induction on the structure
409 of the type of the method signature.
410
411
412 %************************************************************************
413 %*                                                                      *
414 \subsection{Occurrence information}
415 %*                                                                      *
416 %************************************************************************
417
418 This data type is used exclusively by the simplifier, but it appears in a
419 SubstResult, which is currently defined in VarEnv, which is pretty near
420 the base of the module hierarchy.  So it seemed simpler to put the
421 defn of OccInfo here, safely at the bottom
422
423 \begin{code}
424 -- | Identifier occurrence information
425 data OccInfo 
426   = NoOccInfo           -- ^ There are many occurrences, or unknown occurences
427
428   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
429                         -- lambda and case-bound variables.
430
431   | OneOcc
432         !InsideLam
433         !OneBranch
434         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
435
436   -- | This identifier breaks a loop of mutually recursive functions. The field
437   -- marks whether it is only a loop breaker due to a reference in a rule
438   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
439         !RulesOnly      -- True <=> This is a weak or rules-only loop breaker
440                         --          See OccurAnal Note [Weak loop breakers]
441
442 type RulesOnly = Bool
443 \end{code}
444
445 Note [LoopBreaker OccInfo]
446 ~~~~~~~~~~~~~~~~~~~~~~~~~~
447 An OccInfo of (IAmLoopBreaker False) is used by the occurrence 
448 analyser in two ways:
449   (a) to mark loop-breakers in a group of recursive 
450       definitions (hence the name)
451   (b) to mark binders that must not be inlined in this phase
452       (perhaps it has a NOINLINE pragma)
453 Things with (IAmLoopBreaker False) do not get an unfolding 
454 pinned on to them, so they are completely opaque.
455
456 See OccurAnal Note [Weak loop breakers] for (IAmLoopBreaker True).
457
458
459 \begin{code}
460 isNoOcc :: OccInfo -> Bool
461 isNoOcc NoOccInfo = True
462 isNoOcc _         = False
463
464 seqOccInfo :: OccInfo -> ()
465 seqOccInfo occ = occ `seq` ()
466
467 -----------------
468 type InterestingCxt = Bool      -- True <=> Function: is applied
469                                 --          Data value: scrutinised by a case with
470                                 --                      at least one non-DEFAULT branch
471
472 -----------------
473 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
474                         -- Substituting a redex for this occurrence is
475                         -- dangerous because it might duplicate work.
476 insideLam, notInsideLam :: InsideLam
477 insideLam    = True
478 notInsideLam = False
479
480 -----------------
481 type OneBranch = Bool   -- True <=> Occurs in only one case branch
482                         --      so no code-duplication issue to worry about
483 oneBranch, notOneBranch :: OneBranch
484 oneBranch    = True
485 notOneBranch = False
486
487 isLoopBreaker :: OccInfo -> Bool
488 isLoopBreaker (IAmALoopBreaker _) = True
489 isLoopBreaker _                   = False
490
491 isNonRuleLoopBreaker :: OccInfo -> Bool
492 isNonRuleLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
493 isNonRuleLoopBreaker _                       = False
494
495 nonRuleLoopBreaker :: OccInfo
496 nonRuleLoopBreaker = IAmALoopBreaker False
497
498 isDeadOcc :: OccInfo -> Bool
499 isDeadOcc IAmDead = True
500 isDeadOcc _       = False
501
502 isOneOcc :: OccInfo -> Bool
503 isOneOcc (OneOcc {}) = True
504 isOneOcc _           = False
505
506 zapFragileOcc :: OccInfo -> OccInfo
507 zapFragileOcc (OneOcc {}) = NoOccInfo
508 zapFragileOcc occ         = occ
509 \end{code}
510
511 \begin{code}
512 instance Outputable OccInfo where
513   -- only used for debugging; never parsed.  KSW 1999-07
514   ppr NoOccInfo            = empty
515   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
516   ppr IAmDead              = ptext (sLit "Dead")
517   ppr (OneOcc inside_lam one_branch int_cxt)
518         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
519         where
520           pp_lam | inside_lam = char 'L'
521                  | otherwise  = empty
522           pp_br  | one_branch = empty
523                  | otherwise  = char '*'
524           pp_args | int_cxt   = char '!'
525                   | otherwise = empty
526
527 instance Show OccInfo where
528   showsPrec p occ = showsPrecSDoc p (ppr occ)
529 \end{code}
530
531 %************************************************************************
532 %*                                                                      *
533                 Strictness indication
534 %*                                                                      *
535 %************************************************************************
536
537 The strictness annotations on types in data type declarations
538 e.g.    data T = MkT !Int !(Bool,Bool)
539
540 \begin{code}
541 -------------------------
542 -- HsBang describes what the *programmer* wrote
543 -- This info is retained in the DataCon.dcStrictMarks field
544 data HsBang = HsNoBang  
545
546             | HsStrict  
547
548             | HsUnpack         -- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
549
550             | HsUnpackFailed   -- An UNPACK pragma that we could not make 
551                                -- use of, because the type isn't unboxable; 
552                                -- equivalant to HsStrict except for checkValidDataCon
553   deriving (Eq, Data, Typeable)
554
555 instance Outputable HsBang where
556     ppr HsNoBang       = empty
557     ppr HsStrict       = char '!'
558     ppr HsUnpack       = ptext (sLit "{-# UNPACK #-} !")
559     ppr HsUnpackFailed = ptext (sLit "{-# UNPACK (failed) #-} !")
560
561 isBanged :: HsBang -> Bool
562 isBanged HsNoBang = False
563 isBanged _        = True
564
565 isMarkedUnboxed :: HsBang -> Bool
566 isMarkedUnboxed HsUnpack = True
567 isMarkedUnboxed _        = False
568
569 -------------------------
570 -- StrictnessMark is internal only, used to indicate strictness 
571 -- of the DataCon *worker* fields
572 data StrictnessMark = MarkedStrict | NotMarkedStrict    
573
574 instance Outputable StrictnessMark where
575   ppr MarkedStrict     = ptext (sLit "!")
576   ppr NotMarkedStrict  = empty
577
578 isMarkedStrict :: StrictnessMark -> Bool
579 isMarkedStrict NotMarkedStrict = False
580 isMarkedStrict _               = True   -- All others are strict
581 \end{code}
582
583
584 %************************************************************************
585 %*                                                                      *
586                 Default method specfication
587 %*                                                                      *
588 %************************************************************************
589
590 The DefMethSpec enumeration just indicates what sort of default method
591 is used for a class. It is generated from source code, and present in 
592 interface files; it is converted to Class.DefMeth before begin put in a 
593 Class object.
594
595 \begin{code}
596 data DefMethSpec = NoDM        -- No default method
597                  | VanillaDM   -- Default method given with polymorphic code
598                  | GenericDM   -- Default method given with generic code
599
600 instance Outputable DefMethSpec where
601   ppr NoDM      = empty
602   ppr VanillaDM = ptext (sLit "{- Has default method -}")
603   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
604 \end{code}
605
606 %************************************************************************
607 %*                                                                      *
608 \subsection{Success flag}
609 %*                                                                      *
610 %************************************************************************
611
612 \begin{code}
613 data SuccessFlag = Succeeded | Failed
614
615 instance Outputable SuccessFlag where
616     ppr Succeeded = ptext (sLit "Succeeded")
617     ppr Failed    = ptext (sLit "Failed")
618
619 successIf :: Bool -> SuccessFlag
620 successIf True  = Succeeded
621 successIf False = Failed
622
623 succeeded, failed :: SuccessFlag -> Bool
624 succeeded Succeeded = True
625 succeeded Failed    = False
626
627 failed Succeeded = False
628 failed Failed    = True
629 \end{code}
630
631
632 %************************************************************************
633 %*                                                                      *
634 \subsection{Activation}
635 %*                                                                      *
636 %************************************************************************
637
638 When a rule or inlining is active
639
640 \begin{code}
641 type PhaseNum = Int  -- Compilation phase
642                      -- Phases decrease towards zero
643                      -- Zero is the last phase
644
645 data CompilerPhase
646   = Phase PhaseNum
647   | InitialPhase    -- The first phase -- number = infinity!
648
649 instance Outputable CompilerPhase where
650    ppr (Phase n)    = int n
651    ppr InitialPhase = ptext (sLit "InitialPhase")
652
653 data Activation = NeverActive
654                 | AlwaysActive
655                 | ActiveBefore PhaseNum -- Active only *before* this phase
656                 | ActiveAfter PhaseNum  -- Active in this phase and later
657                 deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
658
659 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
660                    | FunLike
661                    deriving( Eq, Data, Typeable, Show )
662         -- Show needed for Lexer.x
663
664 data InlinePragma            -- Note [InlinePragma]
665   = InlinePragma
666       { inl_inline :: InlineSpec
667
668       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n 
669                                      --            explicit (non-type, non-dictionary) args
670                                      --   That is, inl_sat describes the number of *source-code*
671                                      --   arguments the thing must be applied to.  We add on the 
672                                      --   number of implicit, dictionary arguments when making
673                                      --   the InlineRule, and don't look at inl_sat further
674
675       , inl_act    :: Activation     -- Says during which phases inlining is allowed
676
677       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
678     } deriving( Eq, Data, Typeable )
679
680 data InlineSpec   -- What the user's INLINE pragama looked like
681   = Inline
682   | Inlinable
683   | NoInline
684   | EmptyInlineSpec
685   deriving( Eq, Data, Typeable, Show )
686         -- Show needed for Lexer.x
687 \end{code}
688
689 Note [InlinePragma]
690 ~~~~~~~~~~~~~~~~~~~
691 This data type mirrors what you can write in an INLINE or NOINLINE pragma in 
692 the source program.
693
694 If you write nothing at all, you get defaultInlinePragma:
695    inl_inline = False
696    inl_act    = AlwaysActive
697    inl_rule   = FunLike
698
699 It's not possible to get that combination by *writing* something, so 
700 if an Id has defaultInlinePragma it means the user didn't specify anything.
701
702 If inl_inline = True, then the Id should have an InlineRule unfolding.
703
704 Note [CONLIKE pragma]
705 ~~~~~~~~~~~~~~~~~~~~~
706 The ConLike constructor of a RuleMatchInfo is aimed at the following.
707 Consider first
708     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
709     g b bs = let x = b:bs in ..x...x...(r x)...
710 Now, the rule applies to the (r x) term, because GHC "looks through" 
711 the definition of 'x' to see that it is (b:bs).
712
713 Now consider
714     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
715     g v = let x = f v in ..x...x...(r x)...
716 Normally the (r x) would *not* match the rule, because GHC would be
717 scared about duplicating the redex (f v), so it does not "look
718 through" the bindings.  
719
720 However the CONLIKE modifier says to treat 'f' like a constructor in
721 this situation, and "look through" the unfolding for x.  So (r x)
722 fires, yielding (f (v+1)).
723
724 This is all controlled with a user-visible pragma:
725      {-# NOINLINE CONLIKE [1] f #-}
726
727 The main effects of CONLIKE are:
728
729     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
730       CONLIKE thing like constructors, by ANF-ing them
731
732     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
733       additionally spots applications of CONLIKE functions
734
735     - A CoreUnfolding has a field that caches exprIsExpandable
736
737     - The rule matcher consults this field.  See
738       Note [Expanding variables] in Rules.lhs.
739
740 \begin{code}
741 isConLike :: RuleMatchInfo -> Bool
742 isConLike ConLike = True
743 isConLike _            = False
744
745 isFunLike :: RuleMatchInfo -> Bool
746 isFunLike FunLike = True
747 isFunLike _            = False
748
749 isEmptyInlineSpec :: InlineSpec -> Bool
750 isEmptyInlineSpec EmptyInlineSpec = True
751 isEmptyInlineSpec _               = False
752
753 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
754   :: InlinePragma
755 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
756                                    , inl_rule = FunLike
757                                    , inl_inline = EmptyInlineSpec
758                                    , inl_sat = Nothing }
759
760 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
761 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
762
763 inlinePragmaSpec :: InlinePragma -> InlineSpec
764 inlinePragmaSpec = inl_inline
765
766 -- A DFun has an always-active inline activation so that 
767 -- exprIsConApp_maybe can "see" its unfolding
768 -- (However, its actual Unfolding is a DFunUnfolding, which is
769 --  never inlined other than via exprIsConApp_maybe.)
770 dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
771                                          , inl_rule = ConLike }
772
773 isDefaultInlinePragma :: InlinePragma -> Bool
774 isDefaultInlinePragma (InlinePragma { inl_act = activation
775                                     , inl_rule = match_info
776                                     , inl_inline = inline })
777   = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
778
779 isInlinePragma :: InlinePragma -> Bool
780 isInlinePragma prag = case inl_inline prag of
781                         Inline -> True
782                         _      -> False
783
784 isInlinablePragma :: InlinePragma -> Bool
785 isInlinablePragma prag = case inl_inline prag of
786                            Inlinable -> True
787                            _         -> False
788
789 isAnyInlinePragma :: InlinePragma -> Bool
790 -- INLINE or INLINABLE
791 isAnyInlinePragma prag = case inl_inline prag of
792                         Inline    -> True
793                         Inlinable -> True
794                         _         -> False
795  
796 inlinePragmaSat :: InlinePragma -> Maybe Arity
797 inlinePragmaSat = inl_sat
798
799 inlinePragmaActivation :: InlinePragma -> Activation
800 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
801
802 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
803 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
804
805 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
806 setInlinePragmaActivation prag activation = prag { inl_act = activation }
807
808 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
809 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
810
811 instance Outputable Activation where
812    ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
813    ppr NeverActive      = brackets (ptext (sLit "NEVER"))
814    ppr (ActiveBefore n) = brackets (char '~' <> int n)
815    ppr (ActiveAfter n)  = brackets (int n)
816
817 instance Outputable RuleMatchInfo where
818    ppr ConLike = ptext (sLit "CONLIKE")
819    ppr FunLike = ptext (sLit "FUNLIKE")
820
821 instance Outputable InlineSpec where
822    ppr Inline          = ptext (sLit "INLINE")
823    ppr NoInline        = ptext (sLit "NOINLINE")
824    ppr Inlinable       = ptext (sLit "INLINABLE")
825    ppr EmptyInlineSpec = empty
826
827 instance Outputable InlinePragma where
828   ppr (InlinePragma { inl_inline = inline, inl_act = activation
829                     , inl_rule = info, inl_sat = mb_arity })
830     = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info 
831     where
832       pp_act Inline   AlwaysActive = empty      
833       pp_act NoInline NeverActive  = empty
834       pp_act _        act          = ppr act
835
836       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
837              | otherwise           = empty
838       pp_info | isFunLike info = empty
839               | otherwise      = ppr info
840
841 isActive :: CompilerPhase -> Activation -> Bool
842 isActive InitialPhase AlwaysActive      = True
843 isActive InitialPhase (ActiveBefore {}) = True
844 isActive InitialPhase _                 = False
845 isActive (Phase p)    act               = isActiveIn p act
846
847 isActiveIn :: PhaseNum -> Activation -> Bool
848 isActiveIn _ NeverActive      = False
849 isActiveIn _ AlwaysActive     = True
850 isActiveIn p (ActiveAfter n)  = p <= n
851 isActiveIn p (ActiveBefore n) = p >  n
852
853 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
854 isNeverActive NeverActive = True
855 isNeverActive _           = False
856
857 isAlwaysActive AlwaysActive = True
858 isAlwaysActive _            = False
859
860 isEarlyActive AlwaysActive      = True
861 isEarlyActive (ActiveBefore {}) = True
862 isEarlyActive _                 = False
863 \end{code}
864