Complete work on new OVERLAPPABLE/OVERLAPPING pragmas (Trac #9242)
[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         ConTag, fIRST_TAG,
23
24         Arity, RepArity,
25
26         Alignment,
27
28         FunctionOrData(..),
29
30         WarningTxt(..),
31
32         Fixity(..), FixityDirection(..),
33         defaultFixity, maxPrecedence, minPrecedence,
34         negateFixity, funTyFixity,
35         compareFixity,
36
37         RecFlag(..), isRec, isNonRec, boolToRecFlag,
38         Origin(..), isGenerated,
39
40         RuleName,
41
42         TopLevelFlag(..), isTopLevel, isNotTopLevel,
43
44         OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
45         hasOverlappingFlag, hasOverlappableFlag,
46
47         Boxity(..), isBoxed,
48
49         TupleSort(..), tupleSortBoxity, boxityNormalTupleSort,
50         tupleParens,
51
52         -- ** The OneShotInfo type
53         OneShotInfo(..),
54         noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
55         bestOneShot, worstOneShot,
56
57         OccInfo(..), seqOccInfo, zapFragileOcc, isOneOcc,
58         isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isNoOcc,
59         strongLoopBreaker, weakLoopBreaker,
60
61         InsideLam, insideLam, notInsideLam,
62         OneBranch, oneBranch, notOneBranch,
63         InterestingCxt,
64
65         EP(..),
66
67         DefMethSpec(..),
68         SwapFlag(..), flipSwap, unSwap, isSwapped,
69
70         CompilerPhase(..), PhaseNum,
71         Activation(..), isActive, isActiveIn,
72         isNeverActive, isAlwaysActive, isEarlyActive,
73         RuleMatchInfo(..), isConLike, isFunLike,
74         InlineSpec(..), isEmptyInlineSpec,
75         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
76         neverInlinePragma, dfunInlinePragma,
77         isDefaultInlinePragma,
78         isInlinePragma, isInlinablePragma, isAnyInlinePragma,
79         inlinePragmaSpec, inlinePragmaSat,
80         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
81         setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
82
83         SuccessFlag(..), succeeded, failed, successIf,
84
85         FractionalLit(..), negateFractionalLit, integralFractionalLit,
86
87         HValue(..)
88    ) where
89
90 import FastString
91 import Outputable
92
93 import Data.Data hiding (Fixity)
94 import Data.Function (on)
95 import GHC.Exts (Any)
96 \end{code}
97
98 %************************************************************************
99 %*                                                                      *
100 \subsection[Arity]{Arity}
101 %*                                                                      *
102 %************************************************************************
103
104 \begin{code}
105 -- | The number of value arguments that can be applied to a value before it does
106 -- "real work". So:
107 --  fib 100     has arity 0
108 --  \x -> fib x has arity 1
109 type Arity = Int
110
111 -- | The number of represented arguments that can be applied to a value before it does
112 -- "real work". So:
113 --  fib 100                    has representation arity 0
114 --  \x -> fib x                has representation arity 1
115 --  \(# x, y #) -> fib (x + y) has representation arity 2
116 type RepArity = Int
117 \end{code}
118
119 %************************************************************************
120 %*                                                                      *
121               Constructor tags
122 %*                                                                      *
123 %************************************************************************
124
125 \begin{code}
126 -- | Type of the tags associated with each constructor possibility
127 type ConTag = Int
128
129 fIRST_TAG :: ConTag
130 -- ^ Tags are allocated from here for real constructors
131 fIRST_TAG =  1
132 \end{code}
133
134 %************************************************************************
135 %*                                                                      *
136 \subsection[Alignment]{Alignment}
137 %*                                                                      *
138 %************************************************************************
139
140 \begin{code}
141 type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
142 \end{code}
143
144 %************************************************************************
145 %*                                                                      *
146          One-shot information
147 %*                                                                      *
148 %************************************************************************
149
150 \begin{code}
151 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
152 -- variable info. Sometimes we know whether the lambda binding this variable
153 -- is a \"one-shot\" lambda; that is, whether it is applied at most once.
154 --
155 -- This information may be useful in optimisation, as computations may
156 -- safely be floated inside such a lambda without risk of duplicating
157 -- work.
158 data OneShotInfo = NoOneShotInfo -- ^ No information
159                  | ProbOneShot   -- ^ The lambda is probably applied at most once
160                  | OneShotLam    -- ^ The lambda is applied at most once.
161
162 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
163 noOneShotInfo :: OneShotInfo
164 noOneShotInfo = NoOneShotInfo
165
166 isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
167 isOneShotInfo OneShotLam = True
168 isOneShotInfo _          = False
169
170 hasNoOneShotInfo NoOneShotInfo = True
171 hasNoOneShotInfo _             = False
172
173 worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
174 worstOneShot NoOneShotInfo _             = NoOneShotInfo
175 worstOneShot ProbOneShot   NoOneShotInfo = NoOneShotInfo
176 worstOneShot ProbOneShot   _             = ProbOneShot
177 worstOneShot OneShotLam    os            = os
178
179 bestOneShot NoOneShotInfo os         = os
180 bestOneShot ProbOneShot   OneShotLam = OneShotLam
181 bestOneShot ProbOneShot   _          = ProbOneShot
182 bestOneShot OneShotLam    _          = OneShotLam
183
184 pprOneShotInfo :: OneShotInfo -> SDoc
185 pprOneShotInfo NoOneShotInfo = empty
186 pprOneShotInfo ProbOneShot   = ptext (sLit "ProbOneShot")
187 pprOneShotInfo OneShotLam    = ptext (sLit "OneShot")
188
189 instance Outputable OneShotInfo where
190     ppr = pprOneShotInfo
191 \end{code}
192
193
194 %************************************************************************
195 %*                                                                      *
196            Swap flag
197 %*                                                                      *
198 %************************************************************************
199
200 \begin{code}
201 data SwapFlag
202   = NotSwapped  -- Args are: actual,   expected
203   | IsSwapped   -- Args are: expected, actual
204
205 instance Outputable SwapFlag where
206   ppr IsSwapped  = ptext (sLit "Is-swapped")
207   ppr NotSwapped = ptext (sLit "Not-swapped")
208
209 flipSwap :: SwapFlag -> SwapFlag
210 flipSwap IsSwapped  = NotSwapped
211 flipSwap NotSwapped = IsSwapped
212
213 isSwapped :: SwapFlag -> Bool
214 isSwapped IsSwapped  = True
215 isSwapped NotSwapped = False
216
217 unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
218 unSwap NotSwapped f a b = f a b
219 unSwap IsSwapped  f a b = f b a
220 \end{code}
221
222
223 %************************************************************************
224 %*                                                                      *
225 \subsection[FunctionOrData]{FunctionOrData}
226 %*                                                                      *
227 %************************************************************************
228
229 \begin{code}
230 data FunctionOrData = IsFunction | IsData
231     deriving (Eq, Ord, Data, Typeable)
232
233 instance Outputable FunctionOrData where
234     ppr IsFunction = text "(function)"
235     ppr IsData     = text "(data)"
236 \end{code}
237
238
239 %************************************************************************
240 %*                                                                      *
241 \subsection[Version]{Module and identifier version numbers}
242 %*                                                                      *
243 %************************************************************************
244
245 \begin{code}
246 type Version = Int
247
248 bumpVersion :: Version -> Version
249 bumpVersion v = v+1
250
251 initialVersion :: Version
252 initialVersion = 1
253 \end{code}
254
255 %************************************************************************
256 %*                                                                      *
257                 Deprecations
258 %*                                                                      *
259 %************************************************************************
260
261
262 \begin{code}
263 -- reason/explanation from a WARNING or DEPRECATED pragma
264 data WarningTxt = WarningTxt [FastString]
265                 | DeprecatedTxt [FastString]
266     deriving (Eq, Data, Typeable)
267
268 instance Outputable WarningTxt where
269     ppr (WarningTxt    ws) = doubleQuotes (vcat (map ftext ws))
270     ppr (DeprecatedTxt ds) = text "Deprecated:" <+>
271                              doubleQuotes (vcat (map ftext ds))
272 \end{code}
273
274 %************************************************************************
275 %*                                                                      *
276                 Rules
277 %*                                                                      *
278 %************************************************************************
279
280 \begin{code}
281 type RuleName = FastString
282 \end{code}
283
284 %************************************************************************
285 %*                                                                      *
286 \subsection[Fixity]{Fixity info}
287 %*                                                                      *
288 %************************************************************************
289
290 \begin{code}
291 ------------------------
292 data Fixity = Fixity Int FixityDirection
293   deriving (Data, Typeable)
294
295 instance Outputable Fixity where
296     ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
297
298 instance Eq Fixity where -- Used to determine if two fixities conflict
299   (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
300
301 ------------------------
302 data FixityDirection = InfixL | InfixR | InfixN
303                      deriving (Eq, Data, Typeable)
304
305 instance Outputable FixityDirection where
306     ppr InfixL = ptext (sLit "infixl")
307     ppr InfixR = ptext (sLit "infixr")
308     ppr InfixN = ptext (sLit "infix")
309
310 ------------------------
311 maxPrecedence, minPrecedence :: Int
312 maxPrecedence = 9
313 minPrecedence = 0
314
315 defaultFixity :: Fixity
316 defaultFixity = Fixity maxPrecedence InfixL
317
318 negateFixity, funTyFixity :: Fixity
319 -- Wired-in fixities
320 negateFixity = Fixity 6 InfixL  -- Fixity of unary negate
321 funTyFixity  = Fixity 0 InfixR  -- Fixity of '->'
322 \end{code}
323
324 Consider
325
326 \begin{verbatim}
327         a `op1` b `op2` c
328 \end{verbatim}
329 @(compareFixity op1 op2)@ tells which way to arrange appication, or
330 whether there's an error.
331
332 \begin{code}
333 compareFixity :: Fixity -> Fixity
334               -> (Bool,         -- Error please
335                   Bool)         -- Associate to the right: a op1 (b op2 c)
336 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
337   = case prec1 `compare` prec2 of
338         GT -> left
339         LT -> right
340         EQ -> case (dir1, dir2) of
341                         (InfixR, InfixR) -> right
342                         (InfixL, InfixL) -> left
343                         _                -> error_please
344   where
345     right        = (False, True)
346     left         = (False, False)
347     error_please = (True,  False)
348 \end{code}
349
350
351 %************************************************************************
352 %*                                                                      *
353 \subsection[Top-level/local]{Top-level/not-top level flag}
354 %*                                                                      *
355 %************************************************************************
356
357 \begin{code}
358 data TopLevelFlag
359   = TopLevel
360   | NotTopLevel
361
362 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
363
364 isNotTopLevel NotTopLevel = True
365 isNotTopLevel TopLevel    = False
366
367 isTopLevel TopLevel     = True
368 isTopLevel NotTopLevel  = False
369
370 instance Outputable TopLevelFlag where
371   ppr TopLevel    = ptext (sLit "<TopLevel>")
372   ppr NotTopLevel = ptext (sLit "<NotTopLevel>")
373 \end{code}
374
375
376 %************************************************************************
377 %*                                                                      *
378                 Boxity flag
379 %*                                                                      *
380 %************************************************************************
381
382 \begin{code}
383 data Boxity
384   = Boxed
385   | Unboxed
386   deriving( Eq, Data, Typeable )
387
388 isBoxed :: Boxity -> Bool
389 isBoxed Boxed   = True
390 isBoxed Unboxed = False
391 \end{code}
392
393
394 %************************************************************************
395 %*                                                                      *
396                 Recursive/Non-Recursive flag
397 %*                                                                      *
398 %************************************************************************
399
400 \begin{code}
401 data RecFlag = Recursive
402              | NonRecursive
403              deriving( Eq, Data, Typeable )
404
405 isRec :: RecFlag -> Bool
406 isRec Recursive    = True
407 isRec NonRecursive = False
408
409 isNonRec :: RecFlag -> Bool
410 isNonRec Recursive    = False
411 isNonRec NonRecursive = True
412
413 boolToRecFlag :: Bool -> RecFlag
414 boolToRecFlag True  = Recursive
415 boolToRecFlag False = NonRecursive
416
417 instance Outputable RecFlag where
418   ppr Recursive    = ptext (sLit "Recursive")
419   ppr NonRecursive = ptext (sLit "NonRecursive")
420 \end{code}
421
422 %************************************************************************
423 %*                                                                      *
424                 Code origin
425 %*                                                                      *
426 %************************************************************************
427 \begin{code}
428 data Origin = FromSource
429             | Generated
430             deriving( Eq, Data, Typeable )
431
432 isGenerated :: Origin -> Bool
433 isGenerated Generated = True
434 isGenerated FromSource = False
435
436 instance Outputable Origin where
437   ppr FromSource  = ptext (sLit "FromSource")
438   ppr Generated   = ptext (sLit "Generated")
439 \end{code}
440
441 %************************************************************************
442 %*                                                                      *
443                 Instance overlap flag
444 %*                                                                      *
445 %************************************************************************
446
447 \begin{code}
448 -- | The semantics allowed for overlapping instances for a particular
449 -- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.lhs`) for a
450 -- explanation of the `isSafeOverlap` field.
451 data OverlapFlag = OverlapFlag
452   { overlapMode   :: OverlapMode
453   , isSafeOverlap :: Bool
454   } deriving (Eq, Data, Typeable)
455
456 setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
457 setOverlapModeMaybe f Nothing  = f
458 setOverlapModeMaybe f (Just m) = f { overlapMode = m }
459
460 hasOverlappableFlag :: OverlapMode -> Bool
461 hasOverlappableFlag mode =
462   case mode of
463     Overlappable -> True
464     Overlaps     -> True
465     Incoherent   -> True
466     _            -> False
467
468 hasOverlappingFlag :: OverlapMode -> Bool
469 hasOverlappingFlag mode =
470   case mode of
471     Overlapping  -> True
472     Overlaps     -> True
473     Incoherent   -> True
474     _            -> False
475
476 data OverlapMode  -- See Note [Rules for instance lookup] in InstEnv
477   = NoOverlap
478     -- ^ This instance must not overlap another `NoOverlap` instance.
479     -- However, it may be overlapped by `Overlapping` instances,
480     -- and it may overlap `Overlappable` instances.
481
482
483   | Overlappable
484     -- ^ Silently ignore this instance if you find a
485     -- more specific one that matches the constraint
486     -- you are trying to resolve
487     --
488     -- Example: constraint (Foo [Int])
489     --   instance                      Foo [Int]
490     --   instance {-# OVERLAPPABLE #-} Foo [a]
491     --
492     -- Since the second instance has the Overlappable flag,
493     -- the first instance will be chosen (otherwise
494     -- its ambiguous which to choose)
495
496
497   | Overlapping
498     -- ^ Silently ignore any more general instances that may be
499     --   used to solve the constraint.
500     --
501     -- Example: constraint (Foo [Int])
502     --   instance {-# OVERLAPPING #-} Foo [Int]
503     --   instance                     Foo [a]
504     --
505     -- Since the first instance has the Overlapping flag,
506     -- the second---more general---instance will be ignored (otherwise
507     -- it is ambiguous which to choose)
508
509
510   | Overlaps
511     -- ^ Equiavalent to having both `Overlapping` and `Overlappable` flags.
512
513   | Incoherent
514     -- ^ Behave like Overlappable and Overlapping, and in addition pick
515     -- an an arbitrary one if there are multiple matching candidates, and
516     -- don't worry about later instantiation
517     --
518     -- Example: constraint (Foo [b])
519     -- instance {-# INCOHERENT -} Foo [Int]
520     -- instance                   Foo [a]
521     -- Without the Incoherent flag, we'd complain that
522     -- instantiating 'b' would change which instance
523     -- was chosen. See also note [Incoherent instances] in InstEnv
524
525   deriving (Eq, Data, Typeable)
526
527
528 instance Outputable OverlapFlag where
529    ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
530
531 instance Outputable OverlapMode where
532    ppr NoOverlap    = empty
533    ppr Overlappable = ptext (sLit "[overlappable]")
534    ppr Overlapping  = ptext (sLit "[overlapping]")
535    ppr Overlaps     = ptext (sLit "[overlap ok]")
536    ppr Incoherent   = ptext (sLit "[incoherent]")
537
538 pprSafeOverlap :: Bool -> SDoc
539 pprSafeOverlap True  = ptext $ sLit "[safe]"
540 pprSafeOverlap False = empty
541 \end{code}
542
543 %************************************************************************
544 %*                                                                      *
545                 Tuples
546 %*                                                                      *
547 %************************************************************************
548
549 \begin{code}
550 data TupleSort
551   = BoxedTuple
552   | UnboxedTuple
553   | ConstraintTuple
554   deriving( Eq, Data, Typeable )
555
556 tupleSortBoxity :: TupleSort -> Boxity
557 tupleSortBoxity BoxedTuple     = Boxed
558 tupleSortBoxity UnboxedTuple   = Unboxed
559 tupleSortBoxity ConstraintTuple = Boxed
560
561 boxityNormalTupleSort :: Boxity -> TupleSort
562 boxityNormalTupleSort Boxed   = BoxedTuple
563 boxityNormalTupleSort Unboxed = UnboxedTuple
564
565 tupleParens :: TupleSort -> SDoc -> SDoc
566 tupleParens BoxedTuple      p = parens p
567 tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples
568                                          -- directly, we overload the (,,) syntax
569 tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
570 \end{code}
571
572 %************************************************************************
573 %*                                                                      *
574 \subsection[Generic]{Generic flag}
575 %*                                                                      *
576 %************************************************************************
577
578 This is the "Embedding-Projection pair" datatype, it contains
579 two pieces of code (normally either RenamedExpr's or Id's)
580 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
581 represents functions of type
582
583         from :: T -> Tring
584         to   :: Tring -> T
585
586 And we should have
587
588         to (from x) = x
589
590 T and Tring are arbitrary, but typically T is the 'main' type while
591 Tring is the 'representation' type.  (This just helps us remember
592 whether to use 'from' or 'to'.
593
594 \begin{code}
595 data EP a = EP { fromEP :: a,   -- :: T -> Tring
596                  toEP   :: a }  -- :: Tring -> T
597 \end{code}
598
599 Embedding-projection pairs are used in several places:
600
601 First of all, each type constructor has an EP associated with it, the
602 code in EP converts (datatype T) from T to Tring and back again.
603
604 Secondly, when we are filling in Generic methods (in the typechecker,
605 tcMethodBinds), we are constructing bimaps by induction on the structure
606 of the type of the method signature.
607
608
609 %************************************************************************
610 %*                                                                      *
611 \subsection{Occurrence information}
612 %*                                                                      *
613 %************************************************************************
614
615 This data type is used exclusively by the simplifier, but it appears in a
616 SubstResult, which is currently defined in VarEnv, which is pretty near
617 the base of the module hierarchy.  So it seemed simpler to put the
618 defn of OccInfo here, safely at the bottom
619
620 \begin{code}
621 -- | Identifier occurrence information
622 data OccInfo
623   = NoOccInfo           -- ^ There are many occurrences, or unknown occurrences
624
625   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
626                         -- lambda and case-bound variables.
627
628   | OneOcc
629         !InsideLam
630         !OneBranch
631         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
632
633   -- | This identifier breaks a loop of mutually recursive functions. The field
634   -- marks whether it is only a loop breaker due to a reference in a rule
635   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
636         !RulesOnly
637
638 type RulesOnly = Bool
639 \end{code}
640
641 Note [LoopBreaker OccInfo]
642 ~~~~~~~~~~~~~~~~~~~~~~~~~~
643    IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
644                              Do not preInlineUnconditionally
645
646    IAmALoopBreaker False <=> A "strong" loop breaker
647                              Do not inline at all
648
649 See OccurAnal Note [Weak loop breakers]
650
651
652 \begin{code}
653 isNoOcc :: OccInfo -> Bool
654 isNoOcc NoOccInfo = True
655 isNoOcc _         = False
656
657 seqOccInfo :: OccInfo -> ()
658 seqOccInfo occ = occ `seq` ()
659
660 -----------------
661 type InterestingCxt = Bool      -- True <=> Function: is applied
662                                 --          Data value: scrutinised by a case with
663                                 --                      at least one non-DEFAULT branch
664
665 -----------------
666 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
667                         -- Substituting a redex for this occurrence is
668                         -- dangerous because it might duplicate work.
669 insideLam, notInsideLam :: InsideLam
670 insideLam    = True
671 notInsideLam = False
672
673 -----------------
674 type OneBranch = Bool   -- True <=> Occurs in only one case branch
675                         --      so no code-duplication issue to worry about
676 oneBranch, notOneBranch :: OneBranch
677 oneBranch    = True
678 notOneBranch = False
679
680 strongLoopBreaker, weakLoopBreaker :: OccInfo
681 strongLoopBreaker = IAmALoopBreaker False
682 weakLoopBreaker   = IAmALoopBreaker True
683
684 isWeakLoopBreaker :: OccInfo -> Bool
685 isWeakLoopBreaker (IAmALoopBreaker _) = True
686 isWeakLoopBreaker _                   = False
687
688 isStrongLoopBreaker :: OccInfo -> Bool
689 isStrongLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
690 isStrongLoopBreaker _                       = False
691
692 isDeadOcc :: OccInfo -> Bool
693 isDeadOcc IAmDead = True
694 isDeadOcc _       = False
695
696 isOneOcc :: OccInfo -> Bool
697 isOneOcc (OneOcc {}) = True
698 isOneOcc _           = False
699
700 zapFragileOcc :: OccInfo -> OccInfo
701 zapFragileOcc (OneOcc {}) = NoOccInfo
702 zapFragileOcc occ         = occ
703 \end{code}
704
705 \begin{code}
706 instance Outputable OccInfo where
707   -- only used for debugging; never parsed.  KSW 1999-07
708   ppr NoOccInfo            = empty
709   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
710   ppr IAmDead              = ptext (sLit "Dead")
711   ppr (OneOcc inside_lam one_branch int_cxt)
712         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
713         where
714           pp_lam | inside_lam = char 'L'
715                  | otherwise  = empty
716           pp_br  | one_branch = empty
717                  | otherwise  = char '*'
718           pp_args | int_cxt   = char '!'
719                   | otherwise = empty
720 \end{code}
721
722 %************************************************************************
723 %*                                                                      *
724                 Default method specfication
725 %*                                                                      *
726 %************************************************************************
727
728 The DefMethSpec enumeration just indicates what sort of default method
729 is used for a class. It is generated from source code, and present in
730 interface files; it is converted to Class.DefMeth before begin put in a
731 Class object.
732
733 \begin{code}
734 data DefMethSpec = NoDM        -- No default method
735                  | VanillaDM   -- Default method given with polymorphic code
736                  | GenericDM   -- Default method given with generic code
737
738 instance Outputable DefMethSpec where
739   ppr NoDM      = empty
740   ppr VanillaDM = ptext (sLit "{- Has default method -}")
741   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
742 \end{code}
743
744 %************************************************************************
745 %*                                                                      *
746 \subsection{Success flag}
747 %*                                                                      *
748 %************************************************************************
749
750 \begin{code}
751 data SuccessFlag = Succeeded | Failed
752
753 instance Outputable SuccessFlag where
754     ppr Succeeded = ptext (sLit "Succeeded")
755     ppr Failed    = ptext (sLit "Failed")
756
757 successIf :: Bool -> SuccessFlag
758 successIf True  = Succeeded
759 successIf False = Failed
760
761 succeeded, failed :: SuccessFlag -> Bool
762 succeeded Succeeded = True
763 succeeded Failed    = False
764
765 failed Succeeded = False
766 failed Failed    = True
767 \end{code}
768
769
770 %************************************************************************
771 %*                                                                      *
772 \subsection{Activation}
773 %*                                                                      *
774 %************************************************************************
775
776 When a rule or inlining is active
777
778 \begin{code}
779 type PhaseNum = Int  -- Compilation phase
780                      -- Phases decrease towards zero
781                      -- Zero is the last phase
782
783 data CompilerPhase
784   = Phase PhaseNum
785   | InitialPhase    -- The first phase -- number = infinity!
786
787 instance Outputable CompilerPhase where
788    ppr (Phase n)    = int n
789    ppr InitialPhase = ptext (sLit "InitialPhase")
790
791 data Activation = NeverActive
792                 | AlwaysActive
793                 | ActiveBefore PhaseNum -- Active only *before* this phase
794                 | ActiveAfter PhaseNum  -- Active in this phase and later
795                 deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
796
797 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
798                    | FunLike
799                    deriving( Eq, Data, Typeable, Show )
800         -- Show needed for Lexer.x
801
802 data InlinePragma            -- Note [InlinePragma]
803   = InlinePragma
804       { inl_inline :: InlineSpec
805
806       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
807                                      --            explicit (non-type, non-dictionary) args
808                                      --   That is, inl_sat describes the number of *source-code*
809                                      --   arguments the thing must be applied to.  We add on the
810                                      --   number of implicit, dictionary arguments when making
811                                      --   the InlineRule, and don't look at inl_sat further
812
813       , inl_act    :: Activation     -- Says during which phases inlining is allowed
814
815       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
816     } deriving( Eq, Data, Typeable )
817
818 data InlineSpec   -- What the user's INLINE pragama looked like
819   = Inline
820   | Inlinable
821   | NoInline
822   | EmptyInlineSpec  -- Used in a place-holder InlinePragma in SpecPrag or IdInfo,
823                      -- where there isn't any real inline pragma at all
824   deriving( Eq, Data, Typeable, Show )
825         -- Show needed for Lexer.x
826 \end{code}
827
828 Note [InlinePragma]
829 ~~~~~~~~~~~~~~~~~~~
830 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
831 the source program.
832
833 If you write nothing at all, you get defaultInlinePragma:
834    inl_inline = False
835    inl_act    = AlwaysActive
836    inl_rule   = FunLike
837
838 It's not possible to get that combination by *writing* something, so
839 if an Id has defaultInlinePragma it means the user didn't specify anything.
840
841 If inl_inline = True, then the Id should have an InlineRule unfolding.
842
843 Note [CONLIKE pragma]
844 ~~~~~~~~~~~~~~~~~~~~~
845 The ConLike constructor of a RuleMatchInfo is aimed at the following.
846 Consider first
847     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
848     g b bs = let x = b:bs in ..x...x...(r x)...
849 Now, the rule applies to the (r x) term, because GHC "looks through"
850 the definition of 'x' to see that it is (b:bs).
851
852 Now consider
853     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
854     g v = let x = f v in ..x...x...(r x)...
855 Normally the (r x) would *not* match the rule, because GHC would be
856 scared about duplicating the redex (f v), so it does not "look
857 through" the bindings.
858
859 However the CONLIKE modifier says to treat 'f' like a constructor in
860 this situation, and "look through" the unfolding for x.  So (r x)
861 fires, yielding (f (v+1)).
862
863 This is all controlled with a user-visible pragma:
864      {-# NOINLINE CONLIKE [1] f #-}
865
866 The main effects of CONLIKE are:
867
868     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
869       CONLIKE thing like constructors, by ANF-ing them
870
871     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
872       additionally spots applications of CONLIKE functions
873
874     - A CoreUnfolding has a field that caches exprIsExpandable
875
876     - The rule matcher consults this field.  See
877       Note [Expanding variables] in Rules.lhs.
878
879 \begin{code}
880 isConLike :: RuleMatchInfo -> Bool
881 isConLike ConLike = True
882 isConLike _            = False
883
884 isFunLike :: RuleMatchInfo -> Bool
885 isFunLike FunLike = True
886 isFunLike _            = False
887
888 isEmptyInlineSpec :: InlineSpec -> Bool
889 isEmptyInlineSpec EmptyInlineSpec = True
890 isEmptyInlineSpec _               = False
891
892 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
893   :: InlinePragma
894 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
895                                    , inl_rule = FunLike
896                                    , inl_inline = EmptyInlineSpec
897                                    , inl_sat = Nothing }
898
899 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
900 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
901
902 inlinePragmaSpec :: InlinePragma -> InlineSpec
903 inlinePragmaSpec = inl_inline
904
905 -- A DFun has an always-active inline activation so that
906 -- exprIsConApp_maybe can "see" its unfolding
907 -- (However, its actual Unfolding is a DFunUnfolding, which is
908 --  never inlined other than via exprIsConApp_maybe.)
909 dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
910                                          , inl_rule = ConLike }
911
912 isDefaultInlinePragma :: InlinePragma -> Bool
913 isDefaultInlinePragma (InlinePragma { inl_act = activation
914                                     , inl_rule = match_info
915                                     , inl_inline = inline })
916   = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
917
918 isInlinePragma :: InlinePragma -> Bool
919 isInlinePragma prag = case inl_inline prag of
920                         Inline -> True
921                         _      -> False
922
923 isInlinablePragma :: InlinePragma -> Bool
924 isInlinablePragma prag = case inl_inline prag of
925                            Inlinable -> True
926                            _         -> False
927
928 isAnyInlinePragma :: InlinePragma -> Bool
929 -- INLINE or INLINABLE
930 isAnyInlinePragma prag = case inl_inline prag of
931                         Inline    -> True
932                         Inlinable -> True
933                         _         -> False
934
935 inlinePragmaSat :: InlinePragma -> Maybe Arity
936 inlinePragmaSat = inl_sat
937
938 inlinePragmaActivation :: InlinePragma -> Activation
939 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
940
941 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
942 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
943
944 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
945 setInlinePragmaActivation prag activation = prag { inl_act = activation }
946
947 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
948 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
949
950 instance Outputable Activation where
951    ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
952    ppr NeverActive      = brackets (ptext (sLit "NEVER"))
953    ppr (ActiveBefore n) = brackets (char '~' <> int n)
954    ppr (ActiveAfter n)  = brackets (int n)
955
956 instance Outputable RuleMatchInfo where
957    ppr ConLike = ptext (sLit "CONLIKE")
958    ppr FunLike = ptext (sLit "FUNLIKE")
959
960 instance Outputable InlineSpec where
961    ppr Inline          = ptext (sLit "INLINE")
962    ppr NoInline        = ptext (sLit "NOINLINE")
963    ppr Inlinable       = ptext (sLit "INLINABLE")
964    ppr EmptyInlineSpec = empty
965
966 instance Outputable InlinePragma where
967   ppr (InlinePragma { inl_inline = inline, inl_act = activation
968                     , inl_rule = info, inl_sat = mb_arity })
969     = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
970     where
971       pp_act Inline   AlwaysActive = empty
972       pp_act NoInline NeverActive  = empty
973       pp_act _        act          = ppr act
974
975       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
976              | otherwise           = empty
977       pp_info | isFunLike info = empty
978               | otherwise      = ppr info
979
980 isActive :: CompilerPhase -> Activation -> Bool
981 isActive InitialPhase AlwaysActive      = True
982 isActive InitialPhase (ActiveBefore {}) = True
983 isActive InitialPhase _                 = False
984 isActive (Phase p)    act               = isActiveIn p act
985
986 isActiveIn :: PhaseNum -> Activation -> Bool
987 isActiveIn _ NeverActive      = False
988 isActiveIn _ AlwaysActive     = True
989 isActiveIn p (ActiveAfter n)  = p <= n
990 isActiveIn p (ActiveBefore n) = p >  n
991
992 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
993 isNeverActive NeverActive = True
994 isNeverActive _           = False
995
996 isAlwaysActive AlwaysActive = True
997 isAlwaysActive _            = False
998
999 isEarlyActive AlwaysActive      = True
1000 isEarlyActive (ActiveBefore {}) = True
1001 isEarlyActive _                 = False
1002 \end{code}
1003
1004
1005
1006 \begin{code}
1007 -- Used (instead of Rational) to represent exactly the floating point literal that we
1008 -- encountered in the user's source program. This allows us to pretty-print exactly what
1009 -- the user wrote, which is important e.g. for floating point numbers that can't represented
1010 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
1011 data FractionalLit
1012   = FL { fl_text :: String         -- How the value was written in the source
1013        , fl_value :: Rational      -- Numeric value of the literal
1014        }
1015   deriving (Data, Typeable, Show)
1016   -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
1017
1018 negateFractionalLit :: FractionalLit -> FractionalLit
1019 negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value }
1020 negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value }
1021
1022 integralFractionalLit :: Integer -> FractionalLit
1023 integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
1024
1025 -- Comparison operations are needed when grouping literals
1026 -- for compiling pattern-matching (module MatchLit)
1027
1028 instance Eq FractionalLit where
1029   (==) = (==) `on` fl_value
1030
1031 instance Ord FractionalLit where
1032   compare = compare `on` fl_value
1033
1034 instance Outputable FractionalLit where
1035   ppr = text . fl_text
1036 \end{code}
1037
1038 \begin{code}
1039
1040 newtype HValue = HValue Any
1041
1042 \end{code}