0ae47377d73235cbc8795b6769962cb9121ba32b
[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     _            -> False
466
467 hasOverlappingFlag :: OverlapMode -> Bool
468 hasOverlappingFlag mode =
469   case mode of
470     Overlapping  -> True
471     Overlaps     -> True
472     _            -> False
473
474 data OverlapMode
475
476   {- | This instance must not overlap another `NoOverlap` instance.
477   However, it may be overlapped by `Overlapping` instances,
478   and it may overlap `Overlappable` instances. -}
479   = NoOverlap
480
481
482   {- | Silently ignore this instance if you find a
483   more specific one that matches the constraint
484   you are trying to resolve
485
486   Example: constraint (Foo [Int])
487     instance                      Foo [Int]
488     instance {-# OVERLAPPABLE #-} Foo [a]
489
490   Since the second instance has the Overlappable flag,
491   the first instance will be chosen (otherwise
492   its ambiguous which to choose) -}
493   | Overlappable
494
495
496   {- | Silently ignore any more general instances that may be
497        used to solve the constraint.
498
499   Example: constraint (Foo [Int])
500     instance {-# OVERLAPPING #-} Foo [Int]
501     instance                     Foo [a]
502
503   Since the first instance has the Overlapping flag,
504   the second---more general---instance will be ignored (otherwise
505   its ambiguous which to choose) -}
506   | Overlapping
507
508
509   -- | Equiavalent to having both `Overlapping` and `Overlappable` flags.
510   | Overlaps
511
512   -- | Silently ignore this instance if you find any other that matches the
513   -- constraing you are trying to resolve, including when checking if there are
514   -- instances that do not match, but unify.
515   --
516   -- Example: constraint (Foo [b])
517   -- instance {-# INCOHERENT -} Foo [Int]
518   -- instance                   Foo [a]
519   -- Without the Incoherent flag, we'd complain that
520   -- instantiating 'b' would change which instance
521   -- was chosen. See also note [Incoherent instances]
522   | Incoherent
523   deriving (Eq, Data, Typeable)
524
525
526 instance Outputable OverlapFlag where
527    ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
528
529 instance Outputable OverlapMode where
530    ppr NoOverlap    = empty
531    ppr Overlappable = ptext (sLit "[overlappable]")
532    ppr Overlapping  = ptext (sLit "[overlapping]")
533    ppr Overlaps     = ptext (sLit "[overlap ok]")
534    ppr Incoherent   = ptext (sLit "[incoherent]")
535
536 pprSafeOverlap :: Bool -> SDoc
537 pprSafeOverlap True  = ptext $ sLit "[safe]"
538 pprSafeOverlap False = empty
539 \end{code}
540
541 %************************************************************************
542 %*                                                                      *
543                 Tuples
544 %*                                                                      *
545 %************************************************************************
546
547 \begin{code}
548 data TupleSort
549   = BoxedTuple
550   | UnboxedTuple
551   | ConstraintTuple
552   deriving( Eq, Data, Typeable )
553
554 tupleSortBoxity :: TupleSort -> Boxity
555 tupleSortBoxity BoxedTuple     = Boxed
556 tupleSortBoxity UnboxedTuple   = Unboxed
557 tupleSortBoxity ConstraintTuple = Boxed
558
559 boxityNormalTupleSort :: Boxity -> TupleSort
560 boxityNormalTupleSort Boxed   = BoxedTuple
561 boxityNormalTupleSort Unboxed = UnboxedTuple
562
563 tupleParens :: TupleSort -> SDoc -> SDoc
564 tupleParens BoxedTuple      p = parens p
565 tupleParens ConstraintTuple p = parens p -- The user can't write fact tuples
566                                          -- directly, we overload the (,,) syntax
567 tupleParens UnboxedTuple p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
568 \end{code}
569
570 %************************************************************************
571 %*                                                                      *
572 \subsection[Generic]{Generic flag}
573 %*                                                                      *
574 %************************************************************************
575
576 This is the "Embedding-Projection pair" datatype, it contains
577 two pieces of code (normally either RenamedExpr's or Id's)
578 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
579 represents functions of type
580
581         from :: T -> Tring
582         to   :: Tring -> T
583
584 And we should have
585
586         to (from x) = x
587
588 T and Tring are arbitrary, but typically T is the 'main' type while
589 Tring is the 'representation' type.  (This just helps us remember
590 whether to use 'from' or 'to'.
591
592 \begin{code}
593 data EP a = EP { fromEP :: a,   -- :: T -> Tring
594                  toEP   :: a }  -- :: Tring -> T
595 \end{code}
596
597 Embedding-projection pairs are used in several places:
598
599 First of all, each type constructor has an EP associated with it, the
600 code in EP converts (datatype T) from T to Tring and back again.
601
602 Secondly, when we are filling in Generic methods (in the typechecker,
603 tcMethodBinds), we are constructing bimaps by induction on the structure
604 of the type of the method signature.
605
606
607 %************************************************************************
608 %*                                                                      *
609 \subsection{Occurrence information}
610 %*                                                                      *
611 %************************************************************************
612
613 This data type is used exclusively by the simplifier, but it appears in a
614 SubstResult, which is currently defined in VarEnv, which is pretty near
615 the base of the module hierarchy.  So it seemed simpler to put the
616 defn of OccInfo here, safely at the bottom
617
618 \begin{code}
619 -- | Identifier occurrence information
620 data OccInfo
621   = NoOccInfo           -- ^ There are many occurrences, or unknown occurrences
622
623   | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
624                         -- lambda and case-bound variables.
625
626   | OneOcc
627         !InsideLam
628         !OneBranch
629         !InterestingCxt -- ^ Occurs exactly once, not inside a rule
630
631   -- | This identifier breaks a loop of mutually recursive functions. The field
632   -- marks whether it is only a loop breaker due to a reference in a rule
633   | IAmALoopBreaker     -- Note [LoopBreaker OccInfo]
634         !RulesOnly
635
636 type RulesOnly = Bool
637 \end{code}
638
639 Note [LoopBreaker OccInfo]
640 ~~~~~~~~~~~~~~~~~~~~~~~~~~
641    IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
642                              Do not preInlineUnconditionally
643
644    IAmALoopBreaker False <=> A "strong" loop breaker
645                              Do not inline at all
646
647 See OccurAnal Note [Weak loop breakers]
648
649
650 \begin{code}
651 isNoOcc :: OccInfo -> Bool
652 isNoOcc NoOccInfo = True
653 isNoOcc _         = False
654
655 seqOccInfo :: OccInfo -> ()
656 seqOccInfo occ = occ `seq` ()
657
658 -----------------
659 type InterestingCxt = Bool      -- True <=> Function: is applied
660                                 --          Data value: scrutinised by a case with
661                                 --                      at least one non-DEFAULT branch
662
663 -----------------
664 type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
665                         -- Substituting a redex for this occurrence is
666                         -- dangerous because it might duplicate work.
667 insideLam, notInsideLam :: InsideLam
668 insideLam    = True
669 notInsideLam = False
670
671 -----------------
672 type OneBranch = Bool   -- True <=> Occurs in only one case branch
673                         --      so no code-duplication issue to worry about
674 oneBranch, notOneBranch :: OneBranch
675 oneBranch    = True
676 notOneBranch = False
677
678 strongLoopBreaker, weakLoopBreaker :: OccInfo
679 strongLoopBreaker = IAmALoopBreaker False
680 weakLoopBreaker   = IAmALoopBreaker True
681
682 isWeakLoopBreaker :: OccInfo -> Bool
683 isWeakLoopBreaker (IAmALoopBreaker _) = True
684 isWeakLoopBreaker _                   = False
685
686 isStrongLoopBreaker :: OccInfo -> Bool
687 isStrongLoopBreaker (IAmALoopBreaker False) = True   -- Loop-breaker that breaks a non-rule cycle
688 isStrongLoopBreaker _                       = False
689
690 isDeadOcc :: OccInfo -> Bool
691 isDeadOcc IAmDead = True
692 isDeadOcc _       = False
693
694 isOneOcc :: OccInfo -> Bool
695 isOneOcc (OneOcc {}) = True
696 isOneOcc _           = False
697
698 zapFragileOcc :: OccInfo -> OccInfo
699 zapFragileOcc (OneOcc {}) = NoOccInfo
700 zapFragileOcc occ         = occ
701 \end{code}
702
703 \begin{code}
704 instance Outputable OccInfo where
705   -- only used for debugging; never parsed.  KSW 1999-07
706   ppr NoOccInfo            = empty
707   ppr (IAmALoopBreaker ro) = ptext (sLit "LoopBreaker") <> if ro then char '!' else empty
708   ppr IAmDead              = ptext (sLit "Dead")
709   ppr (OneOcc inside_lam one_branch int_cxt)
710         = ptext (sLit "Once") <> pp_lam <> pp_br <> pp_args
711         where
712           pp_lam | inside_lam = char 'L'
713                  | otherwise  = empty
714           pp_br  | one_branch = empty
715                  | otherwise  = char '*'
716           pp_args | int_cxt   = char '!'
717                   | otherwise = empty
718 \end{code}
719
720 %************************************************************************
721 %*                                                                      *
722                 Default method specfication
723 %*                                                                      *
724 %************************************************************************
725
726 The DefMethSpec enumeration just indicates what sort of default method
727 is used for a class. It is generated from source code, and present in
728 interface files; it is converted to Class.DefMeth before begin put in a
729 Class object.
730
731 \begin{code}
732 data DefMethSpec = NoDM        -- No default method
733                  | VanillaDM   -- Default method given with polymorphic code
734                  | GenericDM   -- Default method given with generic code
735
736 instance Outputable DefMethSpec where
737   ppr NoDM      = empty
738   ppr VanillaDM = ptext (sLit "{- Has default method -}")
739   ppr GenericDM = ptext (sLit "{- Has generic default method -}")
740 \end{code}
741
742 %************************************************************************
743 %*                                                                      *
744 \subsection{Success flag}
745 %*                                                                      *
746 %************************************************************************
747
748 \begin{code}
749 data SuccessFlag = Succeeded | Failed
750
751 instance Outputable SuccessFlag where
752     ppr Succeeded = ptext (sLit "Succeeded")
753     ppr Failed    = ptext (sLit "Failed")
754
755 successIf :: Bool -> SuccessFlag
756 successIf True  = Succeeded
757 successIf False = Failed
758
759 succeeded, failed :: SuccessFlag -> Bool
760 succeeded Succeeded = True
761 succeeded Failed    = False
762
763 failed Succeeded = False
764 failed Failed    = True
765 \end{code}
766
767
768 %************************************************************************
769 %*                                                                      *
770 \subsection{Activation}
771 %*                                                                      *
772 %************************************************************************
773
774 When a rule or inlining is active
775
776 \begin{code}
777 type PhaseNum = Int  -- Compilation phase
778                      -- Phases decrease towards zero
779                      -- Zero is the last phase
780
781 data CompilerPhase
782   = Phase PhaseNum
783   | InitialPhase    -- The first phase -- number = infinity!
784
785 instance Outputable CompilerPhase where
786    ppr (Phase n)    = int n
787    ppr InitialPhase = ptext (sLit "InitialPhase")
788
789 data Activation = NeverActive
790                 | AlwaysActive
791                 | ActiveBefore PhaseNum -- Active only *before* this phase
792                 | ActiveAfter PhaseNum  -- Active in this phase and later
793                 deriving( Eq, Data, Typeable )  -- Eq used in comparing rules in HsDecls
794
795 data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
796                    | FunLike
797                    deriving( Eq, Data, Typeable, Show )
798         -- Show needed for Lexer.x
799
800 data InlinePragma            -- Note [InlinePragma]
801   = InlinePragma
802       { inl_inline :: InlineSpec
803
804       , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
805                                      --            explicit (non-type, non-dictionary) args
806                                      --   That is, inl_sat describes the number of *source-code*
807                                      --   arguments the thing must be applied to.  We add on the
808                                      --   number of implicit, dictionary arguments when making
809                                      --   the InlineRule, and don't look at inl_sat further
810
811       , inl_act    :: Activation     -- Says during which phases inlining is allowed
812
813       , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
814     } deriving( Eq, Data, Typeable )
815
816 data InlineSpec   -- What the user's INLINE pragama looked like
817   = Inline
818   | Inlinable
819   | NoInline
820   | EmptyInlineSpec  -- Used in a place-holder InlinePragma in SpecPrag or IdInfo,
821                      -- where there isn't any real inline pragma at all
822   deriving( Eq, Data, Typeable, Show )
823         -- Show needed for Lexer.x
824 \end{code}
825
826 Note [InlinePragma]
827 ~~~~~~~~~~~~~~~~~~~
828 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
829 the source program.
830
831 If you write nothing at all, you get defaultInlinePragma:
832    inl_inline = False
833    inl_act    = AlwaysActive
834    inl_rule   = FunLike
835
836 It's not possible to get that combination by *writing* something, so
837 if an Id has defaultInlinePragma it means the user didn't specify anything.
838
839 If inl_inline = True, then the Id should have an InlineRule unfolding.
840
841 Note [CONLIKE pragma]
842 ~~~~~~~~~~~~~~~~~~~~~
843 The ConLike constructor of a RuleMatchInfo is aimed at the following.
844 Consider first
845     {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
846     g b bs = let x = b:bs in ..x...x...(r x)...
847 Now, the rule applies to the (r x) term, because GHC "looks through"
848 the definition of 'x' to see that it is (b:bs).
849
850 Now consider
851     {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
852     g v = let x = f v in ..x...x...(r x)...
853 Normally the (r x) would *not* match the rule, because GHC would be
854 scared about duplicating the redex (f v), so it does not "look
855 through" the bindings.
856
857 However the CONLIKE modifier says to treat 'f' like a constructor in
858 this situation, and "look through" the unfolding for x.  So (r x)
859 fires, yielding (f (v+1)).
860
861 This is all controlled with a user-visible pragma:
862      {-# NOINLINE CONLIKE [1] f #-}
863
864 The main effects of CONLIKE are:
865
866     - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
867       CONLIKE thing like constructors, by ANF-ing them
868
869     - New function coreUtils.exprIsExpandable is like exprIsCheap, but
870       additionally spots applications of CONLIKE functions
871
872     - A CoreUnfolding has a field that caches exprIsExpandable
873
874     - The rule matcher consults this field.  See
875       Note [Expanding variables] in Rules.lhs.
876
877 \begin{code}
878 isConLike :: RuleMatchInfo -> Bool
879 isConLike ConLike = True
880 isConLike _            = False
881
882 isFunLike :: RuleMatchInfo -> Bool
883 isFunLike FunLike = True
884 isFunLike _            = False
885
886 isEmptyInlineSpec :: InlineSpec -> Bool
887 isEmptyInlineSpec EmptyInlineSpec = True
888 isEmptyInlineSpec _               = False
889
890 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
891   :: InlinePragma
892 defaultInlinePragma = InlinePragma { inl_act = AlwaysActive
893                                    , inl_rule = FunLike
894                                    , inl_inline = EmptyInlineSpec
895                                    , inl_sat = Nothing }
896
897 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
898 neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
899
900 inlinePragmaSpec :: InlinePragma -> InlineSpec
901 inlinePragmaSpec = inl_inline
902
903 -- A DFun has an always-active inline activation so that
904 -- exprIsConApp_maybe can "see" its unfolding
905 -- (However, its actual Unfolding is a DFunUnfolding, which is
906 --  never inlined other than via exprIsConApp_maybe.)
907 dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
908                                          , inl_rule = ConLike }
909
910 isDefaultInlinePragma :: InlinePragma -> Bool
911 isDefaultInlinePragma (InlinePragma { inl_act = activation
912                                     , inl_rule = match_info
913                                     , inl_inline = inline })
914   = isEmptyInlineSpec inline && isAlwaysActive activation && isFunLike match_info
915
916 isInlinePragma :: InlinePragma -> Bool
917 isInlinePragma prag = case inl_inline prag of
918                         Inline -> True
919                         _      -> False
920
921 isInlinablePragma :: InlinePragma -> Bool
922 isInlinablePragma prag = case inl_inline prag of
923                            Inlinable -> True
924                            _         -> False
925
926 isAnyInlinePragma :: InlinePragma -> Bool
927 -- INLINE or INLINABLE
928 isAnyInlinePragma prag = case inl_inline prag of
929                         Inline    -> True
930                         Inlinable -> True
931                         _         -> False
932
933 inlinePragmaSat :: InlinePragma -> Maybe Arity
934 inlinePragmaSat = inl_sat
935
936 inlinePragmaActivation :: InlinePragma -> Activation
937 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
938
939 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
940 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
941
942 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
943 setInlinePragmaActivation prag activation = prag { inl_act = activation }
944
945 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
946 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
947
948 instance Outputable Activation where
949    ppr AlwaysActive     = brackets (ptext (sLit "ALWAYS"))
950    ppr NeverActive      = brackets (ptext (sLit "NEVER"))
951    ppr (ActiveBefore n) = brackets (char '~' <> int n)
952    ppr (ActiveAfter n)  = brackets (int n)
953
954 instance Outputable RuleMatchInfo where
955    ppr ConLike = ptext (sLit "CONLIKE")
956    ppr FunLike = ptext (sLit "FUNLIKE")
957
958 instance Outputable InlineSpec where
959    ppr Inline          = ptext (sLit "INLINE")
960    ppr NoInline        = ptext (sLit "NOINLINE")
961    ppr Inlinable       = ptext (sLit "INLINABLE")
962    ppr EmptyInlineSpec = empty
963
964 instance Outputable InlinePragma where
965   ppr (InlinePragma { inl_inline = inline, inl_act = activation
966                     , inl_rule = info, inl_sat = mb_arity })
967     = ppr inline <> pp_act inline activation <+> pp_sat <+> pp_info
968     where
969       pp_act Inline   AlwaysActive = empty
970       pp_act NoInline NeverActive  = empty
971       pp_act _        act          = ppr act
972
973       pp_sat | Just ar <- mb_arity = parens (ptext (sLit "sat-args=") <> int ar)
974              | otherwise           = empty
975       pp_info | isFunLike info = empty
976               | otherwise      = ppr info
977
978 isActive :: CompilerPhase -> Activation -> Bool
979 isActive InitialPhase AlwaysActive      = True
980 isActive InitialPhase (ActiveBefore {}) = True
981 isActive InitialPhase _                 = False
982 isActive (Phase p)    act               = isActiveIn p act
983
984 isActiveIn :: PhaseNum -> Activation -> Bool
985 isActiveIn _ NeverActive      = False
986 isActiveIn _ AlwaysActive     = True
987 isActiveIn p (ActiveAfter n)  = p <= n
988 isActiveIn p (ActiveBefore n) = p >  n
989
990 isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
991 isNeverActive NeverActive = True
992 isNeverActive _           = False
993
994 isAlwaysActive AlwaysActive = True
995 isAlwaysActive _            = False
996
997 isEarlyActive AlwaysActive      = True
998 isEarlyActive (ActiveBefore {}) = True
999 isEarlyActive _                 = False
1000 \end{code}
1001
1002
1003
1004 \begin{code}
1005 -- Used (instead of Rational) to represent exactly the floating point literal that we
1006 -- encountered in the user's source program. This allows us to pretty-print exactly what
1007 -- the user wrote, which is important e.g. for floating point numbers that can't represented
1008 -- as Doubles (we used to via Double for pretty-printing). See also #2245.
1009 data FractionalLit
1010   = FL { fl_text :: String         -- How the value was written in the source
1011        , fl_value :: Rational      -- Numeric value of the literal
1012        }
1013   deriving (Data, Typeable, Show)
1014   -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
1015
1016 negateFractionalLit :: FractionalLit -> FractionalLit
1017 negateFractionalLit (FL { fl_text = '-':text, fl_value = value }) = FL { fl_text = text, fl_value = negate value }
1018 negateFractionalLit (FL { fl_text = text, fl_value = value }) = FL { fl_text = '-':text, fl_value = negate value }
1019
1020 integralFractionalLit :: Integer -> FractionalLit
1021 integralFractionalLit i = FL { fl_text = show i, fl_value = fromInteger i }
1022
1023 -- Comparison operations are needed when grouping literals
1024 -- for compiling pattern-matching (module MatchLit)
1025
1026 instance Eq FractionalLit where
1027   (==) = (==) `on` fl_value
1028
1029 instance Ord FractionalLit where
1030   compare = compare `on` fl_value
1031
1032 instance Outputable FractionalLit where
1033   ppr = text . fl_text
1034 \end{code}
1035
1036 \begin{code}
1037
1038 newtype HValue = HValue Any
1039
1040 \end{code}