2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Id]{@Ids@: Value and constructor identifiers}
7 #include "HsVersions.h"
11 GenId(..), -- *naughtily* used in some places (e.g., TcHsSyn)
12 SYN_IE(Id), IdDetails,
14 SYN_IE(ConTag), fIRST_TAG,
15 SYN_IE(DataCon), SYN_IE(DictFun), SYN_IE(DictVar),
21 mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
37 -- DESTRUCTION (excluding pragmatic info)
53 recordSelectorFieldLabel,
59 cmpId_withSpecDataCon,
62 idWantsToBeINLINEd, getInlinePragma,
63 idMustBeINLINEd, idMustNotBeINLINEd,
65 isDataCon, isAlgCon, isNewCon,
67 isDefaultMethodId_maybe,
74 isSuperDictSelId_maybe,
80 unfoldingUnfriendlyId,
86 -- PRINTING and RENUMBERING
95 -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
109 replaceIdInfo, replacePragmaInfo,
110 addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
113 SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
134 modifyIdEnv_Directly,
145 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
146 IMPORT_DELOOPER(IdLoop) -- for paranoia checking
147 IMPORT_DELOOPER(TyLoop) -- for paranoia checking
149 import {-# SOURCE #-} SpecEnv ( SpecEnv )
150 import {-# SOURCE #-} CoreUnfold ( Unfolding )
151 import {-# SOURCE #-} StdIdInfo ( addStandardIdInfo )
152 -- Let's see how much we can leave out..
153 --import {-# SOURCE #-} TysPrim
157 import Class ( SYN_IE(Class), GenClass )
158 import BasicTypes ( SYN_IE(Arity) )
160 import Maybes ( maybeToBool )
161 import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
162 mkCompoundName, mkInstDeclName,
163 isLocallyDefinedName, occNameString, modAndOcc,
164 isLocallyDefined, changeUnique, isWiredInName,
165 nameString, getOccString, setNameVisibility,
166 isExported, ExportFlag(..), Provenance,
167 OccName(..), Name, SYN_IE(Module),
170 import PrelMods ( pREL_TUP, pREL_BASE )
171 import Lex ( mkTupNameStr )
172 import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
173 import PragmaInfo ( PragmaInfo(..) )
174 #if __GLASGOW_HASKELL__ >= 202
175 import PrimOp ( PrimOp )
177 import PprType ( getTypeString, specMaybeTysSuffix,
181 import MatchEnv ( MatchEnv )
182 import SrcLoc ( mkBuiltinSrcLoc )
183 import TysWiredIn ( tupleTyCon )
184 import TyCon ( TyCon, tyConDataCons, isDataTyCon, isNewTyCon, mkSpecTyCon )
185 import Type ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy, splitSigmaTy,
186 applyTyCon, instantiateTy, mkForAllTys,
187 tyVarsOfType, applyTypeEnvToTy, typePrimRep,
188 specialiseTy, instantiateTauTy,
189 GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
191 import TyVar ( SYN_IE(TyVar), GenTyVar, alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
192 import Usage ( SYN_IE(UVar) )
194 import UniqSet -- practically all of it
195 import Unique ( getBuiltinUniques, pprUnique,
197 Unique{-instance Ord3-},
200 import Outputable ( ifPprDebug, Outputable(..), PprStyle(..) )
201 import SrcLoc ( SrcLoc )
202 import Util ( Ord3(..), mapAccumL, nOfThem, zipEqual, assoc,
203 panic, panic#, pprPanic, assertPanic
207 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
210 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
211 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
212 strictness). The essential info about different kinds of @Ids@ is
215 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
219 Unique -- Key for fast comparison
221 ty -- Id's type; used all the time;
222 IdDetails -- Stuff about individual kinds of Ids.
223 PragmaInfo -- Properties of this Id requested by programmer
224 -- eg specialise-me, inline-me
225 IdInfo -- Properties of this Id deduced by compiler
229 data StrictnessMark = MarkedStrict | NotMarkedStrict
233 ---------------- Local values
235 = LocalId Bool -- Local name; mentioned by the user
236 -- True <=> no free type vars
238 | SysLocalId Bool -- Local name; made up by the compiler
241 | PrimitiveId PrimOp -- The Id for a primitive operation
243 | SpecPragmaId -- Local name; introduced by the compiler
244 (Maybe Id) -- for explicit specid in pragma
245 Bool -- as for LocalId
247 ---------------- Global values
249 | ImportedId -- Global name (Imported or Implicit); Id imported from an interface
251 ---------------- Data constructors
253 | AlgConId -- Used for both data and newtype constructors.
254 -- You can tell the difference by looking at the TyCon
256 [StrictnessMark] -- Strict args; length = arity
257 [FieldLabel] -- Field labels for this constructor;
258 --length = 0 (not a record) or arity
260 [TyVar] [(Class,Type)] -- Type vars and context for the data type decl
261 [TyVar] [(Class,Type)] -- Ditto for the context of the constructor,
262 -- the existentially quantified stuff
263 [Type] TyCon -- Args and result tycon
265 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
266 -- unitype_1 -> ... -> unitype_n -> tycon tyvars
268 | TupleConId Int -- Its arity
270 | RecordSelId FieldLabel
272 ---------------- Things to do with overloading
274 | SuperDictSelId -- Selector for superclass dictionary
275 Class -- The class (input dict)
276 Class -- The superclass (result dict)
278 | MethodSelId Class -- An overloaded class operation, with
279 -- a fully polymorphic type. Its code
280 -- just selects a method from the
283 -- NB: The IdInfo for a MethodSelId has all the info about its
284 -- related "constant method Ids", which are just
285 -- specialisations of this general one.
287 | DefaultMethodId -- Default method for a particular class op
288 Class -- same class, <blah-blah> info as MethodSelId
291 | DictFunId Class -- A DictFun is uniquely identified
292 Type -- by its class and type; this type has free type vars,
293 -- whose identity is irrelevant. Eg Class = Eq
295 -- The "a" is irrelevant. As it is too painful to
296 -- actually do comparisons that way, we kindly supply
297 -- a Unique for that purpose.
299 | InstId -- An instance of a dictionary, class operation,
300 -- or overloaded value (Local name)
301 Bool -- as for LocalId
303 | SpecId -- A specialisation of another Id
304 Id -- Id of which this is a specialisation
305 [Maybe Type] -- Types at which it is specialised;
306 -- A "Nothing" says this type ain't relevant.
307 Bool -- True <=> no free type vars; it's not enough
308 -- to know about the unspec version, because
309 -- we may specialise to a type w/ free tyvars
310 -- (i.e., in one of the "Maybe Type" dudes).
318 DictFunIds are generated from instance decls.
323 instance Foo a => Foo [a] where
326 generates the dict fun id decl
328 dfun.Foo.[*] = \d -> ...
330 The dfun id is uniquely named by the (class, type) pair. Notice, it
331 isn't a (class,tycon) pair any more, because we may get manually or
332 automatically generated specialisations of the instance decl:
334 instance Foo [Int] where
341 The type variables in the name are irrelevant; we print them as stars.
344 Constant method ids are generated from instance decls where
345 there is no context; that is, no dictionaries are needed to
346 construct the method. Example
348 instance Foo Int where
351 Then we get a constant method
356 It is possible, albeit unusual, to have a constant method
357 for an instance decl which has type vars:
359 instance Foo [a] where
363 We get the constant method
367 So a constant method is identified by a class/op/type triple.
368 The type variables in the type are irrelevant.
371 For Ids whose names must be known/deducible in other modules, we have
372 to conjure up their worker's names (and their worker's worker's
373 names... etc) in a known systematic way.
376 %************************************************************************
378 \subsection[Id-documentation]{Documentation}
380 %************************************************************************
384 The @Id@ datatype describes {\em values}. The basic things we want to
385 know: (1)~a value's {\em type} (@idType@ is a very common
386 operation in the compiler); and (2)~what ``flavour'' of value it might
387 be---for example, it can be terribly useful to know that a value is a
391 %----------------------------------------------------------------------
392 \item[@AlgConId@:] For the data constructors declared by a @data@
393 declaration. Their type is kept in {\em two} forms---as a regular
394 @Type@ (in the usual place), and also in its constituent pieces (in
395 the ``details''). We are frequently interested in those pieces.
397 %----------------------------------------------------------------------
398 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
399 the infinite family of tuples.
401 %----------------------------------------------------------------------
402 \item[@ImportedId@:] These are values defined outside this module.
403 {\em Everything} we want to know about them must be stored here (or in
406 %----------------------------------------------------------------------
407 \item[@MethodSelId@:] A selector from a dictionary; it may select either
408 a method or a dictionary for one of the class's superclasses.
410 %----------------------------------------------------------------------
413 @mkDictFunId [a,b..] theta C T@ is the function derived from the
416 instance theta => C (T a b ..) where
419 It builds function @Id@ which maps dictionaries for theta,
420 to a dictionary for C (T a b ..).
422 *Note* that with the ``Mark Jones optimisation'', the theta may
423 include dictionaries for the immediate superclasses of C at the type
426 %----------------------------------------------------------------------
429 %----------------------------------------------------------------------
432 %----------------------------------------------------------------------
433 \item[@LocalId@:] A purely-local value, e.g., a function argument,
434 something defined in a @where@ clauses, ... --- but which appears in
435 the original program text.
437 %----------------------------------------------------------------------
438 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
439 the original program text; these are introduced by the compiler in
442 %----------------------------------------------------------------------
443 \item[@SpecPragmaId@:] Introduced by the compiler to record
444 Specialisation pragmas. It is dead code which MUST NOT be removed
445 before specialisation.
450 %----------------------------------------------------------------------
453 @DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
454 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
458 They have no free type variables, so if you are making a
459 type-variable substitution you don't need to look inside them.
461 They are constants, so they are not free variables. (When the STG
462 machine makes a closure, it puts all the free variables in the
463 closure; the above are not required.)
465 Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
466 properties, but they may not.
469 %************************************************************************
471 \subsection[Id-general-funs]{General @Id@-related functions}
473 %************************************************************************
476 -- isDataCon returns False for @newtype@ constructors
477 isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
478 isDataCon (Id _ _ _ (TupleConId _) _ _) = True
479 isDataCon (Id _ _ _ (SpecId unspec _ _) _ _) = isDataCon unspec
480 isDataCon other = False
482 isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
483 isNewCon other = False
485 -- isAlgCon returns True for @data@ or @newtype@ constructors
486 isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
487 isAlgCon (Id _ _ _ (TupleConId _) _ _) = True
488 isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _) = isAlgCon unspec
489 isAlgCon other = False
491 isTupleCon (Id _ _ _ (TupleConId _) _ _) = True
492 isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _) = isTupleCon unspec
493 isTupleCon other = False
496 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
497 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
498 defined at top level (returns @True@). This is used to decide whether
499 the @Id@ is a candidate free variable. NB: you are only {\em sure}
500 about something if it returns @True@!
503 toplevelishId :: Id -> Bool
504 idHasNoFreeTyVars :: Id -> Bool
506 toplevelishId (Id _ _ _ details _ _)
509 chk (AlgConId _ __ _ _ _ _ _ _) = True
510 chk (TupleConId _) = True
511 chk (RecordSelId _) = True
512 chk ImportedId = True
513 chk (SuperDictSelId _ _) = True
514 chk (MethodSelId _) = True
515 chk (DefaultMethodId _) = True
516 chk (DictFunId _ _) = True
517 chk (SpecId unspec _ _) = toplevelishId unspec
518 -- depends what the unspecialised thing is
519 chk (InstId _) = False -- these are local
520 chk (LocalId _) = False
521 chk (SysLocalId _) = False
522 chk (SpecPragmaId _ _) = False
523 chk (PrimitiveId _) = True
525 idHasNoFreeTyVars (Id _ _ _ details _ info)
528 chk (AlgConId _ _ _ _ _ _ _ _ _) = True
529 chk (TupleConId _) = True
530 chk (RecordSelId _) = True
531 chk ImportedId = True
532 chk (SuperDictSelId _ _) = True
533 chk (MethodSelId _) = True
534 chk (DefaultMethodId _) = True
535 chk (DictFunId _ _) = True
536 chk (SpecId _ _ no_free_tvs) = no_free_tvs
537 chk (InstId no_free_tvs) = no_free_tvs
538 chk (LocalId no_free_tvs) = no_free_tvs
539 chk (SysLocalId no_free_tvs) = no_free_tvs
540 chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
541 chk (PrimitiveId _) = True
543 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
544 -- so we don't need to put its signature in an interface file, even if it's mentioned
545 -- in some other interface unfolding.
551 omitIfaceSigForId (Id _ name _ details _ _)
557 ImportedId -> True -- Never put imports in interface file
558 (PrimitiveId _) -> True -- Ditto, for primitives
560 -- This group is Ids that are implied by their type or class decl;
561 -- remember that all type and class decls appear in the interface file.
562 -- The dfun id must *not* be omitted, because it carries version info for
564 (AlgConId _ _ _ _ _ _ _ _ _) -> True
565 (TupleConId _) -> True
566 (RecordSelId _) -> True
567 (SuperDictSelId _ _) -> True
568 (MethodSelId _) -> True
570 other -> False -- Don't omit!
571 -- NB DefaultMethodIds are not omitted
575 isImportedId (Id _ _ _ ImportedId _ _) = True
576 isImportedId other = False
578 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
580 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
581 isSysLocalId other = False
583 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
584 isSpecPragmaId other = False
586 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
587 = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
588 Just (unspec, ty_maybes)
589 isSpecId_maybe other_id
592 isMethodSelId_maybe (Id _ _ _ (MethodSelId cls) _ _) = Just cls
593 isMethodSelId_maybe _ = Nothing
595 isDefaultMethodId (Id _ _ _ (DefaultMethodId _) _ _) = True
596 isDefaultMethodId other = False
598 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls) _ _)
600 isDefaultMethodId_maybe other = Nothing
602 isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
603 isDictFunId other = False
605 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
606 isSuperDictSelId_maybe other_id = Nothing
608 isWrapperId id = workerExists (getIdStrictness id)
610 isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
611 isPrimitiveId_maybe other = Nothing
615 unfoldingUnfriendlyId -- return True iff it is definitely a bad
616 :: Id -- idea to export an unfolding that
617 -> Bool -- mentions this Id. Reason: it cannot
618 -- possibly be seen in another module.
620 unfoldingUnfriendlyId id = not (externallyVisibleId id)
623 @externallyVisibleId@: is it true that another module might be
624 able to ``see'' this Id in a code generation sense. That
625 is, another .o file might refer to this Id.
627 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
628 local-ness precisely so that the test here would be easy
631 externallyVisibleId :: Id -> Bool
632 externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
633 -- not local => global => externally visible
636 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
637 `Top-levelish Ids'' cannot have any free type variables, so applying
638 the type-env cannot have any effect. (NB: checked in CoreLint?)
641 type TypeEnv = TyVarEnv Type
643 applyTypeEnvToId :: TypeEnv -> Id -> Id
644 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
645 = apply_to_Id ( \ ty ->
646 applyTypeEnvToTy type_env ty
651 apply_to_Id :: (Type -> Type) -> Id -> Id
653 apply_to_Id ty_fn id@(Id u n ty details prag info)
654 | idHasNoFreeTyVars id
657 = Id u n (ty_fn ty) (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
659 apply_to_details (SpecId unspec ty_maybes no_ftvs)
661 new_unspec = apply_to_Id ty_fn unspec
662 new_maybes = map apply_to_maybe ty_maybes
664 SpecId new_unspec new_maybes (no_free_tvs ty)
665 -- ToDo: gratuitous recalc no_ftvs???? (also InstId)
667 apply_to_maybe Nothing = Nothing
668 apply_to_maybe (Just ty) = Just (ty_fn ty)
670 apply_to_details other = other
674 %************************************************************************
676 \subsection[Id-type-funs]{Type-related @Id@ functions}
678 %************************************************************************
681 idName :: GenId ty -> Name
682 idName (Id _ n _ _ _ _) = n
684 idType :: GenId ty -> ty
685 idType (Id _ _ ty _ _ _) = ty
687 idPrimRep i = typePrimRep (idType i)
690 %************************************************************************
692 \subsection[Id-overloading]{Functions related to overloading}
694 %************************************************************************
697 mkSuperDictSelId u clas sc ty
698 = addStandardIdInfo $
699 Id u name ty details NoPragmaInfo noIdInfo
701 name = mkCompoundName name_fn u (getName clas)
702 details = SuperDictSelId clas sc
703 name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
704 (mod,occ) = modAndOcc sc
706 -- For method selectors the clean thing to do is
707 -- to give the method selector the same name as the class op itself.
708 mkMethodSelId op_name rec_c ty
709 = addStandardIdInfo $
710 Id (uniqueOf op_name) op_name ty (MethodSelId rec_c) NoPragmaInfo noIdInfo
712 mkDefaultMethodId dm_name rec_c ty
713 = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c) NoPragmaInfo noIdInfo
715 mkDictFunId dfun_name full_ty clas ity
716 = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
718 details = DictFunId clas ity
720 mkWorkerId u unwrkr ty info
721 = Id u name ty details NoPragmaInfo info
723 details = LocalId (no_free_tvs ty)
724 name = mkCompoundName name_fn u (getName unwrkr)
725 name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
728 = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
731 %************************************************************************
733 \subsection[local-funs]{@LocalId@-related functions}
735 %************************************************************************
738 mkImported n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
740 mkPrimitiveId n ty primop
741 = addStandardIdInfo $
742 Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
743 -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
744 -- It's only true for primitives, because we don't want to make a closure for each of them.
750 type MyTy a b = GenType (GenTyVar a) b
751 type MyId a b = GenId (MyTy a b)
753 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
755 -- SysLocal: for an Id being created by the compiler out of thin air...
756 -- UserLocal: an Id with a name the user might recognize...
757 mkSysLocal :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
758 mkUserLocal :: OccName -> Unique -> MyTy a b -> SrcLoc -> MyId a b
760 mkSysLocal str uniq ty loc
761 = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
763 mkUserLocal occ uniq ty loc
764 = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
766 mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
767 mkUserId name ty pragma_info
768 = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
772 -- See notes with setNameVisibility (Name.lhs)
773 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
774 setIdVisibility maybe_mod u (Id uniq name ty details prag info)
775 = Id uniq (setNameVisibility maybe_mod u name) ty details prag info
777 mkIdWithNewUniq :: Id -> Unique -> Id
778 mkIdWithNewUniq (Id _ n ty details prag info) u
779 = Id u (changeUnique n u) ty details prag info
781 mkIdWithNewName :: Id -> Name -> Id
782 mkIdWithNewName (Id _ _ ty details prag info) new_name
783 = Id (uniqueOf new_name) new_name ty details prag info
785 mkIdWithNewType :: Id -> Type -> Id
786 mkIdWithNewType (Id u name _ details pragma info) ty
787 = Id u name ty details pragma info
789 -- Specialised version of constructor: only used in STG and code generation
790 -- Note: The specialsied Id has the same unique as the unspeced Id
792 mkSameSpecCon ty_maybes unspec@(Id u name ty details pragma info)
793 = ASSERT(isDataCon unspec)
794 ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
795 Id u name new_ty (SpecId unspec ty_maybes (no_free_tvs new_ty)) pragma info
797 new_ty = specialiseTy ty ty_maybes 0
799 -- pprTrace "SameSpecCon:Unique:"
800 -- (ppSep (ppr PprDebug unspec: [pprMaybeTy PprDebug ty | ty <- ty_maybes]))
803 Make some local @Ids@ for a template @CoreExpr@. These have bogus
804 @Uniques@, but that's OK because the templates are supposed to be
805 instantiated before use.
807 mkTemplateLocals :: [Type] -> [Id]
809 = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
810 (getBuiltinUniques (length tys))
815 getIdInfo :: GenId ty -> IdInfo
816 getPragmaInfo :: GenId ty -> PragmaInfo
818 getIdInfo (Id _ _ _ _ _ info) = info
819 getPragmaInfo (Id _ _ _ _ info _) = info
821 replaceIdInfo :: Id -> IdInfo -> Id
822 replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
824 replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
825 replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
828 %************************************************************************
830 \subsection[Id-arities]{Arity-related functions}
832 %************************************************************************
834 For locally-defined Ids, the code generator maintains its own notion
835 of their arities; so it should not be asking... (but other things
836 besides the code-generator need arity info!)
839 getIdArity :: Id -> ArityInfo
840 getIdArity id@(Id _ _ _ _ _ id_info)
843 addIdArity :: Id -> ArityInfo -> Id
844 addIdArity (Id u n ty details pinfo info) arity
845 = Id u n ty details pinfo (info `addArityInfo` arity)
848 %************************************************************************
850 \subsection[Id-arities]{Deforestation related functions}
852 %************************************************************************
855 addIdDeforestInfo :: Id -> DeforestInfo -> Id
856 addIdDeforestInfo (Id u n ty details pinfo info) def_info
857 = Id u n ty details pinfo (info `addDeforestInfo` def_info)
860 %************************************************************************
862 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
864 %************************************************************************
868 -> [StrictnessMark] -> [FieldLabel]
869 -> [TyVar] -> ThetaType
870 -> [TyVar] -> ThetaType
871 -> [TauType] -> TyCon
873 -- can get the tag and all the pieces of the type from the Type
875 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
876 = ASSERT(length stricts == length args_tys)
877 addStandardIdInfo data_con
879 -- NB: data_con self-recursion; should be OK as tags are not
880 -- looked at until late in the game.
885 (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
886 IWantToBeINLINEd -- Always inline constructors if possible
889 data_con_tag = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
890 data_con_family = tyConDataCons tycon
893 = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
894 (mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
897 mkTupleCon :: Arity -> Name -> Type -> Id
898 mkTupleCon arity name ty
899 = addStandardIdInfo tuple_id
901 tuple_id = Id (nameUnique name) name ty
903 IWantToBeINLINEd -- Always inline constructors if possible
907 fIRST_TAG = 1 -- Tags allocated from here for real constructors
910 dataConNumFields gives the number of actual fields in the
911 {\em representation} of the data constructor. This may be more than appear
912 in the source code; the extra ones are the existentially quantified
917 = ASSERT(isDataCon id)
918 case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
919 length con_theta + length arg_tys }
921 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
927 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
928 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
929 dataConTag (Id _ _ _ (TupleConId _) _ _) = fIRST_TAG
930 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _) = dataConTag unspec
932 dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
933 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
934 dataConTyCon (Id _ _ _ (TupleConId a) _ _) = tupleTyCon a
936 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
937 -- will panic if not a DataCon
939 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
940 = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
942 dataConSig (Id _ _ _ (TupleConId arity) _ _)
943 = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
945 tyvars = take arity alphaTyVars
946 tyvar_tys = mkTyVarTys tyvars
947 dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
948 = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
950 (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec
952 ty_env = tyvars `zip` ty_maybes
954 spec_tyvars = foldr nothing_tyvars [] ty_env
955 spec_con_tyvars = foldr nothing_tyvars [] (con_tyvars `zip` ty_maybes) -- Hmm..
957 nothing_tyvars (tyvar, Nothing) l = tyvar : l
958 nothing_tyvars (tyvar, Just ty) l = l
960 spec_env = foldr just_env [] ty_env
961 just_env (tyvar, Nothing) l = l
962 just_env (tyvar, Just ty) l = (tyvar, ty) : l
963 spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
965 spec_theta_ty = if null theta_ty then []
966 else panic "dataConSig:ThetaTy:SpecDataCon1"
967 spec_con_theta = if null con_theta then []
968 else panic "dataConSig:ThetaTy:SpecDataCon2"
969 spec_tycon = mkSpecTyCon tycon ty_maybes
972 -- dataConRepType returns the type of the representation of a contructor
973 -- This may differ from the type of the contructor Id itself for two reasons:
974 -- a) the constructor Id may be overloaded, but the dictionary isn't stored
975 -- b) the constructor may store an unboxed version of a strict field.
976 -- Here's an example illustrating both:
977 -- data Ord a => T a = MkT Int! a
979 -- T :: Ord a => Int -> a -> T a
980 -- but the rep type is
981 -- Trep :: Int# -> a -> T a
982 -- Actually, the unboxed part isn't implemented yet!
984 dataConRepType :: GenId (GenType tv u) -> GenType tv u
986 = mkForAllTys tyvars tau
988 (tyvars, theta, tau) = splitSigmaTy (idType con)
990 dataConFieldLabels :: DataCon -> [FieldLabel]
991 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
992 dataConFieldLabels (Id _ _ _ (TupleConId _) _ _) = []
994 dataConStrictMarks :: DataCon -> [StrictnessMark]
995 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
996 dataConStrictMarks (Id _ _ _ (TupleConId arity) _ _)
997 = nOfThem arity NotMarkedStrict
999 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
1000 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
1002 dataConArgTys :: DataCon
1003 -> [Type] -- Instantiated at these types
1004 -> [Type] -- Needs arguments of these types
1005 dataConArgTys con_id inst_tys
1006 = map (instantiateTy tenv) arg_tys
1008 (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
1009 tenv = zipEqual "dataConArgTys" tyvars inst_tys
1013 mkRecordSelId field_label selector_ty
1014 = addStandardIdInfo $ -- Record selectors have a standard unfolding
1015 Id (nameUnique name)
1018 (RecordSelId field_label)
1022 name = fieldLabelName field_label
1024 recordSelectorFieldLabel :: Id -> FieldLabel
1025 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1027 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
1028 isRecordSelector other = False
1032 Data type declarations are of the form:
1034 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1036 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1037 @C1 x y z@, we want a function binding:
1039 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1041 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1042 2nd-order polymorphic lambda calculus with explicit types.
1044 %************************************************************************
1046 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1048 %************************************************************************
1051 getIdUnfolding :: Id -> Unfolding
1053 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1055 addIdUnfolding :: Id -> Unfolding -> Id
1056 addIdUnfolding id@(Id u n ty details prag info) unfolding
1057 = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1060 The inline pragma tells us to be very keen to inline this Id, but it's still
1061 OK not to if optimisation is switched off.
1064 getInlinePragma :: Id -> PragmaInfo
1065 getInlinePragma (Id _ _ _ _ prag _) = prag
1067 idWantsToBeINLINEd :: Id -> Bool
1069 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1070 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1071 idWantsToBeINLINEd _ = False
1073 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1074 idMustNotBeINLINEd _ = False
1076 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1077 idMustBeINLINEd _ = False
1079 addInlinePragma :: Id -> Id
1080 addInlinePragma (Id u sn ty details _ info)
1081 = Id u sn ty details IWantToBeINLINEd info
1083 nukeNoInlinePragma :: Id -> Id
1084 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1085 = Id u sn ty details NoPragmaInfo info
1086 nukeNoInlinePragma id@(Id u sn ty details _ info) = id -- Otherwise no-op
1088 addNoInlinePragma :: Id -> Id
1089 addNoInlinePragma id@(Id u sn ty details _ info)
1090 = Id u sn ty details IMustNotBeINLINEd info
1095 %************************************************************************
1097 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1099 %************************************************************************
1102 getIdDemandInfo :: Id -> DemandInfo
1103 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1105 addIdDemandInfo :: Id -> DemandInfo -> Id
1106 addIdDemandInfo (Id u n ty details prags info) demand_info
1107 = Id u n ty details prags (info `addDemandInfo` demand_info)
1111 getIdUpdateInfo :: Id -> UpdateInfo
1112 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1114 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1115 addIdUpdateInfo (Id u n ty details prags info) upd_info
1116 = Id u n ty details prags (info `addUpdateInfo` upd_info)
1121 getIdArgUsageInfo :: Id -> ArgUsageInfo
1122 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1124 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1125 addIdArgUsageInfo (Id u n ty info details) au_info
1126 = Id u n ty (info `addArgusageInfo` au_info) details
1132 getIdFBTypeInfo :: Id -> FBTypeInfo
1133 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1135 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1136 addIdFBTypeInfo (Id u n ty info details) upd_info
1137 = Id u n ty (info `addFBTypeInfo` upd_info) details
1142 getIdSpecialisation :: Id -> SpecEnv
1143 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1145 addIdSpecialisation :: Id -> SpecEnv -> Id
1146 addIdSpecialisation (Id u n ty details prags info) spec_info
1147 = Id u n ty details prags (info `addSpecInfo` spec_info)
1150 Strictness: we snaffle the info out of the IdInfo.
1153 getIdStrictness :: Id -> StrictnessInfo
1155 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1157 addIdStrictness :: Id -> StrictnessInfo -> Id
1158 addIdStrictness (Id u n ty details prags info) strict_info
1159 = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1162 %************************************************************************
1164 \subsection[Id-comparison]{Comparison functions for @Id@s}
1166 %************************************************************************
1168 Comparison: equality and ordering---this stuff gets {\em hammered}.
1171 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = cmp u1 u2
1172 -- short and very sweet
1176 instance Ord3 (GenId ty) where
1179 instance Eq (GenId ty) where
1180 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
1181 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
1183 instance Ord (GenId ty) where
1184 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
1185 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
1186 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
1187 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
1188 _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1191 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1192 account when comparing two data constructors. We need to do this
1193 because a specialised data constructor has the same Unique as its
1194 unspecialised counterpart.
1197 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1199 cmpId_withSpecDataCon id1 id2
1200 | eq_ids && isDataCon id1 && isDataCon id2
1201 = cmpEqDataCon id1 id2
1206 cmp_ids = cmpId id1 id2
1207 eq_ids = case cmp_ids of { EQ_ -> True; other -> False }
1209 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1210 = panic# "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1212 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT_
1213 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT_
1214 cmpEqDataCon _ _ = EQ_
1217 %************************************************************************
1219 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1221 %************************************************************************
1224 instance Outputable ty => Outputable (GenId ty) where
1225 ppr sty id = pprId sty id
1227 -- and a SPECIALIZEd one:
1228 instance Outputable {-Id, i.e.:-}(GenId Type) where
1229 ppr sty id = pprId sty id
1231 showId :: PprStyle -> Id -> String
1232 showId sty id = show (pprId sty id)
1235 Default printing code (not used for interfaces):
1237 pprId :: Outputable ty => PprStyle -> GenId ty -> Doc
1239 pprId sty (Id u n _ _ prags _)
1240 = hcat [ppr sty n, pp_prags]
1242 pp_prags = ifPprDebug sty (case prags of
1243 IMustNotBeINLINEd -> text "{n}"
1244 IWantToBeINLINEd -> text "{i}"
1245 IMustBeINLINEd -> text "{I}"
1248 -- WDP 96/05/06: We can re-elaborate this as we go along...
1252 idUnique (Id u _ _ _ _ _) = u
1254 instance Uniquable (GenId ty) where
1257 instance NamedThing (GenId ty) where
1258 getName this_id@(Id u n _ details _ _) = n
1261 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1262 the @Uniques@ out of local @Ids@ given to it.
1264 %************************************************************************
1266 \subsection{@IdEnv@s and @IdSet@s}
1268 %************************************************************************
1271 type IdEnv elt = UniqFM elt
1273 nullIdEnv :: IdEnv a
1275 mkIdEnv :: [(GenId ty, a)] -> IdEnv a
1276 unitIdEnv :: GenId ty -> a -> IdEnv a
1277 addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
1278 growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
1279 growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1281 delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
1282 delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
1283 combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1284 mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
1285 modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1286 rngIdEnv :: IdEnv a -> [a]
1288 isNullIdEnv :: IdEnv a -> Bool
1289 lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
1290 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1294 addOneToIdEnv = addToUFM
1295 combineIdEnvs = plusUFM_C
1296 delManyFromIdEnv = delListFromUFM
1297 delOneFromIdEnv = delFromUFM
1299 lookupIdEnv = lookupUFM
1302 nullIdEnv = emptyUFM
1306 growIdEnvList env pairs = plusUFM env (listToUFM pairs)
1307 isNullIdEnv env = sizeUFM env == 0
1308 lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
1310 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1311 -- modify function, and put it back.
1313 modifyIdEnv mangle_fn env key
1314 = case (lookupIdEnv env key) of
1316 Just xx -> addOneToIdEnv env key (mangle_fn xx)
1318 modifyIdEnv_Directly mangle_fn env key
1319 = case (lookupUFM_Directly env key) of
1321 Just xx -> addToUFM_Directly env key (mangle_fn xx)
1325 type GenIdSet ty = UniqSet (GenId ty)
1326 type IdSet = UniqSet (GenId Type)
1328 emptyIdSet :: GenIdSet ty
1329 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1330 unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1331 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1332 idSetToList :: GenIdSet ty -> [GenId ty]
1333 unitIdSet :: GenId ty -> GenIdSet ty
1334 addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
1335 elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
1336 minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1337 isEmptyIdSet :: GenIdSet ty -> Bool
1338 mkIdSet :: [GenId ty] -> GenIdSet ty
1340 emptyIdSet = emptyUniqSet
1341 unitIdSet = unitUniqSet
1342 addOneToIdSet = addOneToUniqSet
1343 intersectIdSets = intersectUniqSets
1344 unionIdSets = unionUniqSets
1345 unionManyIdSets = unionManyUniqSets
1346 idSetToList = uniqSetToList
1347 elementOfIdSet = elementOfUniqSet
1348 minusIdSet = minusUniqSet
1349 isEmptyIdSet = isEmptyUniqSet