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, isNoOcc,
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 isNoOcc :: OccInfo -> Bool
344 isNoOcc NoOccInfo = True
345 isNoOcc other = False
347 seqOccInfo :: OccInfo -> ()
348 seqOccInfo occ = occ `seq` ()
351 type InterestingCxt = Bool -- True <=> Function: is applied
352 -- Data value: scrutinised by a case with
353 -- at least one non-DEFAULT branch
356 type InsideLam = Bool -- True <=> Occurs inside a non-linear lambda
357 -- Substituting a redex for this occurrence is
358 -- dangerous because it might duplicate work.
363 type OneBranch = Bool -- True <=> Occurs in only one case branch
364 -- so no code-duplication issue to worry about
368 isLoopBreaker :: OccInfo -> Bool
369 isLoopBreaker IAmALoopBreaker = True
370 isLoopBreaker other = False
372 isDeadOcc :: OccInfo -> Bool
373 isDeadOcc IAmDead = True
374 isDeadOcc other = False
376 isOneOcc (OneOcc _ _ _) = True
377 isOneOcc other = False
379 isFragileOcc :: OccInfo -> Bool
380 isFragileOcc (OneOcc _ _ _) = True
381 isFragileOcc other = False
385 instance Outputable OccInfo where
386 -- only used for debugging; never parsed. KSW 1999-07
387 ppr NoOccInfo = empty
388 ppr IAmALoopBreaker = ptext SLIT("LoopBreaker")
389 ppr IAmDead = ptext SLIT("Dead")
390 ppr (OneOcc inside_lam one_branch int_cxt)
391 = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
393 pp_lam | inside_lam = char 'L'
395 pp_br | one_branch = empty
396 | otherwise = char '*'
397 pp_args | int_cxt = char '!'
400 instance Show OccInfo where
401 showsPrec p occ = showsPrecSDoc p (ppr occ)
404 %************************************************************************
406 \subsection{Strictness indication}
408 %************************************************************************
410 The strictness annotations on types in data type declarations
411 e.g. data T = MkT !Int !(Bool,Bool)
414 data StrictnessMark -- Used in interface decls only
420 isMarkedUnboxed MarkedUnboxed = True
421 isMarkedUnboxed other = False
423 isMarkedStrict NotMarkedStrict = False
424 isMarkedStrict other = True -- All others are strict
426 instance Outputable StrictnessMark where
427 ppr MarkedStrict = ptext SLIT("!")
428 ppr MarkedUnboxed = ptext SLIT("!!")
429 ppr NotMarkedStrict = ptext SLIT("_")
433 %************************************************************************
435 \subsection{Success flag}
437 %************************************************************************
440 data SuccessFlag = Succeeded | Failed
442 successIf :: Bool -> SuccessFlag
443 successIf True = Succeeded
444 successIf False = Failed
446 succeeded, failed :: SuccessFlag -> Bool
447 succeeded Succeeded = True
448 succeeded Failed = False
450 failed Succeeded = False
455 %************************************************************************
457 \subsection{Activation}
459 %************************************************************************
461 When a rule or inlining is active
464 type CompilerPhase = Int -- Compilation phase
465 -- Phases decrease towards zero
466 -- Zero is the last phase
468 data Activation = NeverActive
470 | ActiveBefore CompilerPhase -- Active only *before* this phase
471 | ActiveAfter CompilerPhase -- Active in this phase and later
472 deriving( Eq ) -- Eq used in comparing rules in HsDecls
476 Activation -- Says during which phases inlining is allowed
477 Bool -- True <=> make the RHS look small, so that when inlining
478 -- is enabled, it will definitely actually happen
481 defaultInlineSpec = Inline AlwaysActive False -- Inlining is OK, but not forced
482 alwaysInlineSpec = Inline AlwaysActive True -- INLINE always
483 neverInlineSpec = Inline NeverActive False -- NOINLINE
485 instance Outputable Activation where
486 ppr AlwaysActive = empty -- The default
487 ppr (ActiveBefore n) = brackets (char '~' <> int n)
488 ppr (ActiveAfter n) = brackets (int n)
489 ppr NeverActive = ptext SLIT("NEVER")
491 instance Outputable InlineSpec where
492 ppr (Inline act True) = ptext SLIT("INLINE") <> ppr act
493 ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
495 isActive :: CompilerPhase -> Activation -> Bool
496 isActive p NeverActive = False
497 isActive p AlwaysActive = True
498 isActive p (ActiveAfter n) = p <= n
499 isActive p (ActiveBefore n) = p > n
501 isNeverActive, isAlwaysActive :: Activation -> Bool
502 isNeverActive NeverActive = True
503 isNeverActive act = False
505 isAlwaysActive AlwaysActive = True
506 isAlwaysActive other = False