never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4
5 \section[BasicTypes]{Miscellaneous 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
17 {-# LANGUAGE DeriveDataTypeable #-}
18 {-# LANGUAGE MultiParamTypeClasses #-}
19 {-# LANGUAGE FlexibleInstances #-}
20
21 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
22
23 module GHC.Types.Basic (
24 LeftOrRight(..),
25 pickLR,
26
27 ConTag, ConTagZ, fIRST_TAG,
28
29 Arity, RepArity, JoinArity, FullArgCount,
30
31 Alignment, mkAlignment, alignmentOf, alignmentBytes,
32
33 PromotionFlag(..), isPromoted,
34 FunctionOrData(..),
35
36 RecFlag(..), isRec, isNonRec, boolToRecFlag,
37 Origin(..), isGenerated,
38
39 RuleName, pprRuleName,
40
41 TopLevelFlag(..), isTopLevel, isNotTopLevel,
42
43 OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
44 hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
45
46 Boxity(..), isBoxed,
47
48 PprPrec(..), topPrec, sigPrec, opPrec, funPrec, starPrec, appPrec,
49 maybeParen,
50
51 TupleSort(..), tupleSortBoxity, boxityTupleSort,
52 tupleParens,
53
54 sumParens, pprAlternative,
55
56 -- ** The OneShotInfo type
57 OneShotInfo(..),
58 noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
59 bestOneShot, worstOneShot,
60
61 OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
62 isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
63 isNoOccInfo, strongLoopBreaker, weakLoopBreaker,
64
65 InsideLam(..),
66 BranchCount, oneBranch,
67 InterestingCxt(..),
68 TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
69 isAlwaysTailCalled,
70
71 EP(..),
72
73 DefMethSpec(..),
74 SwapFlag(..), flipSwap, unSwap, isSwapped,
75
76 CompilerPhase(..), PhaseNum,
77
78 Activation(..), isActive, competesWith,
79 isNeverActive, isAlwaysActive, activeInFinalPhase,
80 activateAfterInitial, activateDuringFinal,
81
82 RuleMatchInfo(..), isConLike, isFunLike,
83 InlineSpec(..), noUserInlineSpec,
84 InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
85 neverInlinePragma, dfunInlinePragma,
86 isDefaultInlinePragma,
87 isInlinePragma, isInlinablePragma, isNoInlinePragma,
88 isAnyInlinePragma, alwaysInlineConLikePragma,
89 inlinePragmaSource,
90 inlinePragmaName, inlineSpecSource,
91 inlinePragmaSpec, inlinePragmaSat,
92 inlinePragmaActivation, inlinePragmaRuleMatchInfo,
93 setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
94 pprInline, pprInlineDebug,
95
96 SuccessFlag(..), succeeded, failed, successIf,
97
98 IntWithInf, infinity, treatZeroAsInf, subWithInf, mkIntWithInf, intGtLimit,
99
100 SpliceExplicitFlag(..),
101
102 TypeOrKind(..), isTypeLevel, isKindLevel,
103
104 DefaultKindVars(..), DefaultVarsOfKind(..),
105 allVarsOfKindDefault, noVarsOfKindDefault,
106
107 ForeignSrcLang (..)
108 ) where
109
110 import GHC.Prelude
111
112 import GHC.ForeignSrcLang
113 import GHC.Data.FastString
114 import GHC.Utils.Outputable
115 import GHC.Utils.Panic
116 import GHC.Utils.Binary
117 import GHC.Types.SourceText
118 import Data.Data
119 import qualified Data.Semigroup as Semi
120
121 {-
122 ************************************************************************
123 * *
124 Binary choice
125 * *
126 ************************************************************************
127 -}
128
129 data LeftOrRight = CLeft | CRight
130 deriving( Eq, Data )
131
132 pickLR :: LeftOrRight -> (a,a) -> a
133 pickLR CLeft (l,_) = l
134 pickLR CRight (_,r) = r
135
136 instance Outputable LeftOrRight where
137 ppr CLeft = text "Left"
138 ppr CRight = text "Right"
139
140 instance Binary LeftOrRight where
141 put_ bh CLeft = putByte bh 0
142 put_ bh CRight = putByte bh 1
143
144 get bh = do { h <- getByte bh
145 ; case h of
146 0 -> return CLeft
147 _ -> return CRight }
148
149
150 {-
151 ************************************************************************
152 * *
153 \subsection[Arity]{Arity}
154 * *
155 ************************************************************************
156 -}
157
158 -- | The number of value arguments that can be applied to a value before it does
159 -- "real work". So:
160 -- fib 100 has arity 0
161 -- \x -> fib x has arity 1
162 -- See also Note [Definition of arity] in "GHC.Core.Opt.Arity"
163 type Arity = Int
164
165 -- | Representation Arity
166 --
167 -- The number of represented arguments that can be applied to a value before it does
168 -- "real work". So:
169 -- fib 100 has representation arity 0
170 -- \x -> fib x has representation arity 1
171 -- \(# x, y #) -> fib (x + y) has representation arity 2
172 type RepArity = Int
173
174 -- | The number of arguments that a join point takes. Unlike the arity of a
175 -- function, this is a purely syntactic property and is fixed when the join
176 -- point is created (or converted from a value). Both type and value arguments
177 -- are counted.
178 type JoinArity = Int
179
180 -- | FullArgCount is the number of type or value arguments in an application,
181 -- or the number of type or value binders in a lambda. Note: it includes
182 -- both type and value arguments!
183 type FullArgCount = Int
184
185 {-
186 ************************************************************************
187 * *
188 Constructor tags
189 * *
190 ************************************************************************
191 -}
192
193 -- | A *one-index* constructor tag
194 --
195 -- Type of the tags associated with each constructor possibility or superclass
196 -- selector
197 type ConTag = Int
198
199 -- | A *zero-indexed* constructor tag
200 type ConTagZ = Int
201
202 fIRST_TAG :: ConTag
203 -- ^ Tags are allocated from here for real constructors
204 -- or for superclass selectors
205 fIRST_TAG = 1
206
207 {-
208 ************************************************************************
209 * *
210 \subsection[Alignment]{Alignment}
211 * *
212 ************************************************************************
213 -}
214
215 -- | A power-of-two alignment
216 newtype Alignment = Alignment { alignmentBytes :: Int } deriving (Eq, Ord)
217
218 -- Builds an alignment, throws on non power of 2 input. This is not
219 -- ideal, but convenient for internal use and better then silently
220 -- passing incorrect data.
221 mkAlignment :: Int -> Alignment
222 mkAlignment n
223 | n == 1 = Alignment 1
224 | n == 2 = Alignment 2
225 | n == 4 = Alignment 4
226 | n == 8 = Alignment 8
227 | n == 16 = Alignment 16
228 | n == 32 = Alignment 32
229 | n == 64 = Alignment 64
230 | n == 128 = Alignment 128
231 | n == 256 = Alignment 256
232 | n == 512 = Alignment 512
233 | otherwise = panic "mkAlignment: received either a non power of 2 argument or > 512"
234
235 -- Calculates an alignment of a number. x is aligned at N bytes means
236 -- the remainder from x / N is zero. Currently, interested in N <= 8,
237 -- but can be expanded to N <= 16 or N <= 32 if used within SSE or AVX
238 -- context.
239 alignmentOf :: Int -> Alignment
240 alignmentOf x = case x .&. 7 of
241 0 -> Alignment 8
242 4 -> Alignment 4
243 2 -> Alignment 2
244 _ -> Alignment 1
245
246 instance Outputable Alignment where
247 ppr (Alignment m) = ppr m
248
249 instance OutputableP env Alignment where
250 pdoc _ = ppr
251
252 {-
253 ************************************************************************
254 * *
255 One-shot information
256 * *
257 ************************************************************************
258 -}
259
260 {-
261 Note [OneShotInfo overview]
262 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
263 Lambda-bound Ids (and only lambda-bound Ids) may be decorated with
264 one-shot info. The idea is that if we see
265 (\x{one-shot}. e)
266 it means that this lambda will only be applied once. In particular
267 that means we can float redexes under the lambda without losing
268 work. For example, consider
269 let t = expensive in
270 (\x{one-shot}. case t of { True -> ...; False -> ... })
271
272 Because it's a one-shot lambda, we can safely inline t, giving
273 (\x{one_shot}. case <expensive> of
274 { True -> ...; False -> ... })
275
276 Moving parts:
277
278 * Usage analysis, performed as part of demand-analysis, finds
279 out whether functions call their argument once. Consider
280 f g x = Just (case g x of { ... })
281
282 Here 'f' is lazy in 'g', but it guarantees to call it no
283 more than once. So g will get a C1(U) usage demand.
284
285 * Occurrence analysis propagates this usage information
286 (in the demand signature of a function) to its calls.
287 Example, given 'f' above
288 f (\x.e) blah
289
290 Since f's demand signature says it has a C1(U) usage demand on its
291 first argument, the occurrence analyser sets the \x to be one-shot.
292 This is done via the occ_one_shots field of OccEnv.
293
294 * Float-in and float-out take account of one-shot-ness
295
296 * Occurrence analysis doesn't set "inside-lam" for occurrences inside
297 a one-shot lambda
298
299 Other notes
300
301 * A one-shot lambda can use its argument many times. To elaborate
302 the example above
303 let t = expensive in
304 (\x{one-shot}. case t of { True -> x+x; False -> x*x })
305
306 Here the '\x' is one-shot, which justifies inlining 't',
307 but x is used many times. That's absolutely fine.
308
309 * It's entirely possible to have
310 (\x{one-shot}. \y{many-shot}. e)
311
312 For example
313 let t = expensive
314 g = \x -> let v = x+t in
315 \y -> x + v
316 in map (g 5) xs
317
318 Here the `\x` is a one-shot binder: `g` is applied to one argument
319 exactly once. And because the `\x` is one-shot, it would be fine to
320 float that `let t = expensive` binding inside the `\x`.
321
322 But the `\y` is most definitely not one-shot!
323 -}
324
325 -- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
326 -- variable info. Sometimes we know whether the lambda binding this variable
327 -- is a "one-shot" lambda; that is, whether it is applied at most once.
328 --
329 -- This information may be useful in optimisation, as computations may
330 -- safely be floated inside such a lambda without risk of duplicating
331 -- work.
332 --
333 -- See also Note [OneShotInfo overview] above.
334 data OneShotInfo
335 = NoOneShotInfo -- ^ No information
336 | OneShotLam -- ^ The lambda is applied at most once.
337 deriving (Eq)
338
339 -- | It is always safe to assume that an 'Id' has no lambda-bound variable information
340 noOneShotInfo :: OneShotInfo
341 noOneShotInfo = NoOneShotInfo
342
343 isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
344 isOneShotInfo OneShotLam = True
345 isOneShotInfo _ = False
346
347 hasNoOneShotInfo NoOneShotInfo = True
348 hasNoOneShotInfo _ = False
349
350 worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
351 worstOneShot NoOneShotInfo _ = NoOneShotInfo
352 worstOneShot OneShotLam os = os
353
354 bestOneShot NoOneShotInfo os = os
355 bestOneShot OneShotLam _ = OneShotLam
356
357 pprOneShotInfo :: OneShotInfo -> SDoc
358 pprOneShotInfo NoOneShotInfo = empty
359 pprOneShotInfo OneShotLam = text "OneShot"
360
361 instance Outputable OneShotInfo where
362 ppr = pprOneShotInfo
363
364 {-
365 ************************************************************************
366 * *
367 Swap flag
368 * *
369 ************************************************************************
370 -}
371
372 data SwapFlag
373 = NotSwapped -- Args are: actual, expected
374 | IsSwapped -- Args are: expected, actual
375
376 instance Outputable SwapFlag where
377 ppr IsSwapped = text "Is-swapped"
378 ppr NotSwapped = text "Not-swapped"
379
380 flipSwap :: SwapFlag -> SwapFlag
381 flipSwap IsSwapped = NotSwapped
382 flipSwap NotSwapped = IsSwapped
383
384 isSwapped :: SwapFlag -> Bool
385 isSwapped IsSwapped = True
386 isSwapped NotSwapped = False
387
388 unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
389 unSwap NotSwapped f a b = f a b
390 unSwap IsSwapped f a b = f b a
391
392
393 {- *********************************************************************
394 * *
395 Promotion flag
396 * *
397 ********************************************************************* -}
398
399 -- | Is a TyCon a promoted data constructor or just a normal type constructor?
400 data PromotionFlag
401 = NotPromoted
402 | IsPromoted
403 deriving ( Eq, Data )
404
405 isPromoted :: PromotionFlag -> Bool
406 isPromoted IsPromoted = True
407 isPromoted NotPromoted = False
408
409 instance Outputable PromotionFlag where
410 ppr NotPromoted = text "NotPromoted"
411 ppr IsPromoted = text "IsPromoted"
412
413 instance Binary PromotionFlag where
414 put_ bh NotPromoted = putByte bh 0
415 put_ bh IsPromoted = putByte bh 1
416
417 get bh = do
418 n <- getByte bh
419 case n of
420 0 -> return NotPromoted
421 1 -> return IsPromoted
422 _ -> fail "Binary(IsPromoted): fail)"
423
424 {-
425 ************************************************************************
426 * *
427 \subsection[FunctionOrData]{FunctionOrData}
428 * *
429 ************************************************************************
430 -}
431
432 data FunctionOrData = IsFunction | IsData
433 deriving (Eq, Ord, Data)
434
435 instance Outputable FunctionOrData where
436 ppr IsFunction = text "(function)"
437 ppr IsData = text "(data)"
438
439 instance Binary FunctionOrData where
440 put_ bh IsFunction = putByte bh 0
441 put_ bh IsData = putByte bh 1
442 get bh = do
443 h <- getByte bh
444 case h of
445 0 -> return IsFunction
446 1 -> return IsData
447 _ -> panic "Binary FunctionOrData"
448
449 {-
450 ************************************************************************
451 * *
452 Rules
453 * *
454 ************************************************************************
455 -}
456
457 type RuleName = FastString
458
459 pprRuleName :: RuleName -> SDoc
460 pprRuleName rn = doubleQuotes (ftext rn)
461
462
463 {-
464 ************************************************************************
465 * *
466 \subsection[Top-level/local]{Top-level/not-top level flag}
467 * *
468 ************************************************************************
469 -}
470
471 data TopLevelFlag
472 = TopLevel
473 | NotTopLevel
474 deriving Data
475
476 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
477
478 isNotTopLevel NotTopLevel = True
479 isNotTopLevel TopLevel = False
480
481 isTopLevel TopLevel = True
482 isTopLevel NotTopLevel = False
483
484 instance Outputable TopLevelFlag where
485 ppr TopLevel = text "<TopLevel>"
486 ppr NotTopLevel = text "<NotTopLevel>"
487
488 {-
489 ************************************************************************
490 * *
491 Boxity flag
492 * *
493 ************************************************************************
494 -}
495
496 data Boxity
497 = Boxed
498 | Unboxed
499 deriving( Eq, Data )
500
501 isBoxed :: Boxity -> Bool
502 isBoxed Boxed = True
503 isBoxed Unboxed = False
504
505 instance Outputable Boxity where
506 ppr Boxed = text "Boxed"
507 ppr Unboxed = text "Unboxed"
508
509 instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
510 put_ bh = put_ bh . isBoxed
511 get bh = do
512 b <- get bh
513 pure $ if b then Boxed else Unboxed
514
515 {-
516 ************************************************************************
517 * *
518 Recursive/Non-Recursive flag
519 * *
520 ************************************************************************
521 -}
522
523 -- | Recursivity Flag
524 data RecFlag = Recursive
525 | NonRecursive
526 deriving( Eq, Data )
527
528 isRec :: RecFlag -> Bool
529 isRec Recursive = True
530 isRec NonRecursive = False
531
532 isNonRec :: RecFlag -> Bool
533 isNonRec Recursive = False
534 isNonRec NonRecursive = True
535
536 boolToRecFlag :: Bool -> RecFlag
537 boolToRecFlag True = Recursive
538 boolToRecFlag False = NonRecursive
539
540 instance Outputable RecFlag where
541 ppr Recursive = text "Recursive"
542 ppr NonRecursive = text "NonRecursive"
543
544 instance Binary RecFlag where
545 put_ bh Recursive =
546 putByte bh 0
547 put_ bh NonRecursive =
548 putByte bh 1
549 get bh = do
550 h <- getByte bh
551 case h of
552 0 -> return Recursive
553 _ -> return NonRecursive
554
555 {-
556 ************************************************************************
557 * *
558 Code origin
559 * *
560 ************************************************************************
561 -}
562
563 data Origin = FromSource
564 | Generated
565 deriving( Eq, Data )
566
567 isGenerated :: Origin -> Bool
568 isGenerated Generated = True
569 isGenerated FromSource = False
570
571 instance Outputable Origin where
572 ppr FromSource = text "FromSource"
573 ppr Generated = text "Generated"
574
575 {-
576 ************************************************************************
577 * *
578 Instance overlap flag
579 * *
580 ************************************************************************
581 -}
582
583 -- | The semantics allowed for overlapping instances for a particular
584 -- instance. See Note [Safe Haskell isSafeOverlap] (in "GHC.Core.InstEnv") for a
585 -- explanation of the `isSafeOverlap` field.
586 --
587 -- - 'GHC.Parser.Annotation.AnnKeywordId' :
588 -- 'GHC.Parser.Annotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
589 -- @'\{-\# OVERLAPPING'@ or
590 -- @'\{-\# OVERLAPS'@ or
591 -- @'\{-\# INCOHERENT'@,
592 -- 'GHC.Parser.Annotation.AnnClose' @`\#-\}`@,
593
594 -- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
595 data OverlapFlag = OverlapFlag
596 { overlapMode :: OverlapMode
597 , isSafeOverlap :: Bool
598 } deriving (Eq, Data)
599
600 setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
601 setOverlapModeMaybe f Nothing = f
602 setOverlapModeMaybe f (Just m) = f { overlapMode = m }
603
604 hasIncoherentFlag :: OverlapMode -> Bool
605 hasIncoherentFlag mode =
606 case mode of
607 Incoherent _ -> True
608 _ -> False
609
610 hasOverlappableFlag :: OverlapMode -> Bool
611 hasOverlappableFlag mode =
612 case mode of
613 Overlappable _ -> True
614 Overlaps _ -> True
615 Incoherent _ -> True
616 _ -> False
617
618 hasOverlappingFlag :: OverlapMode -> Bool
619 hasOverlappingFlag mode =
620 case mode of
621 Overlapping _ -> True
622 Overlaps _ -> True
623 Incoherent _ -> True
624 _ -> False
625
626 data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
627 = NoOverlap SourceText
628 -- See Note [Pragma source text]
629 -- ^ This instance must not overlap another `NoOverlap` instance.
630 -- However, it may be overlapped by `Overlapping` instances,
631 -- and it may overlap `Overlappable` instances.
632
633
634 | Overlappable SourceText
635 -- See Note [Pragma source text]
636 -- ^ Silently ignore this instance if you find a
637 -- more specific one that matches the constraint
638 -- you are trying to resolve
639 --
640 -- Example: constraint (Foo [Int])
641 -- instance Foo [Int]
642 -- instance {-# OVERLAPPABLE #-} Foo [a]
643 --
644 -- Since the second instance has the Overlappable flag,
645 -- the first instance will be chosen (otherwise
646 -- its ambiguous which to choose)
647
648
649 | Overlapping SourceText
650 -- See Note [Pragma source text]
651 -- ^ Silently ignore any more general instances that may be
652 -- used to solve the constraint.
653 --
654 -- Example: constraint (Foo [Int])
655 -- instance {-# OVERLAPPING #-} Foo [Int]
656 -- instance Foo [a]
657 --
658 -- Since the first instance has the Overlapping flag,
659 -- the second---more general---instance will be ignored (otherwise
660 -- it is ambiguous which to choose)
661
662
663 | Overlaps SourceText
664 -- See Note [Pragma source text]
665 -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
666
667 | Incoherent SourceText
668 -- See Note [Pragma source text]
669 -- ^ Behave like Overlappable and Overlapping, and in addition pick
670 -- an arbitrary one if there are multiple matching candidates, and
671 -- don't worry about later instantiation
672 --
673 -- Example: constraint (Foo [b])
674 -- instance {-# INCOHERENT -} Foo [Int]
675 -- instance Foo [a]
676 -- Without the Incoherent flag, we'd complain that
677 -- instantiating 'b' would change which instance
678 -- was chosen. See also note [Incoherent instances] in "GHC.Core.InstEnv"
679
680 deriving (Eq, Data)
681
682
683 instance Outputable OverlapFlag where
684 ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
685
686 instance Outputable OverlapMode where
687 ppr (NoOverlap _) = empty
688 ppr (Overlappable _) = text "[overlappable]"
689 ppr (Overlapping _) = text "[overlapping]"
690 ppr (Overlaps _) = text "[overlap ok]"
691 ppr (Incoherent _) = text "[incoherent]"
692
693 instance Binary OverlapMode where
694 put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s
695 put_ bh (Overlaps s) = putByte bh 1 >> put_ bh s
696 put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s
697 put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s
698 put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s
699 get bh = do
700 h <- getByte bh
701 case h of
702 0 -> (get bh) >>= \s -> return $ NoOverlap s
703 1 -> (get bh) >>= \s -> return $ Overlaps s
704 2 -> (get bh) >>= \s -> return $ Incoherent s
705 3 -> (get bh) >>= \s -> return $ Overlapping s
706 4 -> (get bh) >>= \s -> return $ Overlappable s
707 _ -> panic ("get OverlapMode" ++ show h)
708
709
710 instance Binary OverlapFlag where
711 put_ bh flag = do put_ bh (overlapMode flag)
712 put_ bh (isSafeOverlap flag)
713 get bh = do
714 h <- get bh
715 b <- get bh
716 return OverlapFlag { overlapMode = h, isSafeOverlap = b }
717
718 pprSafeOverlap :: Bool -> SDoc
719 pprSafeOverlap True = text "[safe]"
720 pprSafeOverlap False = empty
721
722 {-
723 ************************************************************************
724 * *
725 Precedence
726 * *
727 ************************************************************************
728 -}
729
730 -- | A general-purpose pretty-printing precedence type.
731 newtype PprPrec = PprPrec Int deriving (Eq, Ord, Show)
732 -- See Note [Precedence in types]
733
734 topPrec, sigPrec, funPrec, opPrec, starPrec, appPrec :: PprPrec
735 topPrec = PprPrec 0 -- No parens
736 sigPrec = PprPrec 1 -- Explicit type signatures
737 funPrec = PprPrec 2 -- Function args; no parens for constructor apps
738 -- See [Type operator precedence] for why both
739 -- funPrec and opPrec exist.
740 opPrec = PprPrec 2 -- Infix operator
741 starPrec = PprPrec 3 -- Star syntax for the type of types, i.e. the * in (* -> *)
742 -- See Note [Star kind precedence]
743 appPrec = PprPrec 4 -- Constructor args; no parens for atomic
744
745 maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc
746 maybeParen ctxt_prec inner_prec pretty
747 | ctxt_prec < inner_prec = pretty
748 | otherwise = parens pretty
749
750 {- Note [Precedence in types]
751 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
752 Many pretty-printing functions have type
753 ppr_ty :: PprPrec -> Type -> SDoc
754
755 The PprPrec gives the binding strength of the context. For example, in
756 T ty1 ty2
757 we will pretty-print 'ty1' and 'ty2' with the call
758 (ppr_ty appPrec ty)
759 to indicate that the context is that of an argument of a TyConApp.
760
761 We use this consistently for Type and HsType.
762
763 Note [Type operator precedence]
764 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
765 We don't keep the fixity of type operators in the operator. So the
766 pretty printer follows the following precedence order:
767
768 TyConPrec Type constructor application
769 TyOpPrec/FunPrec Operator application and function arrow
770
771 We have funPrec and opPrec to represent the precedence of function
772 arrow and type operators respectively, but currently we implement
773 funPrec == opPrec, so that we don't distinguish the two. Reason:
774 it's hard to parse a type like
775 a ~ b => c * d -> e - f
776
777 By treating opPrec = funPrec we end up with more parens
778 (a ~ b) => (c * d) -> (e - f)
779
780 But the two are different constructors of PprPrec so we could make
781 (->) bind more or less tightly if we wanted.
782
783 Note [Star kind precedence]
784 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
785 We parenthesize the (*) kind to avoid two issues:
786
787 1. Printing invalid or incorrect code.
788 For example, instead of type F @(*) x = x
789 GHC used to print type F @* x = x
790 However, (@*) is a type operator, not a kind application.
791
792 2. Printing kinds that are correct but hard to read.
793 Should Either * Int be read as Either (*) Int
794 or as (*) Either Int ?
795 This depends on whether -XStarIsType is enabled, but it would be
796 easier if we didn't have to check for the flag when reading the code.
797
798 At the same time, we cannot parenthesize (*) blindly.
799 Consider this Haskell98 kind: ((* -> *) -> *) -> *
800 With parentheses, it is less readable: (((*) -> (*)) -> (*)) -> (*)
801
802 The solution is to assign a special precedence to (*), 'starPrec', which is
803 higher than 'funPrec' but lower than 'appPrec':
804
805 F * * * becomes F (*) (*) (*)
806 F A * B becomes F A (*) B
807 Proxy * becomes Proxy (*)
808 a * -> * becomes a (*) -> *
809 -}
810
811 {-
812 ************************************************************************
813 * *
814 Tuples
815 * *
816 ************************************************************************
817 -}
818
819 data TupleSort
820 = BoxedTuple
821 | UnboxedTuple
822 | ConstraintTuple
823 deriving( Eq, Data )
824
825 instance Outputable TupleSort where
826 ppr ts = text $
827 case ts of
828 BoxedTuple -> "BoxedTuple"
829 UnboxedTuple -> "UnboxedTuple"
830 ConstraintTuple -> "ConstraintTuple"
831
832 instance Binary TupleSort where
833 put_ bh BoxedTuple = putByte bh 0
834 put_ bh UnboxedTuple = putByte bh 1
835 put_ bh ConstraintTuple = putByte bh 2
836 get bh = do
837 h <- getByte bh
838 case h of
839 0 -> return BoxedTuple
840 1 -> return UnboxedTuple
841 _ -> return ConstraintTuple
842
843
844 tupleSortBoxity :: TupleSort -> Boxity
845 tupleSortBoxity BoxedTuple = Boxed
846 tupleSortBoxity UnboxedTuple = Unboxed
847 tupleSortBoxity ConstraintTuple = Boxed
848
849 boxityTupleSort :: Boxity -> TupleSort
850 boxityTupleSort Boxed = BoxedTuple
851 boxityTupleSort Unboxed = UnboxedTuple
852
853 tupleParens :: TupleSort -> SDoc -> SDoc
854 tupleParens BoxedTuple p = parens p
855 tupleParens UnboxedTuple p = text "(#" <+> p <+> text "#)"
856 tupleParens ConstraintTuple p -- In debug-style write (% Eq a, Ord b %)
857 = ifPprDebug (text "(%" <+> p <+> text "%)")
858 (parens p)
859
860 {-
861 ************************************************************************
862 * *
863 Sums
864 * *
865 ************************************************************************
866 -}
867
868 sumParens :: SDoc -> SDoc
869 sumParens p = text "(#" <+> p <+> text "#)"
870
871 -- | Pretty print an alternative in an unboxed sum e.g. "| a | |".
872 pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use
873 -> a -- ^ The things to be pretty printed
874 -> ConTag -- ^ Alternative (one-based)
875 -> Arity -- ^ Arity
876 -> SDoc -- ^ 'SDoc' where the alternative havs been pretty
877 -- printed and finally packed into a paragraph.
878 pprAlternative pp x alt arity =
879 fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)
880
881 {-
882 ************************************************************************
883 * *
884 \subsection[Generic]{Generic flag}
885 * *
886 ************************************************************************
887
888 This is the "Embedding-Projection pair" datatype, it contains
889 two pieces of code (normally either RenamedExpr's or Id's)
890 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
891 represents functions of type
892
893 from :: T -> Tring
894 to :: Tring -> T
895
896 And we should have
897
898 to (from x) = x
899
900 T and Tring are arbitrary, but typically T is the 'main' type while
901 Tring is the 'representation' type. (This just helps us remember
902 whether to use 'from' or 'to'.
903 -}
904
905 -- | Embedding Projection pair
906 data EP a = EP { fromEP :: a, -- :: T -> Tring
907 toEP :: a } -- :: Tring -> T
908
909 {-
910 Embedding-projection pairs are used in several places:
911
912 First of all, each type constructor has an EP associated with it, the
913 code in EP converts (datatype T) from T to Tring and back again.
914
915 Secondly, when we are filling in Generic methods (in the typechecker,
916 tcMethodBinds), we are constructing bimaps by induction on the structure
917 of the type of the method signature.
918
919
920 ************************************************************************
921 * *
922 \subsection{Occurrence information}
923 * *
924 ************************************************************************
925
926 This data type is used exclusively by the simplifier, but it appears in a
927 SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty
928 near the base of the module hierarchy. So it seemed simpler to put the defn of
929 OccInfo here, safely at the bottom
930 -}
931
932 -- | identifier Occurrence Information
933 data OccInfo
934 = ManyOccs { occ_tail :: !TailCallInfo }
935 -- ^ There are many occurrences, or unknown occurrences
936
937 | IAmDead -- ^ Marks unused variables. Sometimes useful for
938 -- lambda and case-bound variables.
939
940 | OneOcc { occ_in_lam :: !InsideLam
941 , occ_n_br :: {-# UNPACK #-} !BranchCount
942 , occ_int_cxt :: !InterestingCxt
943 , occ_tail :: !TailCallInfo }
944 -- ^ Occurs exactly once (per branch), not inside a rule
945
946 -- | This identifier breaks a loop of mutually recursive functions. The field
947 -- marks whether it is only a loop breaker due to a reference in a rule
948 | IAmALoopBreaker { occ_rules_only :: !RulesOnly
949 , occ_tail :: !TailCallInfo }
950 -- Note [LoopBreaker OccInfo]
951 deriving (Eq)
952
953 type RulesOnly = Bool
954
955 type BranchCount = Int
956 -- For OneOcc, the BranchCount says how many syntactic occurrences there are
957 -- At the moment we really only check for 1 or >1, but in principle
958 -- we could pay attention to how *many* occurrences there are
959 -- (notably in postInlineUnconditionally).
960 -- But meanwhile, Ints are very efficiently represented.
961
962 oneBranch :: BranchCount
963 oneBranch = 1
964
965 {-
966 Note [LoopBreaker OccInfo]
967 ~~~~~~~~~~~~~~~~~~~~~~~~~~
968 IAmALoopBreaker True <=> A "weak" or rules-only loop breaker
969 Do not preInlineUnconditionally
970
971 IAmALoopBreaker False <=> A "strong" loop breaker
972 Do not inline at all
973
974 See OccurAnal Note [Weak loop breakers]
975 -}
976
977 noOccInfo :: OccInfo
978 noOccInfo = ManyOccs { occ_tail = NoTailCallInfo }
979
980 isNoOccInfo :: OccInfo -> Bool
981 isNoOccInfo ManyOccs { occ_tail = NoTailCallInfo } = True
982 isNoOccInfo _ = False
983
984 isManyOccs :: OccInfo -> Bool
985 isManyOccs ManyOccs{} = True
986 isManyOccs _ = False
987
988 seqOccInfo :: OccInfo -> ()
989 seqOccInfo occ = occ `seq` ()
990
991 -----------------
992 -- | Interesting Context
993 data InterestingCxt
994 = IsInteresting
995 -- ^ Function: is applied
996 -- Data value: scrutinised by a case with at least one non-DEFAULT branch
997 | NotInteresting
998 deriving (Eq)
999
1000 -- | If there is any 'interesting' identifier occurrence, then the
1001 -- aggregated occurrence info of that identifier is considered interesting.
1002 instance Semi.Semigroup InterestingCxt where
1003 NotInteresting <> x = x
1004 IsInteresting <> _ = IsInteresting
1005
1006 instance Monoid InterestingCxt where
1007 mempty = NotInteresting
1008 mappend = (Semi.<>)
1009
1010 -----------------
1011 -- | Inside Lambda
1012 data InsideLam
1013 = IsInsideLam
1014 -- ^ Occurs inside a non-linear lambda
1015 -- Substituting a redex for this occurrence is
1016 -- dangerous because it might duplicate work.
1017 | NotInsideLam
1018 deriving (Eq)
1019
1020 -- | If any occurrence of an identifier is inside a lambda, then the
1021 -- occurrence info of that identifier marks it as occurring inside a lambda
1022 instance Semi.Semigroup InsideLam where
1023 NotInsideLam <> x = x
1024 IsInsideLam <> _ = IsInsideLam
1025
1026 instance Monoid InsideLam where
1027 mempty = NotInsideLam
1028 mappend = (Semi.<>)
1029
1030 -----------------
1031 data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
1032 | NoTailCallInfo
1033 deriving (Eq)
1034
1035 tailCallInfo :: OccInfo -> TailCallInfo
1036 tailCallInfo IAmDead = NoTailCallInfo
1037 tailCallInfo other = occ_tail other
1038
1039 zapOccTailCallInfo :: OccInfo -> OccInfo
1040 zapOccTailCallInfo IAmDead = IAmDead
1041 zapOccTailCallInfo occ = occ { occ_tail = NoTailCallInfo }
1042
1043 isAlwaysTailCalled :: OccInfo -> Bool
1044 isAlwaysTailCalled occ
1045 = case tailCallInfo occ of AlwaysTailCalled{} -> True
1046 NoTailCallInfo -> False
1047
1048 instance Outputable TailCallInfo where
1049 ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ]
1050 ppr _ = empty
1051
1052 -----------------
1053 strongLoopBreaker, weakLoopBreaker :: OccInfo
1054 strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo
1055 weakLoopBreaker = IAmALoopBreaker True NoTailCallInfo
1056
1057 isWeakLoopBreaker :: OccInfo -> Bool
1058 isWeakLoopBreaker (IAmALoopBreaker{}) = True
1059 isWeakLoopBreaker _ = False
1060
1061 isStrongLoopBreaker :: OccInfo -> Bool
1062 isStrongLoopBreaker (IAmALoopBreaker { occ_rules_only = False }) = True
1063 -- Loop-breaker that breaks a non-rule cycle
1064 isStrongLoopBreaker _ = False
1065
1066 isDeadOcc :: OccInfo -> Bool
1067 isDeadOcc IAmDead = True
1068 isDeadOcc _ = False
1069
1070 isOneOcc :: OccInfo -> Bool
1071 isOneOcc (OneOcc {}) = True
1072 isOneOcc _ = False
1073
1074 zapFragileOcc :: OccInfo -> OccInfo
1075 -- Keep only the most robust data: deadness, loop-breaker-hood
1076 zapFragileOcc (OneOcc {}) = noOccInfo
1077 zapFragileOcc occ = zapOccTailCallInfo occ
1078
1079 instance Outputable OccInfo where
1080 -- only used for debugging; never parsed. KSW 1999-07
1081 ppr (ManyOccs tails) = pprShortTailCallInfo tails
1082 ppr IAmDead = text "Dead"
1083 ppr (IAmALoopBreaker rule_only tails)
1084 = text "LoopBreaker" <> pp_ro <> pprShortTailCallInfo tails
1085 where
1086 pp_ro | rule_only = char '!'
1087 | otherwise = empty
1088 ppr (OneOcc inside_lam one_branch int_cxt tail_info)
1089 = text "Once" <> pp_lam inside_lam <> ppr one_branch <> pp_args int_cxt <> pp_tail
1090 where
1091 pp_lam IsInsideLam = char 'L'
1092 pp_lam NotInsideLam = empty
1093 pp_args IsInteresting = char '!'
1094 pp_args NotInteresting = empty
1095 pp_tail = pprShortTailCallInfo tail_info
1096
1097 pprShortTailCallInfo :: TailCallInfo -> SDoc
1098 pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)
1099 pprShortTailCallInfo NoTailCallInfo = empty
1100
1101 {-
1102 Note [TailCallInfo]
1103 ~~~~~~~~~~~~~~~~~~~
1104 The occurrence analyser determines what can be made into a join point, but it
1105 doesn't change the binder into a JoinId because then it would be inconsistent
1106 with the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to
1107 change the IdDetails.
1108
1109 The AlwaysTailCalled marker actually means slightly more than simply that the
1110 function is always tail-called. See Note [Invariants on join points].
1111
1112 This info is quite fragile and should not be relied upon unless the occurrence
1113 analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of
1114 the join-point-hood of a binder; a join id itself will not be marked
1115 AlwaysTailCalled.
1116
1117 Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
1118 being tail-called would mean that the variable could only appear once per branch
1119 (thus getting a `OneOcc { }` occurrence info), but a join
1120 point can also be invoked from other join points, not just from case branches:
1121
1122 let j1 x = ...
1123 j2 y = ... j1 z {- tail call -} ...
1124 in case w of
1125 A -> j1 v
1126 B -> j2 u
1127 C -> j2 q
1128
1129 Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
1130 ManyOccs and j2 will get `OneOcc { occ_n_br = 2 }`.
1131
1132 ************************************************************************
1133 * *
1134 Default method specification
1135 * *
1136 ************************************************************************
1137
1138 The DefMethSpec enumeration just indicates what sort of default method
1139 is used for a class. It is generated from source code, and present in
1140 interface files; it is converted to Class.DefMethInfo before begin put in a
1141 Class object.
1142 -}
1143
1144 -- | Default Method Specification
1145 data DefMethSpec ty
1146 = VanillaDM -- Default method given with polymorphic code
1147 | GenericDM ty -- Default method given with code of this type
1148
1149 instance Outputable (DefMethSpec ty) where
1150 ppr VanillaDM = text "{- Has default method -}"
1151 ppr (GenericDM {}) = text "{- Has generic default method -}"
1152
1153 {-
1154 ************************************************************************
1155 * *
1156 \subsection{Success flag}
1157 * *
1158 ************************************************************************
1159 -}
1160
1161 data SuccessFlag = Succeeded | Failed
1162
1163 instance Outputable SuccessFlag where
1164 ppr Succeeded = text "Succeeded"
1165 ppr Failed = text "Failed"
1166
1167 successIf :: Bool -> SuccessFlag
1168 successIf True = Succeeded
1169 successIf False = Failed
1170
1171 succeeded, failed :: SuccessFlag -> Bool
1172 succeeded Succeeded = True
1173 succeeded Failed = False
1174
1175 failed Succeeded = False
1176 failed Failed = True
1177
1178 {-
1179 ************************************************************************
1180 * *
1181 \subsection{Activation}
1182 * *
1183 ************************************************************************
1184
1185 When a rule or inlining is active
1186
1187 Note [Compiler phases]
1188 ~~~~~~~~~~~~~~~~~~~~~~
1189 The CompilerPhase says which phase the simplifier is running in:
1190
1191 * InitialPhase: before all user-visible phases
1192
1193 * Phase 2,1,0: user-visible phases; the phase number
1194 controls rule ordering an inlining.
1195
1196 * FinalPhase: used for all subsequent simplifier
1197 runs. By delaying inlining of wrappers to FinalPhase we can
1198 ensure that RULE have a good chance to fire. See
1199 Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
1200
1201 NB: FinalPhase is run repeatedly, not just once.
1202
1203 NB: users don't have access to InitialPhase or FinalPhase.
1204 They write {-# INLINE[n] f #-}, meaning (Phase n)
1205
1206 The phase sequencing is done by GHC.Opt.Simplify.Driver
1207 -}
1208
1209 -- | Phase Number
1210 type PhaseNum = Int -- Compilation phase
1211 -- Phases decrease towards zero
1212 -- Zero is the last phase
1213
1214 data CompilerPhase
1215 = InitialPhase -- The first phase -- number = infinity!
1216 | Phase PhaseNum -- User-specificable phases
1217 | FinalPhase -- The last phase -- number = -infinity!
1218 deriving Eq
1219
1220 instance Outputable CompilerPhase where
1221 ppr (Phase n) = int n
1222 ppr InitialPhase = text "InitialPhase"
1223 ppr FinalPhase = text "FinalPhase"
1224
1225 -- See note [Pragma source text]
1226 data Activation
1227 = AlwaysActive
1228 | ActiveBefore SourceText PhaseNum -- Active only *strictly before* this phase
1229 | ActiveAfter SourceText PhaseNum -- Active in this phase and later
1230 | FinalActive -- Active in final phase only
1231 | NeverActive
1232 deriving( Eq, Data )
1233 -- Eq used in comparing rules in GHC.Hs.Decls
1234
1235 activateAfterInitial :: Activation
1236 -- Active in the first phase after the initial phase
1237 -- Currently we have just phases [2,1,0,FinalPhase,FinalPhase,...]
1238 -- Where FinalPhase means GHC's internal simplification steps
1239 -- after all rules have run
1240 activateAfterInitial = ActiveAfter NoSourceText 2
1241
1242 activateDuringFinal :: Activation
1243 -- Active in the final simplification phase (which is repeated)
1244 activateDuringFinal = FinalActive
1245
1246 isActive :: CompilerPhase -> Activation -> Bool
1247 isActive InitialPhase act = activeInInitialPhase act
1248 isActive (Phase p) act = activeInPhase p act
1249 isActive FinalPhase act = activeInFinalPhase act
1250
1251 activeInInitialPhase :: Activation -> Bool
1252 activeInInitialPhase AlwaysActive = True
1253 activeInInitialPhase (ActiveBefore {}) = True
1254 activeInInitialPhase _ = False
1255
1256 activeInPhase :: PhaseNum -> Activation -> Bool
1257 activeInPhase _ AlwaysActive = True
1258 activeInPhase _ NeverActive = False
1259 activeInPhase _ FinalActive = False
1260 activeInPhase p (ActiveAfter _ n) = p <= n
1261 activeInPhase p (ActiveBefore _ n) = p > n
1262
1263 activeInFinalPhase :: Activation -> Bool
1264 activeInFinalPhase AlwaysActive = True
1265 activeInFinalPhase FinalActive = True
1266 activeInFinalPhase (ActiveAfter {}) = True
1267 activeInFinalPhase _ = False
1268
1269 isNeverActive, isAlwaysActive :: Activation -> Bool
1270 isNeverActive NeverActive = True
1271 isNeverActive _ = False
1272
1273 isAlwaysActive AlwaysActive = True
1274 isAlwaysActive _ = False
1275
1276 competesWith :: Activation -> Activation -> Bool
1277 -- See Note [Activation competition]
1278 competesWith AlwaysActive _ = True
1279
1280 competesWith NeverActive _ = False
1281 competesWith _ NeverActive = False
1282
1283 competesWith FinalActive FinalActive = True
1284 competesWith FinalActive _ = False
1285
1286 competesWith (ActiveBefore {}) AlwaysActive = True
1287 competesWith (ActiveBefore {}) FinalActive = False
1288 competesWith (ActiveBefore {}) (ActiveBefore {}) = True
1289 competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
1290
1291 competesWith (ActiveAfter {}) AlwaysActive = False
1292 competesWith (ActiveAfter {}) FinalActive = True
1293 competesWith (ActiveAfter {}) (ActiveBefore {}) = False
1294 competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
1295
1296 {- Note [Competing activations]
1297 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1298 Sometimes a RULE and an inlining may compete, or two RULES.
1299 See Note [Rules and inlining/other rules] in GHC.HsToCore.
1300
1301 We say that act1 "competes with" act2 iff
1302 act1 is active in the phase when act2 *becomes* active
1303 NB: remember that phases count *down*: 2, 1, 0!
1304
1305 It's too conservative to ensure that the two are never simultaneously
1306 active. For example, a rule might be always active, and an inlining
1307 might switch on in phase 2. We could switch off the rule, but it does
1308 no harm.
1309 -}
1310
1311
1312 {- *********************************************************************
1313 * *
1314 InlinePragma, InlineSpec, RuleMatchInfo
1315 * *
1316 ********************************************************************* -}
1317
1318
1319 data InlinePragma -- Note [InlinePragma]
1320 = InlinePragma
1321 { inl_src :: SourceText -- Note [Pragma source text]
1322 , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]
1323
1324 , inl_sat :: Maybe Arity -- Just n <=> Inline only when applied to n
1325 -- explicit (non-type, non-dictionary) args
1326 -- That is, inl_sat describes the number of *source-code*
1327 -- arguments the thing must be applied to. We add on the
1328 -- number of implicit, dictionary arguments when making
1329 -- the Unfolding, and don't look at inl_sat further
1330
1331 , inl_act :: Activation -- Says during which phases inlining is allowed
1332 -- See Note [inl_inline and inl_act]
1333
1334 , inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
1335 } deriving( Eq, Data )
1336
1337 -- | Rule Match Information
1338 data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
1339 | FunLike
1340 deriving( Eq, Data, Show )
1341 -- Show needed for GHC.Parser.Lexer
1342
1343 -- | Inline Specification
1344 data InlineSpec -- What the user's INLINE pragma looked like
1345 = Inline SourceText -- User wrote INLINE
1346 | Inlinable SourceText -- User wrote INLINABLE
1347 | NoInline SourceText -- User wrote NOINLINE
1348 -- Each of the above keywords is accompanied with
1349 -- a string of type SourceText written by the user
1350 | NoUserInlinePrag -- User did not write any of INLINE/INLINABLE/NOINLINE
1351 -- e.g. in `defaultInlinePragma` or when created by CSE
1352 deriving( Eq, Data, Show )
1353 -- Show needed for GHC.Parser.Lexer
1354
1355 {- Note [InlinePragma]
1356 ~~~~~~~~~~~~~~~~~~~~~~
1357 This data type mirrors what you can write in an INLINE or NOINLINE pragma in
1358 the source program.
1359
1360 If you write nothing at all, you get defaultInlinePragma:
1361 inl_inline = NoUserInlinePrag
1362 inl_act = AlwaysActive
1363 inl_rule = FunLike
1364
1365 It's not possible to get that combination by *writing* something, so
1366 if an Id has defaultInlinePragma it means the user didn't specify anything.
1367
1368 If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.
1369
1370 If you want to know where InlinePragmas take effect: Look in GHC.HsToCore.Binds.makeCorePair
1371
1372 Note [inl_inline and inl_act]
1373 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1374 * inl_inline says what the user wrote: did they say INLINE, NOINLINE,
1375 INLINABLE, or nothing at all
1376
1377 * inl_act says in what phases the unfolding is active or inactive
1378 E.g If you write INLINE[1] then inl_act will be set to ActiveAfter 1
1379 If you write NOINLINE[1] then inl_act will be set to ActiveBefore 1
1380 If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1
1381 So note that inl_act does not say what pragma you wrote: it just
1382 expresses its consequences
1383
1384 * inl_act just says when the unfolding is active; it doesn't say what
1385 to inline. If you say INLINE f, then f's inl_act will be AlwaysActive,
1386 but in addition f will get a "stable unfolding" with UnfoldingGuidance
1387 that tells the inliner to be pretty eager about it.
1388
1389 Note [CONLIKE pragma]
1390 ~~~~~~~~~~~~~~~~~~~~~
1391 The ConLike constructor of a RuleMatchInfo is aimed at the following.
1392 Consider first
1393 {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
1394 g b bs = let x = b:bs in ..x...x...(r x)...
1395 Now, the rule applies to the (r x) term, because GHC "looks through"
1396 the definition of 'x' to see that it is (b:bs).
1397
1398 Now consider
1399 {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
1400 g v = let x = f v in ..x...x...(r x)...
1401 Normally the (r x) would *not* match the rule, because GHC would be
1402 scared about duplicating the redex (f v), so it does not "look
1403 through" the bindings.
1404
1405 However the CONLIKE modifier says to treat 'f' like a constructor in
1406 this situation, and "look through" the unfolding for x. So (r x)
1407 fires, yielding (f (v+1)).
1408
1409 This is all controlled with a user-visible pragma:
1410 {-# NOINLINE CONLIKE [1] f #-}
1411
1412 The main effects of CONLIKE are:
1413
1414 - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
1415 CONLIKE thing like constructors, by ANF-ing them
1416
1417 - New function GHC.Core.Utils.exprIsExpandable is like exprIsCheap, but
1418 additionally spots applications of CONLIKE functions
1419
1420 - A CoreUnfolding has a field that caches exprIsExpandable
1421
1422 - The rule matcher consults this field. See
1423 Note [Expanding variables] in GHC.Core.Rules.
1424 -}
1425
1426 isConLike :: RuleMatchInfo -> Bool
1427 isConLike ConLike = True
1428 isConLike _ = False
1429
1430 isFunLike :: RuleMatchInfo -> Bool
1431 isFunLike FunLike = True
1432 isFunLike _ = False
1433
1434 noUserInlineSpec :: InlineSpec -> Bool
1435 noUserInlineSpec NoUserInlinePrag = True
1436 noUserInlineSpec _ = False
1437
1438 defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
1439 :: InlinePragma
1440 defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"
1441 , inl_act = AlwaysActive
1442 , inl_rule = FunLike
1443 , inl_inline = NoUserInlinePrag
1444 , inl_sat = Nothing }
1445
1446 alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline (inlinePragmaSource defaultInlinePragma) }
1447 neverInlinePragma = defaultInlinePragma { inl_act = NeverActive }
1448
1449 alwaysInlineConLikePragma :: InlinePragma
1450 alwaysInlineConLikePragma = alwaysInlinePragma { inl_rule = ConLike }
1451
1452 inlinePragmaSpec :: InlinePragma -> InlineSpec
1453 inlinePragmaSpec = inl_inline
1454
1455 inlinePragmaSource :: InlinePragma -> SourceText
1456 inlinePragmaSource prag = case inl_inline prag of
1457 Inline x -> x
1458 Inlinable y -> y
1459 NoInline z -> z
1460 NoUserInlinePrag -> NoSourceText
1461
1462 inlineSpecSource :: InlineSpec -> SourceText
1463 inlineSpecSource spec = case spec of
1464 Inline x -> x
1465 Inlinable y -> y
1466 NoInline z -> z
1467 NoUserInlinePrag -> NoSourceText
1468
1469 -- A DFun has an always-active inline activation so that
1470 -- exprIsConApp_maybe can "see" its unfolding
1471 -- (However, its actual Unfolding is a DFunUnfolding, which is
1472 -- never inlined other than via exprIsConApp_maybe.)
1473 dfunInlinePragma = defaultInlinePragma { inl_act = AlwaysActive
1474 , inl_rule = ConLike }
1475
1476 isDefaultInlinePragma :: InlinePragma -> Bool
1477 isDefaultInlinePragma (InlinePragma { inl_act = activation
1478 , inl_rule = match_info
1479 , inl_inline = inline })
1480 = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
1481
1482 isInlinePragma :: InlinePragma -> Bool
1483 isInlinePragma prag = case inl_inline prag of
1484 Inline _ -> True
1485 _ -> False
1486
1487 isInlinablePragma :: InlinePragma -> Bool
1488 isInlinablePragma prag = case inl_inline prag of
1489 Inlinable _ -> True
1490 _ -> False
1491
1492 isNoInlinePragma :: InlinePragma -> Bool
1493 isNoInlinePragma prag = case inl_inline prag of
1494 NoInline _ -> True
1495 _ -> False
1496
1497 isAnyInlinePragma :: InlinePragma -> Bool
1498 -- INLINE or INLINABLE
1499 isAnyInlinePragma prag = case inl_inline prag of
1500 Inline _ -> True
1501 Inlinable _ -> True
1502 _ -> False
1503
1504 inlinePragmaSat :: InlinePragma -> Maybe Arity
1505 inlinePragmaSat = inl_sat
1506
1507 inlinePragmaActivation :: InlinePragma -> Activation
1508 inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
1509
1510 inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
1511 inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
1512
1513 setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
1514 setInlinePragmaActivation prag activation = prag { inl_act = activation }
1515
1516 setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
1517 setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
1518
1519 instance Outputable Activation where
1520 ppr AlwaysActive = empty
1521 ppr NeverActive = brackets (text "~")
1522 ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
1523 ppr (ActiveAfter _ n) = brackets (int n)
1524 ppr FinalActive = text "[final]"
1525
1526 instance Binary Activation where
1527 put_ bh NeverActive =
1528 putByte bh 0
1529 put_ bh FinalActive =
1530 putByte bh 1
1531 put_ bh AlwaysActive =
1532 putByte bh 2
1533 put_ bh (ActiveBefore src aa) = do
1534 putByte bh 3
1535 put_ bh src
1536 put_ bh aa
1537 put_ bh (ActiveAfter src ab) = do
1538 putByte bh 4
1539 put_ bh src
1540 put_ bh ab
1541 get bh = do
1542 h <- getByte bh
1543 case h of
1544 0 -> return NeverActive
1545 1 -> return FinalActive
1546 2 -> return AlwaysActive
1547 3 -> do src <- get bh
1548 aa <- get bh
1549 return (ActiveBefore src aa)
1550 _ -> do src <- get bh
1551 ab <- get bh
1552 return (ActiveAfter src ab)
1553
1554 instance Outputable RuleMatchInfo where
1555 ppr ConLike = text "CONLIKE"
1556 ppr FunLike = text "FUNLIKE"
1557
1558 instance Binary RuleMatchInfo where
1559 put_ bh FunLike = putByte bh 0
1560 put_ bh ConLike = putByte bh 1
1561 get bh = do
1562 h <- getByte bh
1563 if h == 1 then return ConLike
1564 else return FunLike
1565
1566 instance Outputable InlineSpec where
1567 ppr (Inline src) = text "INLINE" <+> pprWithSourceText src empty
1568 ppr (NoInline src) = text "NOINLINE" <+> pprWithSourceText src empty
1569 ppr (Inlinable src) = text "INLINABLE" <+> pprWithSourceText src empty
1570 ppr NoUserInlinePrag = empty
1571
1572 instance Binary InlineSpec where
1573 put_ bh NoUserInlinePrag = putByte bh 0
1574 put_ bh (Inline s) = do putByte bh 1
1575 put_ bh s
1576 put_ bh (Inlinable s) = do putByte bh 2
1577 put_ bh s
1578 put_ bh (NoInline s) = do putByte bh 3
1579 put_ bh s
1580
1581 get bh = do h <- getByte bh
1582 case h of
1583 0 -> return NoUserInlinePrag
1584 1 -> do
1585 s <- get bh
1586 return (Inline s)
1587 2 -> do
1588 s <- get bh
1589 return (Inlinable s)
1590 _ -> do
1591 s <- get bh
1592 return (NoInline s)
1593
1594 instance Outputable InlinePragma where
1595 ppr = pprInline
1596
1597 instance Binary InlinePragma where
1598 put_ bh (InlinePragma s a b c d) = do
1599 put_ bh s
1600 put_ bh a
1601 put_ bh b
1602 put_ bh c
1603 put_ bh d
1604
1605 get bh = do
1606 s <- get bh
1607 a <- get bh
1608 b <- get bh
1609 c <- get bh
1610 d <- get bh
1611 return (InlinePragma s a b c d)
1612
1613 -- | Outputs string for pragma name for any of INLINE/INLINABLE/NOINLINE. This
1614 -- differs from the Outputable instance for the InlineSpec type where the pragma
1615 -- name string as well as the accompanying SourceText (if any) is printed.
1616 inlinePragmaName :: InlineSpec -> SDoc
1617 inlinePragmaName (Inline _) = text "INLINE"
1618 inlinePragmaName (Inlinable _) = text "INLINABLE"
1619 inlinePragmaName (NoInline _) = text "NOINLINE"
1620 inlinePragmaName NoUserInlinePrag = empty
1621
1622 pprInline :: InlinePragma -> SDoc
1623 pprInline = pprInline' True
1624
1625 pprInlineDebug :: InlinePragma -> SDoc
1626 pprInlineDebug = pprInline' False
1627
1628 pprInline' :: Bool -- True <=> do not display the inl_inline field
1629 -> InlinePragma
1630 -> SDoc
1631 pprInline' emptyInline (InlinePragma
1632 { inl_inline = inline,
1633 inl_act = activation,
1634 inl_rule = info,
1635 inl_sat = mb_arity })
1636 = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info
1637 where
1638 pp_inl x = if emptyInline then empty else inlinePragmaName x
1639
1640 pp_act Inline {} AlwaysActive = empty
1641 pp_act NoInline {} NeverActive = empty
1642 pp_act _ act = ppr act
1643
1644 pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
1645 | otherwise = empty
1646 pp_info | isFunLike info = empty
1647 | otherwise = ppr info
1648
1649
1650
1651 {-
1652 ************************************************************************
1653 * *
1654 IntWithInf
1655 * *
1656 ************************************************************************
1657
1658 Represents an integer or positive infinity
1659
1660 -}
1661
1662 -- | An integer or infinity
1663 data IntWithInf = Int {-# UNPACK #-} !Int
1664 | Infinity
1665 deriving Eq
1666
1667 -- | A representation of infinity
1668 infinity :: IntWithInf
1669 infinity = Infinity
1670
1671 instance Ord IntWithInf where
1672 compare Infinity Infinity = EQ
1673 compare (Int _) Infinity = LT
1674 compare Infinity (Int _) = GT
1675 compare (Int a) (Int b) = a `compare` b
1676
1677 instance Outputable IntWithInf where
1678 ppr Infinity = char '∞'
1679 ppr (Int n) = int n
1680
1681 instance Num IntWithInf where
1682 (+) = plusWithInf
1683 (*) = mulWithInf
1684
1685 abs Infinity = Infinity
1686 abs (Int n) = Int (abs n)
1687
1688 signum Infinity = Int 1
1689 signum (Int n) = Int (signum n)
1690
1691 fromInteger = Int . fromInteger
1692
1693 (-) = panic "subtracting IntWithInfs"
1694
1695 intGtLimit :: Int -> IntWithInf -> Bool
1696 intGtLimit _ Infinity = False
1697 intGtLimit n (Int m) = n > m
1698
1699 -- | Add two 'IntWithInf's
1700 plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1701 plusWithInf Infinity _ = Infinity
1702 plusWithInf _ Infinity = Infinity
1703 plusWithInf (Int a) (Int b) = Int (a + b)
1704
1705 -- | Multiply two 'IntWithInf's
1706 mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
1707 mulWithInf Infinity _ = Infinity
1708 mulWithInf _ Infinity = Infinity
1709 mulWithInf (Int a) (Int b) = Int (a * b)
1710
1711 -- | Subtract an 'Int' from an 'IntWithInf'
1712 subWithInf :: IntWithInf -> Int -> IntWithInf
1713 subWithInf Infinity _ = Infinity
1714 subWithInf (Int a) b = Int (a - b)
1715
1716 -- | Turn a positive number into an 'IntWithInf', where 0 represents infinity
1717 treatZeroAsInf :: Int -> IntWithInf
1718 treatZeroAsInf 0 = Infinity
1719 treatZeroAsInf n = Int n
1720
1721 -- | Inject any integer into an 'IntWithInf'
1722 mkIntWithInf :: Int -> IntWithInf
1723 mkIntWithInf = Int
1724
1725 data SpliceExplicitFlag
1726 = ExplicitSplice | -- ^ <=> $(f x y)
1727 ImplicitSplice -- ^ <=> f x y, i.e. a naked top level expression
1728 deriving Data
1729
1730 {- *********************************************************************
1731 * *
1732 Types vs Kinds
1733 * *
1734 ********************************************************************* -}
1735
1736 -- | Flag to see whether we're type-checking terms or kind-checking types
1737 data TypeOrKind = TypeLevel | KindLevel
1738 deriving Eq
1739
1740 instance Outputable TypeOrKind where
1741 ppr TypeLevel = text "TypeLevel"
1742 ppr KindLevel = text "KindLevel"
1743
1744 isTypeLevel :: TypeOrKind -> Bool
1745 isTypeLevel TypeLevel = True
1746 isTypeLevel KindLevel = False
1747
1748 isKindLevel :: TypeOrKind -> Bool
1749 isKindLevel TypeLevel = False
1750 isKindLevel KindLevel = True
1751
1752 {- *********************************************************************
1753 * *
1754 Defaulting options
1755 * *
1756 ********************************************************************* -}
1757
1758 -- | Whether to default kind variables. Usually: no, unless `-XNoPolyKinds`
1759 -- is enabled.
1760 data DefaultKindVars
1761 = Don'tDefaultKinds
1762 | DefaultKinds
1763
1764 instance Outputable DefaultKindVars where
1765 ppr Don'tDefaultKinds = text "Don'tDefaultKinds"
1766 ppr DefaultKinds = text "DefaultKinds"
1767
1768 -- | Whether to default type variables of the given kinds:
1769 --
1770 -- - default 'RuntimeRep' variables to LiftedRep?
1771 -- - default 'Levity' variables to Lifted?
1772 -- - default 'Multiplicity' variables to Many?
1773 data DefaultVarsOfKind =
1774 DefaultVarsOfKind
1775 { def_runtimeRep, def_levity, def_multiplicity :: !Bool }
1776
1777 instance Outputable DefaultVarsOfKind where
1778 ppr
1779 (DefaultVarsOfKind
1780 { def_runtimeRep = rep
1781 , def_levity = lev
1782 , def_multiplicity = mult })
1783 = text "DefaultVarsOfKind:" <+> defaults
1784 where
1785 defaults :: SDoc
1786 defaults =
1787 case filter snd $ [ ("RuntimeRep", rep), ("Levity", lev), ("Multiplicity", mult)] of
1788 [] -> text "<no defaulting>"
1789 defs -> hsep (map (text . fst) defs)
1790
1791 -- | Do defaulting for variables of kind `RuntimeRep`, `Levity` and `Multiplicity`.
1792 allVarsOfKindDefault :: DefaultVarsOfKind
1793 allVarsOfKindDefault =
1794 DefaultVarsOfKind
1795 { def_runtimeRep = True
1796 , def_levity = True
1797 , def_multiplicity = True
1798 }
1799
1800 -- | Don't do defaulting for variables of kind `RuntimeRep`, `Levity` and `Multiplicity`.
1801 noVarsOfKindDefault :: DefaultVarsOfKind
1802 noVarsOfKindDefault =
1803 DefaultVarsOfKind
1804 { def_runtimeRep = False
1805 , def_levity = False
1806 , def_multiplicity = False
1807 }