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