2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Id]{@Ids@: Value and constructor identifiers}
11 IdDetails(..), -- Exposed only to MkId
14 DataCon, DictFun, DictVar,
16 -- Construction and modification
17 mkId, mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
19 setIdVisibility, mkVanillaId,
21 -- DESTRUCTION (excluding pragmatic info)
27 -- Extracting pieces of particular sorts of Ids
38 recordSelectorFieldLabel,
45 idWantsToBeINLINEd, getInlinePragma,
46 idMustBeINLINEd, idMustNotBeINLINEd,
49 isDataCon, isAlgCon, isNewCon, isTupleCon,
52 isRecordSelector, isSpecPragmaId,
55 -- PRINTING and RENUMBERING
59 -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
72 addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
77 IdEnv, GenIdSet, IdSet,
91 lookupIdEnv, lookupIdSubst,
107 #include "HsVersions.h"
109 import {-# SOURCE #-} CoreUnfold ( Unfolding )
111 import CmdLineOpts ( opt_PprStyle_All )
114 import Name ( nameUnique, isLocalName, mkSysLocalName,
115 isWiredInName, setNameVisibility,
116 ExportFlag(..), Provenance,
117 OccName(..), Name, Module,
120 import PrimOp ( PrimOp )
121 import PrelMods ( pREL_TUP, pREL_BASE )
122 import FieldLabel ( fieldLabelName, FieldLabel(..) )
123 import SrcLoc ( mkBuiltinSrcLoc )
124 import TysWiredIn ( tupleTyCon )
125 import TyCon ( TyCon, isDataTyCon, isNewTyCon )
126 import Type ( mkSigmaTy, mkTyVarTys, mkFunTys,
127 mkTyConApp, instantiateTy, mkForAllTys,
128 tyVarsOfType, instantiateTy, typePrimRep,
130 ThetaType, TauType, Type, GenType
132 import TyVar ( TyVar, alphaTyVars, isEmptyTyVarSet,
133 TyVarEnv, zipTyVarEnv, mkTyVarEnv
136 import UniqSet -- practically all of it
137 import Unique ( Unique, Uniquable(..), getBuiltinUniques )
139 import SrcLoc ( SrcLoc )
140 import Util ( nOfThem, assoc )
141 import GlaExts ( Int# )
144 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
147 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
148 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
149 strictness). The essential info about different kinds of @Ids@ is
152 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
156 idUnique :: Unique, -- Key for fast comparison
158 idType :: ty, -- Id's type; used all the time;
159 idDetails :: IdDetails, -- Stuff about individual kinds of Ids.
160 idInfo :: IdInfo -- Properties of this Id deduced by compiler
165 data StrictnessMark = MarkedStrict | NotMarkedStrict
169 ---------------- Local values
171 = VanillaId Bool -- Ordinary Id
172 -- True <=> no free type vars
174 | PrimitiveId PrimOp -- The Id for a primitive operation
177 ---------------- Data constructors
179 | AlgConId -- Used for both data and newtype constructors.
180 -- You can tell the difference by looking at the TyCon
182 [StrictnessMark] -- Strict args; length = arity
183 [FieldLabel] -- Field labels for this constructor;
184 --length = 0 (not a record) or arity
186 [TyVar] ThetaType -- Type vars and context for the data type decl
187 [TyVar] ThetaType -- Ditto for the context of the constructor,
188 -- the existentially quantified stuff
189 [Type] TyCon -- Args and result tycon
191 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
192 -- unitype_1 -> ... -> unitype_n -> tycon tyvars
194 | TupleConId Int -- Its arity
196 | RecordSelId FieldLabel
198 | SpecPragmaId -- This guy exists only to make Ids that are
199 -- on the *LHS* of bindings created by SPECIALISE
200 -- pragmas; eg: s = f Int d
201 -- The SpecPragmaId is never itself mentioned; it
202 -- exists solely so that the specialiser will find
203 -- the call to f, and make specialised version of it.
204 -- The SpecPragmaId binding is discarded by the specialiser
205 -- when it gathers up overloaded calls.
206 -- Meanwhile, it is not discarded as dead code.
217 %************************************************************************
219 \subsection{Construction}
221 %************************************************************************
224 mkId :: Name -> ty -> IdDetails -> IdInfo -> GenId ty
225 mkId name ty details info
226 = Id {idName = name, idUnique = nameUnique name, idType = ty,
227 idDetails = details, idInfo = info}
229 mkVanillaId :: Name -> (GenType flexi) -> IdInfo -> GenId (GenType flexi)
230 mkVanillaId name ty info
231 = Id {idName = name, idUnique = nameUnique name, idType = ty,
232 idDetails = VanillaId (isEmptyTyVarSet (tyVarsOfType ty)),
235 mkIdWithNewUniq :: Id -> Unique -> Id
236 mkIdWithNewUniq id uniq = id {idUnique = uniq}
238 mkIdWithNewName :: Id -> Name -> Id
239 mkIdWithNewName id new_name
240 = id {idUnique = uniqueOf new_name, idName = new_name}
242 mkIdWithNewType :: GenId ty1 -> ty2 -> GenId ty2
243 mkIdWithNewType id ty = id {idType = ty}
247 Make some local @Ids@ for a template @CoreExpr@. These have bogus
248 @Uniques@, but that's OK because the templates are supposed to be
249 instantiated before use.
252 mkTemplateLocals :: [Type] -> [Id]
254 = zipWith mk (getBuiltinUniques (length tys)) tys
256 mk uniq ty = mkVanillaId (mkSysLocalName uniq SLIT("tpl") mkBuiltinSrcLoc)
262 -- See notes with setNameVisibility (Name.lhs)
263 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
264 setIdVisibility maybe_mod u id
265 = id {idName = setNameVisibility maybe_mod u (idName id)}
267 replaceIdInfo :: GenId ty -> IdInfo -> GenId ty
268 replaceIdInfo id info = id {idInfo = info}
271 %************************************************************************
273 \subsection[Id-general-funs]{General @Id@-related functions}
275 %************************************************************************
279 fIRST_TAG = 1 -- Tags allocated from here for real constructors
281 -- isDataCon returns False for @newtype@ constructors
282 isDataCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isDataTyCon tc
283 isDataCon (Id {idDetails = TupleConId _}) = True
284 isDataCon other = False
286 isNewCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tc}) = isNewTyCon tc
287 isNewCon other = False
289 -- isAlgCon returns True for @data@ or @newtype@ constructors
290 isAlgCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ _}) = True
291 isAlgCon (Id {idDetails = TupleConId _}) = True
292 isAlgCon other = False
294 isTupleCon (Id {idDetails = TupleConId _}) = True
295 isTupleCon other = False
299 idHasNoFreeTyVars :: Id -> Bool
301 idHasNoFreeTyVars (Id {idDetails = details})
304 chk (AlgConId _ _ _ _ _ _ _ _ _) = True
305 chk (TupleConId _) = True
306 chk (RecordSelId _) = True
307 chk (VanillaId no_free_tvs) = no_free_tvs
308 chk (PrimitiveId _) = True
309 chk SpecPragmaId = False -- Play safe
311 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
312 -- so we don't need to put its signature in an interface file, even if it's mentioned
313 -- in some other interface unfolding.
319 omitIfaceSigForId (Id {idName = name, idDetails = details})
325 (PrimitiveId _) -> True -- Ditto, for primitives
327 -- This group is Ids that are implied by their type or class decl;
328 -- remember that all type and class decls appear in the interface file.
329 -- The dfun id must *not* be omitted, because it carries version info for
331 (AlgConId _ _ _ _ _ _ _ _ _) -> True
332 (TupleConId _) -> True
333 (RecordSelId _) -> True
335 other -> False -- Don't omit!
336 -- NB DefaultMethodIds are not omitted
340 isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
342 isPrimitiveId_maybe (Id {idDetails = PrimitiveId primop}) = Just primop
343 isPrimitiveId_maybe other = Nothing
345 isSpecPragmaId (Id {idDetails = SpecPragmaId}) = True
346 isSpecPragmaId _ = False
349 @externallyVisibleId@: is it true that another module might be
350 able to ``see'' this Id in a code generation sense. That
351 is, another .o file might refer to this Id.
353 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
354 local-ness precisely so that the test here would be easy
357 externallyVisibleId :: Id -> Bool
358 externallyVisibleId id = not (isLocalName (idName id))
359 -- not local => global => externally visible
364 idPrimRep id = typePrimRep (idType id)
368 %************************************************************************
370 \subsection[Id-arities]{Arity-related functions}
372 %************************************************************************
374 For locally-defined Ids, the code generator maintains its own notion
375 of their arities; so it should not be asking... (but other things
376 besides the code-generator need arity info!)
379 getIdArity :: Id -> ArityInfo
380 getIdArity id = arityInfo (idInfo id)
382 addIdArity :: Id -> ArityInfo -> Id
383 addIdArity id@(Id {idInfo = info}) arity
384 = id {idInfo = arity `setArityInfo` info}
387 %************************************************************************
389 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
391 %************************************************************************
394 dataConNumFields gives the number of actual fields in the
395 {\em representation} of the data constructor. This may be more than appear
396 in the source code; the extra ones are the existentially quantified
401 = ASSERT( if (isDataCon id) then True else
402 pprTrace "dataConNumFields" (ppr id) False )
403 case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
404 length con_theta + length arg_tys }
406 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
412 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
413 dataConTag (Id {idDetails = AlgConId tag _ _ _ _ _ _ _ _}) = tag
414 dataConTag (Id {idDetails = TupleConId _}) = fIRST_TAG
416 dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
417 dataConTyCon (Id {idDetails = AlgConId _ _ _ _ _ _ _ _ tycon}) = tycon
418 dataConTyCon (Id {idDetails = TupleConId a}) = tupleTyCon a
420 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
421 -- will panic if not a DataCon
423 dataConSig (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
424 = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
426 dataConSig (Id {idDetails = TupleConId arity})
427 = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
429 tyvars = take arity alphaTyVars
430 tyvar_tys = mkTyVarTys tyvars
433 -- dataConRepType returns the type of the representation of a contructor
434 -- This may differ from the type of the contructor Id itself for two reasons:
435 -- a) the constructor Id may be overloaded, but the dictionary isn't stored
436 -- e.g. data Eq a => T a = MkT a a
438 -- b) the constructor may store an unboxed version of a strict field.
440 -- Here's an example illustrating both:
441 -- data Ord a => T a = MkT Int! a
443 -- T :: Ord a => Int -> a -> T a
444 -- but the rep type is
445 -- Trep :: Int# -> a -> T a
446 -- Actually, the unboxed part isn't implemented yet!
448 dataConRepType :: Id -> Type
449 dataConRepType (Id {idDetails = AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon})
450 = mkForAllTys (tyvars++con_tyvars)
451 (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
452 dataConRepType other_id
453 = ASSERT( isDataCon other_id )
456 dataConFieldLabels :: DataCon -> [FieldLabel]
457 dataConFieldLabels (Id {idDetails = AlgConId _ _ fields _ _ _ _ _ _}) = fields
458 dataConFieldLabels (Id {idDetails = TupleConId _}) = []
460 dataConFieldLabels x@(Id {idDetails = idt}) =
461 panic ("dataConFieldLabel: " ++
465 RecordSelId _ -> "r"))
468 dataConStrictMarks :: DataCon -> [StrictnessMark]
469 dataConStrictMarks (Id {idDetails = AlgConId _ stricts _ _ _ _ _ _ _}) = stricts
470 dataConStrictMarks (Id {idDetails = TupleConId arity}) = nOfThem arity NotMarkedStrict
472 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
473 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
475 dataConArgTys :: DataCon
476 -> [Type] -- Instantiated at these types
477 -> [Type] -- Needs arguments of these types
478 dataConArgTys con_id inst_tys
479 = map (instantiateTy tenv) arg_tys
481 (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
482 tenv = zipTyVarEnv tyvars inst_tys
486 recordSelectorFieldLabel :: Id -> FieldLabel
487 recordSelectorFieldLabel (Id {idDetails = RecordSelId lbl}) = lbl
489 isRecordSelector (Id {idDetails = RecordSelId lbl}) = True
490 isRecordSelector other = False
494 %************************************************************************
496 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
498 %************************************************************************
501 getIdUnfolding :: Id -> Unfolding
503 getIdUnfolding id = unfoldingInfo (idInfo id)
505 addIdUnfolding :: Id -> Unfolding -> Id
506 addIdUnfolding id@(Id {idInfo = info}) unfolding
507 = id {idInfo = unfolding `setUnfoldingInfo` info}
510 The inline pragma tells us to be very keen to inline this Id, but it's still
511 OK not to if optimisation is switched off.
514 getInlinePragma :: Id -> InlinePragInfo
515 getInlinePragma id = inlinePragInfo (idInfo id)
517 idWantsToBeINLINEd :: Id -> Bool
519 idWantsToBeINLINEd id = case getInlinePragma id of
520 IWantToBeINLINEd -> True
521 IMustBeINLINEd -> True
524 idMustNotBeINLINEd id = case getInlinePragma id of
525 IMustNotBeINLINEd -> True
528 idMustBeINLINEd id = case getInlinePragma id of
529 IMustBeINLINEd -> True
532 addInlinePragma :: Id -> Id
533 addInlinePragma id@(Id {idInfo = info})
534 = id {idInfo = setInlinePragInfo IWantToBeINLINEd info}
536 nukeNoInlinePragma :: Id -> Id
537 nukeNoInlinePragma id@(Id {idInfo = info})
538 = case inlinePragInfo info of
539 IMustNotBeINLINEd -> id {idInfo = setInlinePragInfo NoPragmaInfo info}
542 addNoInlinePragma :: Id -> Id
543 addNoInlinePragma id@(Id {idInfo = info})
544 = id {idInfo = IMustNotBeINLINEd `setInlinePragInfo` info}
546 mustInlineInfo = IMustBeINLINEd `setInlinePragInfo` noIdInfo
547 wantToInlineInfo = IWantToBeINLINEd `setInlinePragInfo` noIdInfo
552 %************************************************************************
554 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
556 %************************************************************************
559 getIdDemandInfo :: Id -> DemandInfo
560 getIdDemandInfo id = demandInfo (idInfo id)
562 addIdDemandInfo :: Id -> DemandInfo -> Id
563 addIdDemandInfo id@(Id {idInfo = info}) demand_info
564 = id {idInfo = demand_info `setDemandInfo` info}
568 getIdUpdateInfo :: Id -> UpdateInfo
569 getIdUpdateInfo id = updateInfo (idInfo id)
571 addIdUpdateInfo :: Id -> UpdateInfo -> Id
572 addIdUpdateInfo id@(Id {idInfo = info}) upd_info
573 = id {idInfo = upd_info `setUpdateInfo` info}
577 getIdSpecialisation :: Id -> IdSpecEnv
578 getIdSpecialisation id = specInfo (idInfo id)
580 setIdSpecialisation :: Id -> IdSpecEnv -> Id
581 setIdSpecialisation id@(Id {idInfo = info}) spec_info
582 = id {idInfo = spec_info `setSpecInfo` info}
586 getIdStrictness :: Id -> StrictnessInfo
587 getIdStrictness id = strictnessInfo (idInfo id)
589 addIdStrictness :: Id -> StrictnessInfo -> Id
590 addIdStrictness id@(Id {idInfo = info}) strict_info
591 = id {idInfo = strict_info `setStrictnessInfo` info}
594 %************************************************************************
596 \subsection[Id-comparison]{Comparison functions for @Id@s}
598 %************************************************************************
600 Comparison: equality and ordering---this stuff gets {\em hammered}.
603 cmpId (Id {idUnique = u1}) (Id {idUnique = u2}) = compare u1 u2
607 instance Eq (GenId ty) where
608 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
609 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
611 instance Ord (GenId ty) where
612 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
613 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
614 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
615 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
616 compare a b = cmpId a b
619 %************************************************************************
621 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
623 %************************************************************************
626 instance Outputable ty => Outputable (GenId ty) where
629 showId :: Id -> String
630 showId id = showSDoc (pprId id)
633 Default printing code (not used for interfaces):
635 pprId :: Outputable ty => GenId ty -> SDoc
637 pprId Id {idUnique = u, idName = n, idInfo = info}
638 = hcat [ppr n, pp_prags]
640 pp_prags | opt_PprStyle_All = case inlinePragInfo info of
641 IMustNotBeINLINEd -> text "{n}"
642 IWantToBeINLINEd -> text "{i}"
643 IMustBeINLINEd -> text "{I}"
649 instance Uniquable (GenId ty) where
652 instance NamedThing (GenId ty) where
656 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
657 the @Uniques@ out of local @Ids@ given to it.
659 %************************************************************************
661 \subsection{@IdEnv@s and @IdSet@s}
663 %************************************************************************
666 type IdEnv elt = UniqFM elt
670 mkIdEnv :: [(GenId ty, a)] -> IdEnv a
671 unitIdEnv :: GenId ty -> a -> IdEnv a
672 addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
673 growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
674 growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
676 delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
677 delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
678 combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
679 mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
680 modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
681 rngIdEnv :: IdEnv a -> [a]
683 isNullIdEnv :: IdEnv a -> Bool
684 lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
685 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
686 elemIdEnv :: Id -> IdEnv a -> Bool
691 addOneToIdEnv = addToUFM
692 combineIdEnvs = plusUFM_C
693 delManyFromIdEnv = delListFromUFM
694 delOneFromIdEnv = delFromUFM
696 lookupIdEnv = lookupUFM
702 isNullIdEnv = isNullUFM
704 growIdEnvList env pairs = plusUFM env (listToUFM pairs)
705 lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
707 lookupIdSubst :: IdEnv Id -> Id -> Id
708 lookupIdSubst env id = case lookupIdEnv env id of
709 Just id' -> id' -- Return original if
710 Nothing -> id -- it isn't in subst
712 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
713 -- modify function, and put it back.
715 modifyIdEnv mangle_fn env key
716 = case (lookupIdEnv env key) of
718 Just xx -> addOneToIdEnv env key (mangle_fn xx)
720 modifyIdEnv_Directly mangle_fn env key
721 = case (lookupUFM_Directly env key) of
723 Just xx -> addToUFM_Directly env key (mangle_fn xx)
727 type GenIdSet ty = UniqSet (GenId ty)
728 type IdSet = UniqSet (GenId Type)
730 emptyIdSet :: GenIdSet ty
731 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
732 unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
733 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
734 idSetToList :: GenIdSet ty -> [GenId ty]
735 unitIdSet :: GenId ty -> GenIdSet ty
736 addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
737 elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
738 minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
739 isEmptyIdSet :: GenIdSet ty -> Bool
740 mkIdSet :: [GenId ty] -> GenIdSet ty
742 emptyIdSet = emptyUniqSet
743 unitIdSet = unitUniqSet
744 addOneToIdSet = addOneToUniqSet
745 intersectIdSets = intersectUniqSets
746 unionIdSets = unionUniqSets
747 unionManyIdSets = unionManyUniqSets
748 idSetToList = uniqSetToList
749 elementOfIdSet = elementOfUniqSet
750 minusIdSet = minusUniqSet
751 isEmptyIdSet = isEmptyUniqSet