2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
4 \section[BasicTypes]{Miscellanous types}
6 This module defines a miscellaneously collection of very simple
10 \item have no other obvious home
11 \item don't depend on any other complicated types
12 \item are used in more than one "part" of the compiler
17 Version, bumpVersion, initialVersion,
23 Fixity(..), FixityDirection(..),
24 defaultFixity, maxPrecedence,
25 negateFixity, funTyFixity,
28 IPName(..), ipNameName, mapIPName,
30 RecFlag(..), isRec, isNonRec, boolToRecFlag,
32 TopLevelFlag(..), isTopLevel, isNotTopLevel,
36 TupCon(..), tupleParens,
38 OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
39 isDeadOcc, isLoopBreaker,
41 InsideLam, insideLam, notInsideLam,
42 OneBranch, oneBranch, notOneBranch,
47 StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
50 Activation(..), isActive, isNeverActive, isAlwaysActive,
51 InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
53 SuccessFlag(..), succeeded, failed, successIf
56 #include "HsVersions.h"
58 import FastString( FastString )
62 %************************************************************************
64 \subsection[Arity]{Arity}
66 %************************************************************************
73 %************************************************************************
75 \subsection[Version]{Module and identifier version numbers}
77 %************************************************************************
82 bumpVersion :: Version -> Version
85 initialVersion :: Version
89 %************************************************************************
93 %************************************************************************
97 type DeprecTxt = FastString -- reason/explanation for deprecation
100 %************************************************************************
102 \subsection{Implicit parameter identity}
104 %************************************************************************
106 The @IPName@ type is here because it is used in TypeRep (i.e. very
107 early in the hierarchy), but also in HsSyn.
111 = Dupable name -- ?x: you can freely duplicate this implicit parameter
112 | Linear name -- %x: you must use the splitting function to duplicate it
113 deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map
114 -- (used in HscTypes.OrigIParamCache)
117 ipNameName :: IPName name -> name
118 ipNameName (Dupable n) = n
119 ipNameName (Linear n) = n
121 mapIPName :: (a->b) -> IPName a -> IPName b
122 mapIPName f (Dupable n) = Dupable (f n)
123 mapIPName f (Linear n) = Linear (f n)
125 instance Outputable name => Outputable (IPName name) where
126 ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
127 ppr (Linear n) = char '%' <> ppr n -- Splittable implicit parameters
131 %************************************************************************
133 \subsection[Fixity]{Fixity info}
135 %************************************************************************
138 ------------------------
139 data Fixity = Fixity Int FixityDirection
141 instance Outputable Fixity where
142 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
144 instance Eq Fixity where -- Used to determine if two fixities conflict
145 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
147 ------------------------
148 data FixityDirection = InfixL | InfixR | InfixN
151 instance Outputable FixityDirection where
152 ppr InfixL = ptext SLIT("infixl")
153 ppr InfixR = ptext SLIT("infixr")
154 ppr InfixN = ptext SLIT("infix")
156 ------------------------
157 maxPrecedence = (9::Int)
158 defaultFixity = Fixity maxPrecedence InfixL
160 negateFixity, funTyFixity :: Fixity
162 negateFixity = Fixity 6 InfixL -- Fixity of unary negate
163 funTyFixity = Fixity 0 InfixR -- Fixity of '->'
171 @(compareFixity op1 op2)@ tells which way to arrange appication, or
172 whether there's an error.
175 compareFixity :: Fixity -> Fixity
176 -> (Bool, -- Error please
177 Bool) -- Associate to the right: a op1 (b op2 c)
178 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
179 = case prec1 `compare` prec2 of
182 EQ -> case (dir1, dir2) of
183 (InfixR, InfixR) -> right
184 (InfixL, InfixL) -> left
187 right = (False, True)
188 left = (False, False)
189 error_please = (True, False)
193 %************************************************************************
195 \subsection[Top-level/local]{Top-level/not-top level flag}
197 %************************************************************************
204 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
206 isNotTopLevel NotTopLevel = True
207 isNotTopLevel TopLevel = False
209 isTopLevel TopLevel = True
210 isTopLevel NotTopLevel = False
212 instance Outputable TopLevelFlag where
213 ppr TopLevel = ptext SLIT("<TopLevel>")
214 ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
218 %************************************************************************
220 \subsection[Top-level/local]{Top-level/not-top level flag}
222 %************************************************************************
230 isBoxed :: Boxity -> Bool
232 isBoxed Unboxed = False
236 %************************************************************************
238 \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
240 %************************************************************************
243 data RecFlag = Recursive
247 isRec :: RecFlag -> Bool
248 isRec Recursive = True
249 isRec NonRecursive = False
251 isNonRec :: RecFlag -> Bool
252 isNonRec Recursive = False
253 isNonRec NonRecursive = True
255 boolToRecFlag :: Bool -> RecFlag
256 boolToRecFlag True = Recursive
257 boolToRecFlag False = NonRecursive
259 instance Outputable RecFlag where
260 ppr Recursive = ptext SLIT("Recursive")
261 ppr NonRecursive = ptext SLIT("NonRecursive")
264 %************************************************************************
268 %************************************************************************
271 data TupCon = TupCon Boxity Arity
273 instance Eq TupCon where
274 (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
276 tupleParens :: Boxity -> SDoc -> SDoc
277 tupleParens Boxed p = parens p
278 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
281 %************************************************************************
283 \subsection[Generic]{Generic flag}
285 %************************************************************************
287 This is the "Embedding-Projection pair" datatype, it contains
288 two pieces of code (normally either RenamedExpr's or Id's)
289 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
290 represents functions of type
299 T and Tring are arbitrary, but typically T is the 'main' type while
300 Tring is the 'representation' type. (This just helps us remember
301 whether to use 'from' or 'to'.
304 data EP a = EP { fromEP :: a, -- :: T -> Tring
305 toEP :: a } -- :: Tring -> T
308 Embedding-projection pairs are used in several places:
310 First of all, each type constructor has an EP associated with it, the
311 code in EP converts (datatype T) from T to Tring and back again.
313 Secondly, when we are filling in Generic methods (in the typechecker,
314 tcMethodBinds), we are constructing bimaps by induction on the structure
315 of the type of the method signature.
318 %************************************************************************
320 \subsection{Occurrence information}
322 %************************************************************************
324 This data type is used exclusively by the simplifier, but it appears in a
325 SubstResult, which is currently defined in VarEnv, which is pretty near
326 the base of the module hierarchy. So it seemed simpler to put the
327 defn of OccInfo here, safely at the bottom
333 | IAmDead -- Marks unused variables. Sometimes useful for
334 -- lambda and case-bound variables.
340 | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
341 -- in a group of recursive definitions
343 seqOccInfo :: OccInfo -> ()
344 seqOccInfo occ = occ `seq` ()
347 type InterestingCxt = Bool -- True <=> Function: is applied
348 -- Data value: scrutinised by a case with
349 -- at least one non-DEFAULT branch
352 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
353 -- Substituting a redex for this occurrence is
354 -- dangerous because it might duplicate work.
359 type OneBranch = Bool -- True <=> Occurs in only one case branch
360 -- so no code-duplication issue to worry about
364 isLoopBreaker :: OccInfo -> Bool
365 isLoopBreaker IAmALoopBreaker = True
366 isLoopBreaker other = False
368 isDeadOcc :: OccInfo -> Bool
369 isDeadOcc IAmDead = True
370 isDeadOcc other = False
372 isOneOcc (OneOcc _ _ _) = True
373 isOneOcc other = False
375 isFragileOcc :: OccInfo -> Bool
376 isFragileOcc (OneOcc _ _ _) = True
377 isFragileOcc other = False
381 instance Outputable OccInfo where
382 -- only used for debugging; never parsed. KSW 1999-07
383 ppr NoOccInfo = empty
384 ppr IAmALoopBreaker = ptext SLIT("LoopBreaker")
385 ppr IAmDead = ptext SLIT("Dead")
386 ppr (OneOcc inside_lam one_branch int_cxt)
387 = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
389 pp_lam | inside_lam = char 'L'
391 pp_br | one_branch = empty
392 | otherwise = char '*'
393 pp_args | int_cxt = char '!'
396 instance Show OccInfo where
397 showsPrec p occ = showsPrecSDoc p (ppr occ)
400 %************************************************************************
402 \subsection{Strictness indication}
404 %************************************************************************
406 The strictness annotations on types in data type declarations
407 e.g. data T = MkT !Int !(Bool,Bool)
410 data StrictnessMark -- Used in interface decls only
416 isMarkedUnboxed MarkedUnboxed = True
417 isMarkedUnboxed other = False
419 isMarkedStrict NotMarkedStrict = False
420 isMarkedStrict other = True -- All others are strict
422 instance Outputable StrictnessMark where
423 ppr MarkedStrict = ptext SLIT("!")
424 ppr MarkedUnboxed = ptext SLIT("!!")
425 ppr NotMarkedStrict = ptext SLIT("_")
429 %************************************************************************
431 \subsection{Success flag}
433 %************************************************************************
436 data SuccessFlag = Succeeded | Failed
438 successIf :: Bool -> SuccessFlag
439 successIf True = Succeeded
440 successIf False = Failed
442 succeeded, failed :: SuccessFlag -> Bool
443 succeeded Succeeded = True
444 succeeded Failed = False
446 failed Succeeded = False
451 %************************************************************************
453 \subsection{Activation}
455 %************************************************************************
457 When a rule or inlining is active
460 type CompilerPhase = Int -- Compilation phase
461 -- Phases decrease towards zero
462 -- Zero is the last phase
464 data Activation = NeverActive
466 | ActiveBefore CompilerPhase -- Active only *before* this phase
467 | ActiveAfter CompilerPhase -- Active in this phase and later
468 deriving( Eq ) -- Eq used in comparing rules in HsDecls
472 Activation -- Says during which phases inlining is allowed
473 Bool -- True <=> make the RHS look small, so that when inlining
474 -- is enabled, it will definitely actually happen
477 defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
478 alwaysInlineSpec = Inline AlwaysActive True -- INLINE always
479 neverInlineSpec = Inline NeverActive False -- NOINLINE
481 instance Outputable Activation where
482 ppr AlwaysActive = empty -- The default
483 ppr (ActiveBefore n) = brackets (char '~' <> int n)
484 ppr (ActiveAfter n) = brackets (int n)
485 ppr NeverActive = ptext SLIT("NEVER")
487 instance Outputable InlineSpec where
488 ppr (Inline act True) = ptext SLIT("INLINE") <> ppr act
489 ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
491 isActive :: CompilerPhase -> Activation -> Bool
492 isActive p NeverActive = False
493 isActive p AlwaysActive = True
494 isActive p (ActiveAfter n) = p <= n
495 isActive p (ActiveBefore n) = p > n
497 isNeverActive, isAlwaysActive :: Activation -> Bool
498 isNeverActive NeverActive = True
499 isNeverActive act = False
501 isAlwaysActive AlwaysActive = True
502 isAlwaysActive other = False