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, bogusVersion,
23 FixitySig(..), Fixity(..), FixityDirection(..),
24 defaultFixity, maxPrecedence,
25 arrowFixity, negateFixity, negatePrecedence,
28 IPName(..), ipNameName, mapIPName,
32 RecFlag(..), isRec, isNonRec,
34 TopLevelFlag(..), isTopLevel, isNotTopLevel,
36 Boxity(..), isBoxed, tupleParens,
38 OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
39 isDeadOcc, isLoopBreaker,
41 InsideLam, insideLam, notInsideLam,
42 OneBranch, oneBranch, notOneBranch,
46 StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
49 Activation(..), isActive, isNeverActive, isAlwaysActive,
51 SuccessFlag(..), succeeded, failed, successIf
54 #include "HsVersions.h"
60 %************************************************************************
62 \subsection[Unused]{Unused}
64 %************************************************************************
66 Used as a placeholder in types.
72 unused = error "Unused is used!"
76 %************************************************************************
78 \subsection[Arity]{Arity}
80 %************************************************************************
87 %************************************************************************
89 \subsection[Version]{Module and identifier version numbers}
91 %************************************************************************
96 bogusVersion :: Version -- Shouldn't look at these
97 bogusVersion = error "bogusVersion"
99 bumpVersion :: Bool -> Version -> Version
100 -- Bump if the predicate (typically equality between old and new) is false
101 bumpVersion False v = v+1
102 bumpVersion True v = v
104 initialVersion :: Version
109 %************************************************************************
111 \subsection{Implicit parameter identity}
113 %************************************************************************
115 The @IPName@ type is here because it is used in TypeRep (i.e. very
116 early in the hierarchy), but also in HsSyn.
120 = Dupable name -- ?x: you can freely duplicate this implicit parameter
121 | Linear name -- %x: you must use the splitting function to duplicate it
122 deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map
123 -- (used in HscTypes.OrigIParamCache)
126 ipNameName :: IPName name -> name
127 ipNameName (Dupable n) = n
128 ipNameName (Linear n) = n
130 mapIPName :: (a->b) -> IPName a -> IPName b
131 mapIPName f (Dupable n) = Dupable (f n)
132 mapIPName f (Linear n) = Linear (f n)
136 %************************************************************************
138 \subsection[Fixity]{Fixity info}
140 %************************************************************************
143 ------------------------
144 data FixitySig name = FixitySig name Fixity SrcLoc
146 instance Eq name => Eq (FixitySig name) where
147 (FixitySig n1 f1 _) == (FixitySig n2 f2 _) = n1==n2 && f1==f2
149 instance Outputable name => Outputable (FixitySig name) where
150 ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
152 ------------------------
153 data Fixity = Fixity Int FixityDirection
155 instance Outputable Fixity where
156 ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
158 instance Eq Fixity where -- Used to determine if two fixities conflict
159 (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
161 ------------------------
162 data FixityDirection = InfixL | InfixR | InfixN
165 instance Outputable FixityDirection where
166 ppr InfixL = ptext SLIT("infixl")
167 ppr InfixR = ptext SLIT("infixr")
168 ppr InfixN = ptext SLIT("infix")
170 ------------------------
171 maxPrecedence = (9::Int)
172 defaultFixity = Fixity maxPrecedence InfixL
174 negateFixity :: Fixity
175 negateFixity = Fixity negatePrecedence InfixL -- Precedence of unary negate is wired in as infixl 6!
177 arrowFixity :: Fixity -- Fixity of '->' in types
178 arrowFixity = Fixity 0 InfixR
180 negatePrecedence :: Int
189 @(compareFixity op1 op2)@ tells which way to arrange appication, or
190 whether there's an error.
193 compareFixity :: Fixity -> Fixity
194 -> (Bool, -- Error please
195 Bool) -- Associate to the right: a op1 (b op2 c)
196 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
197 = case prec1 `compare` prec2 of
200 EQ -> case (dir1, dir2) of
201 (InfixR, InfixR) -> right
202 (InfixL, InfixL) -> left
205 right = (False, True)
206 left = (False, False)
207 error_please = (True, False)
211 %************************************************************************
213 \subsection[NewType/DataType]{NewType/DataType flag}
215 %************************************************************************
219 = NewType -- "newtype Blah ..."
220 | DataType -- "data Blah ..."
221 deriving( Eq ) -- Needed because Demand derives Eq
225 %************************************************************************
227 \subsection[Top-level/local]{Top-level/not-top level flag}
229 %************************************************************************
236 isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
238 isNotTopLevel NotTopLevel = True
239 isNotTopLevel TopLevel = False
241 isTopLevel TopLevel = True
242 isTopLevel NotTopLevel = False
245 %************************************************************************
247 \subsection[Top-level/local]{Top-level/not-top level flag}
249 %************************************************************************
257 isBoxed :: Boxity -> Bool
259 isBoxed Unboxed = False
261 tupleParens :: Boxity -> SDoc -> SDoc
262 tupleParens Boxed p = parens p
263 tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
267 %************************************************************************
269 \subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
271 %************************************************************************
274 data RecFlag = Recursive
277 isRec :: RecFlag -> Bool
278 isRec Recursive = True
279 isRec NonRecursive = False
281 isNonRec :: RecFlag -> Bool
282 isNonRec Recursive = False
283 isNonRec NonRecursive = True
286 %************************************************************************
288 \subsection[Generic]{Generic flag}
290 %************************************************************************
292 This is the "Embedding-Projection pair" datatype, it contains
293 two pieces of code (normally either RenamedHsExpr's or Id's)
294 If we have a such a pair (EP from to), the idea is that 'from' and 'to'
295 represents functions of type
304 T and Tring are arbitrary, but typically T is the 'main' type while
305 Tring is the 'representation' type. (This just helps us remember
306 whether to use 'from' or 'to'.
309 data EP a = EP { fromEP :: a, -- :: T -> Tring
310 toEP :: a } -- :: Tring -> T
313 Embedding-projection pairs are used in several places:
315 First of all, each type constructor has an EP associated with it, the
316 code in EP converts (datatype T) from T to Tring and back again.
318 Secondly, when we are filling in Generic methods (in the typechecker,
319 tcMethodBinds), we are constructing bimaps by induction on the structure
320 of the type of the method signature.
323 %************************************************************************
325 \subsection{Occurrence information}
327 %************************************************************************
329 This data type is used exclusively by the simplifier, but it appears in a
330 SubstResult, which is currently defined in VarEnv, which is pretty near
331 the base of the module hierarchy. So it seemed simpler to put the
332 defn of OccInfo here, safely at the bottom
338 | IAmDead -- Marks unused variables. Sometimes useful for
339 -- lambda and case-bound variables.
345 | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
346 -- in a group of recursive definitions
348 seqOccInfo :: OccInfo -> ()
349 seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` ()
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.
358 type OneBranch = Bool -- True <=> Occurs in only one case branch
359 -- so no code-duplication issue to worry about
363 isLoopBreaker :: OccInfo -> Bool
364 isLoopBreaker IAmALoopBreaker = True
365 isLoopBreaker other = False
367 isDeadOcc :: OccInfo -> Bool
368 isDeadOcc IAmDead = True
369 isDeadOcc other = False
371 isOneOcc (OneOcc _ _) = True
372 isOneOcc other = False
374 isFragileOcc :: OccInfo -> Bool
375 isFragileOcc (OneOcc _ _) = True
376 isFragileOcc other = False
380 instance Outputable OccInfo where
381 -- only used for debugging; never parsed. KSW 1999-07
382 ppr NoOccInfo = empty
383 ppr IAmALoopBreaker = ptext SLIT("_Kx")
384 ppr IAmDead = ptext SLIT("_Kd")
385 ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
386 | one_branch = ptext SLIT("_Ks")
387 | otherwise = ptext SLIT("_Ks*")
389 instance Show OccInfo where
390 showsPrec p occ = showsPrecSDoc p (ppr occ)
393 %************************************************************************
395 \subsection{Strictness indication}
397 %************************************************************************
399 The strictness annotations on types in data type declarations
400 e.g. data T = MkT !Int !(Bool,Bool)
404 = MarkedUserStrict -- "!" in a source decl
405 | MarkedUserUnboxed -- "!!" in a source decl
406 | MarkedStrict -- "!" in an interface decl: strict but not unboxed
407 | MarkedUnboxed -- "!!" in an interface decl: unboxed
408 | NotMarkedStrict -- No annotation at all
411 isMarkedUnboxed MarkedUnboxed = True
412 isMarkedUnboxed other = False
414 isMarkedStrict NotMarkedStrict = False
415 isMarkedStrict other = True -- All others are strict
417 instance Outputable StrictnessMark where
418 ppr MarkedUserStrict = ptext SLIT("!u")
419 ppr MarkedStrict = ptext SLIT("!")
420 ppr MarkedUnboxed = ptext SLIT("! !")
421 ppr NotMarkedStrict = empty
425 %************************************************************************
427 \subsection{Success flag}
429 %************************************************************************
432 data SuccessFlag = Succeeded | Failed
434 successIf :: Bool -> SuccessFlag
435 successIf True = Succeeded
436 successIf False = Failed
438 succeeded, failed :: SuccessFlag -> Bool
439 succeeded Succeeded = True
440 succeeded Failed = False
442 failed Succeeded = False
447 %************************************************************************
449 \subsection{Activation}
451 %************************************************************************
453 When a rule or inlining is active
456 type CompilerPhase = Int -- Compilation phase
457 -- Phases decrease towards zero
458 -- Zero is the last phase
460 data Activation = NeverActive
462 | ActiveBefore CompilerPhase -- Active only *before* this phase
463 | ActiveAfter CompilerPhase -- Active in this phase and later
464 deriving( Eq ) -- Eq used in comparing rules in HsDecls
466 instance Outputable Activation where
467 ppr AlwaysActive = empty -- The default
468 ppr (ActiveBefore n) = brackets (char '~' <> int n)
469 ppr (ActiveAfter n) = brackets (int n)
470 ppr NeverActive = ptext SLIT("NEVER")
472 isActive :: CompilerPhase -> Activation -> Bool
473 isActive p NeverActive = False
474 isActive p AlwaysActive = True
475 isActive p (ActiveAfter n) = p <= n
476 isActive p (ActiveBefore n) = p > n
478 isNeverActive, isAlwaysActive :: Activation -> Bool
479 isNeverActive NeverActive = True
480 isNeverActive act = False
482 isAlwaysActive AlwaysActive = True
483 isAlwaysActive other = False