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 | MarkedStrict -- "!" in an interface decl: strict but not unboxed
406 | MarkedUnboxed -- "!!" in an interface decl: unboxed
407 | NotMarkedStrict -- No annotation at all
410 isMarkedUnboxed MarkedUnboxed = True
411 isMarkedUnboxed other = False
413 isMarkedStrict NotMarkedStrict = False
414 isMarkedStrict other = True -- All others are strict
416 instance Outputable StrictnessMark where
417 ppr MarkedUserStrict = ptext SLIT("!u")
418 ppr MarkedStrict = ptext SLIT("!")
419 ppr MarkedUnboxed = ptext SLIT("! !")
420 ppr NotMarkedStrict = empty
424 %************************************************************************
426 \subsection{Success flag}
428 %************************************************************************
431 data SuccessFlag = Succeeded | Failed
433 successIf :: Bool -> SuccessFlag
434 successIf True = Succeeded
435 successIf False = Failed
437 succeeded, failed :: SuccessFlag -> Bool
438 succeeded Succeeded = True
439 succeeded Failed = False
441 failed Succeeded = False
446 %************************************************************************
448 \subsection{Activation}
450 %************************************************************************
452 When a rule or inlining is active
455 type CompilerPhase = Int -- Compilation phase
456 -- Phases decrease towards zero
457 -- Zero is the last phase
459 data Activation = NeverActive
461 | ActiveBefore CompilerPhase -- Active only *before* this phase
462 | ActiveAfter CompilerPhase -- Active in this phase and later
463 deriving( Eq ) -- Eq used in comparing rules in HsDecls
465 instance Outputable Activation where
466 ppr AlwaysActive = empty -- The default
467 ppr (ActiveBefore n) = brackets (char '~' <> int n)
468 ppr (ActiveAfter n) = brackets (int n)
469 ppr NeverActive = ptext SLIT("NEVER")
471 isActive :: CompilerPhase -> Activation -> Bool
472 isActive p NeverActive = False
473 isActive p AlwaysActive = True
474 isActive p (ActiveAfter n) = p <= n
475 isActive p (ActiveBefore n) = p > n
477 isNeverActive, isAlwaysActive :: Activation -> Bool
478 isNeverActive NeverActive = True
479 isNeverActive act = False
481 isAlwaysActive AlwaysActive = True
482 isAlwaysActive other = False