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