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
94 -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
108 replaceIdInfo, replacePragmaInfo,
109 addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
112 SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
133 modifyIdEnv_Directly,
144 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
145 IMPORT_DELOOPER(IdLoop) -- for paranoia checking
146 IMPORT_DELOOPER(TyLoop) -- for paranoia checking
148 import {-# SOURCE #-} SpecEnv ( SpecEnv )
149 import {-# SOURCE #-} CoreUnfold ( Unfolding )
150 import {-# SOURCE #-} StdIdInfo ( addStandardIdInfo )
151 -- Let's see how much we can leave out..
152 --import {-# SOURCE #-} TysPrim
156 import Class ( SYN_IE(Class), GenClass )
157 import BasicTypes ( SYN_IE(Arity) )
159 import Maybes ( maybeToBool )
160 import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
161 mkCompoundName, mkInstDeclName,
162 isLocallyDefinedName, occNameString, modAndOcc,
163 isLocallyDefined, changeUnique, isWiredInName,
164 nameString, getOccString, setNameVisibility,
165 isExported, ExportFlag(..), Provenance,
166 OccName(..), Name, SYN_IE(Module),
169 import PrelMods ( pREL_TUP, pREL_BASE )
170 import Lex ( mkTupNameStr )
171 import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
172 import PragmaInfo ( PragmaInfo(..) )
173 #if __GLASGOW_HASKELL__ >= 202
174 import PrimOp ( PrimOp )
176 import PprType ( getTypeString, specMaybeTysSuffix,
180 import MatchEnv ( MatchEnv )
181 import SrcLoc ( mkBuiltinSrcLoc )
182 import TysWiredIn ( tupleTyCon )
183 import TyCon ( TyCon, tyConDataCons, isDataTyCon, isNewTyCon, mkSpecTyCon )
184 import Type ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy, splitSigmaTy,
185 applyTyCon, instantiateTy, mkForAllTys,
186 tyVarsOfType, applyTypeEnvToTy, typePrimRep,
187 specialiseTy, instantiateTauTy,
188 GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
190 import TyVar ( SYN_IE(TyVar), GenTyVar, alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
191 import Usage ( SYN_IE(UVar) )
193 import UniqSet -- practically all of it
194 import Unique ( getBuiltinUniques, pprUnique,
196 Unique{-instance Ord3-},
199 import Outputable ( ifPprDebug, Outputable(..), PprStyle(..) )
200 import SrcLoc ( SrcLoc )
201 import Util ( Ord3(..), mapAccumL, nOfThem, zipEqual, assoc,
202 panic, panic#, pprPanic, assertPanic
206 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
209 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
210 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
211 strictness). The essential info about different kinds of @Ids@ is
214 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
218 Unique -- Key for fast comparison
220 ty -- Id's type; used all the time;
221 IdDetails -- Stuff about individual kinds of Ids.
222 PragmaInfo -- Properties of this Id requested by programmer
223 -- eg specialise-me, inline-me
224 IdInfo -- Properties of this Id deduced by compiler
228 data StrictnessMark = MarkedStrict | NotMarkedStrict
232 ---------------- Local values
234 = LocalId Bool -- Local name; mentioned by the user
235 -- True <=> no free type vars
237 | SysLocalId Bool -- Local name; made up by the compiler
240 | PrimitiveId PrimOp -- The Id for a primitive operation
242 | SpecPragmaId -- Local name; introduced by the compiler
243 (Maybe Id) -- for explicit specid in pragma
244 Bool -- as for LocalId
246 ---------------- Global values
248 | ImportedId -- Global name (Imported or Implicit); Id imported from an interface
250 ---------------- Data constructors
252 | AlgConId -- Used for both data and newtype constructors.
253 -- You can tell the difference by looking at the TyCon
255 [StrictnessMark] -- Strict args; length = arity
256 [FieldLabel] -- Field labels for this constructor;
257 --length = 0 (not a record) or arity
259 [TyVar] [(Class,Type)] -- Type vars and context for the data type decl
260 [TyVar] [(Class,Type)] -- Ditto for the context of the constructor,
261 -- the existentially quantified stuff
262 [Type] TyCon -- Args and result tycon
264 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
265 -- unitype_1 -> ... -> unitype_n -> tycon tyvars
267 | TupleConId Int -- Its arity
269 | RecordSelId FieldLabel
271 ---------------- Things to do with overloading
273 | SuperDictSelId -- Selector for superclass dictionary
274 Class -- The class (input dict)
275 Class -- The superclass (result dict)
277 | MethodSelId Class -- An overloaded class operation, with
278 -- a fully polymorphic type. Its code
279 -- just selects a method from the
282 -- NB: The IdInfo for a MethodSelId has all the info about its
283 -- related "constant method Ids", which are just
284 -- specialisations of this general one.
286 | DefaultMethodId -- Default method for a particular class op
287 Class -- same class, <blah-blah> info as MethodSelId
290 | DictFunId Class -- A DictFun is uniquely identified
291 Type -- by its class and type; this type has free type vars,
292 -- whose identity is irrelevant. Eg Class = Eq
294 -- The "a" is irrelevant. As it is too painful to
295 -- actually do comparisons that way, we kindly supply
296 -- a Unique for that purpose.
298 | InstId -- An instance of a dictionary, class operation,
299 -- or overloaded value (Local name)
300 Bool -- as for LocalId
302 | SpecId -- A specialisation of another Id
303 Id -- Id of which this is a specialisation
304 [Maybe Type] -- Types at which it is specialised;
305 -- A "Nothing" says this type ain't relevant.
306 Bool -- True <=> no free type vars; it's not enough
307 -- to know about the unspec version, because
308 -- we may specialise to a type w/ free tyvars
309 -- (i.e., in one of the "Maybe Type" dudes).
317 DictFunIds are generated from instance decls.
322 instance Foo a => Foo [a] where
325 generates the dict fun id decl
327 dfun.Foo.[*] = \d -> ...
329 The dfun id is uniquely named by the (class, type) pair. Notice, it
330 isn't a (class,tycon) pair any more, because we may get manually or
331 automatically generated specialisations of the instance decl:
333 instance Foo [Int] where
340 The type variables in the name are irrelevant; we print them as stars.
343 Constant method ids are generated from instance decls where
344 there is no context; that is, no dictionaries are needed to
345 construct the method. Example
347 instance Foo Int where
350 Then we get a constant method
355 It is possible, albeit unusual, to have a constant method
356 for an instance decl which has type vars:
358 instance Foo [a] where
362 We get the constant method
366 So a constant method is identified by a class/op/type triple.
367 The type variables in the type are irrelevant.
370 For Ids whose names must be known/deducible in other modules, we have
371 to conjure up their worker's names (and their worker's worker's
372 names... etc) in a known systematic way.
375 %************************************************************************
377 \subsection[Id-documentation]{Documentation}
379 %************************************************************************
383 The @Id@ datatype describes {\em values}. The basic things we want to
384 know: (1)~a value's {\em type} (@idType@ is a very common
385 operation in the compiler); and (2)~what ``flavour'' of value it might
386 be---for example, it can be terribly useful to know that a value is a
390 %----------------------------------------------------------------------
391 \item[@AlgConId@:] For the data constructors declared by a @data@
392 declaration. Their type is kept in {\em two} forms---as a regular
393 @Type@ (in the usual place), and also in its constituent pieces (in
394 the ``details''). We are frequently interested in those pieces.
396 %----------------------------------------------------------------------
397 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
398 the infinite family of tuples.
400 %----------------------------------------------------------------------
401 \item[@ImportedId@:] These are values defined outside this module.
402 {\em Everything} we want to know about them must be stored here (or in
405 %----------------------------------------------------------------------
406 \item[@MethodSelId@:] A selector from a dictionary; it may select either
407 a method or a dictionary for one of the class's superclasses.
409 %----------------------------------------------------------------------
412 @mkDictFunId [a,b..] theta C T@ is the function derived from the
415 instance theta => C (T a b ..) where
418 It builds function @Id@ which maps dictionaries for theta,
419 to a dictionary for C (T a b ..).
421 *Note* that with the ``Mark Jones optimisation'', the theta may
422 include dictionaries for the immediate superclasses of C at the type
425 %----------------------------------------------------------------------
428 %----------------------------------------------------------------------
431 %----------------------------------------------------------------------
432 \item[@LocalId@:] A purely-local value, e.g., a function argument,
433 something defined in a @where@ clauses, ... --- but which appears in
434 the original program text.
436 %----------------------------------------------------------------------
437 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
438 the original program text; these are introduced by the compiler in
441 %----------------------------------------------------------------------
442 \item[@SpecPragmaId@:] Introduced by the compiler to record
443 Specialisation pragmas. It is dead code which MUST NOT be removed
444 before specialisation.
449 %----------------------------------------------------------------------
452 @DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
453 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
457 They have no free type variables, so if you are making a
458 type-variable substitution you don't need to look inside them.
460 They are constants, so they are not free variables. (When the STG
461 machine makes a closure, it puts all the free variables in the
462 closure; the above are not required.)
464 Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
465 properties, but they may not.
468 %************************************************************************
470 \subsection[Id-general-funs]{General @Id@-related functions}
472 %************************************************************************
475 -- isDataCon returns False for @newtype@ constructors
476 isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
477 isDataCon (Id _ _ _ (TupleConId _) _ _) = True
478 isDataCon (Id _ _ _ (SpecId unspec _ _) _ _) = isDataCon unspec
479 isDataCon other = False
481 isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
482 isNewCon other = False
484 -- isAlgCon returns True for @data@ or @newtype@ constructors
485 isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
486 isAlgCon (Id _ _ _ (TupleConId _) _ _) = True
487 isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _) = isAlgCon unspec
488 isAlgCon other = False
490 isTupleCon (Id _ _ _ (TupleConId _) _ _) = True
491 isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _) = isTupleCon unspec
492 isTupleCon other = False
495 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
496 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
497 defined at top level (returns @True@). This is used to decide whether
498 the @Id@ is a candidate free variable. NB: you are only {\em sure}
499 about something if it returns @True@!
502 toplevelishId :: Id -> Bool
503 idHasNoFreeTyVars :: Id -> Bool
505 toplevelishId (Id _ _ _ details _ _)
508 chk (AlgConId _ __ _ _ _ _ _ _) = True
509 chk (TupleConId _) = True
510 chk (RecordSelId _) = True
511 chk ImportedId = True
512 chk (SuperDictSelId _ _) = True
513 chk (MethodSelId _) = True
514 chk (DefaultMethodId _) = True
515 chk (DictFunId _ _) = True
516 chk (SpecId unspec _ _) = toplevelishId unspec
517 -- depends what the unspecialised thing is
518 chk (InstId _) = False -- these are local
519 chk (LocalId _) = False
520 chk (SysLocalId _) = False
521 chk (SpecPragmaId _ _) = False
522 chk (PrimitiveId _) = True
524 idHasNoFreeTyVars (Id _ _ _ details _ info)
527 chk (AlgConId _ _ _ _ _ _ _ _ _) = True
528 chk (TupleConId _) = True
529 chk (RecordSelId _) = True
530 chk ImportedId = True
531 chk (SuperDictSelId _ _) = True
532 chk (MethodSelId _) = True
533 chk (DefaultMethodId _) = True
534 chk (DictFunId _ _) = True
535 chk (SpecId _ _ no_free_tvs) = no_free_tvs
536 chk (InstId no_free_tvs) = no_free_tvs
537 chk (LocalId no_free_tvs) = no_free_tvs
538 chk (SysLocalId no_free_tvs) = no_free_tvs
539 chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
540 chk (PrimitiveId _) = True
542 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
543 -- so we don't need to put its signature in an interface file, even if it's mentioned
544 -- in some other interface unfolding.
550 omitIfaceSigForId (Id _ name _ details _ _)
556 ImportedId -> True -- Never put imports in interface file
557 (PrimitiveId _) -> True -- Ditto, for primitives
559 -- This group is Ids that are implied by their type or class decl;
560 -- remember that all type and class decls appear in the interface file.
561 -- The dfun id must *not* be omitted, because it carries version info for
563 (AlgConId _ _ _ _ _ _ _ _ _) -> True
564 (TupleConId _) -> True
565 (RecordSelId _) -> True
566 (SuperDictSelId _ _) -> True
567 (MethodSelId _) -> True
569 other -> False -- Don't omit!
570 -- NB DefaultMethodIds are not omitted
574 isImportedId (Id _ _ _ ImportedId _ _) = True
575 isImportedId other = False
577 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
579 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
580 isSysLocalId other = False
582 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
583 isSpecPragmaId other = False
585 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
586 = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
587 Just (unspec, ty_maybes)
588 isSpecId_maybe other_id
591 isMethodSelId_maybe (Id _ _ _ (MethodSelId cls) _ _) = Just cls
592 isMethodSelId_maybe _ = Nothing
594 isDefaultMethodId (Id _ _ _ (DefaultMethodId _) _ _) = True
595 isDefaultMethodId other = False
597 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls) _ _)
599 isDefaultMethodId_maybe other = Nothing
601 isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
602 isDictFunId other = False
604 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
605 isSuperDictSelId_maybe other_id = Nothing
607 isWrapperId id = workerExists (getIdStrictness id)
609 isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
610 isPrimitiveId_maybe other = Nothing
614 unfoldingUnfriendlyId -- return True iff it is definitely a bad
615 :: Id -- idea to export an unfolding that
616 -> Bool -- mentions this Id. Reason: it cannot
617 -- possibly be seen in another module.
619 unfoldingUnfriendlyId id = not (externallyVisibleId id)
622 @externallyVisibleId@: is it true that another module might be
623 able to ``see'' this Id in a code generation sense. That
624 is, another .o file might refer to this Id.
626 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
627 local-ness precisely so that the test here would be easy
630 externallyVisibleId :: Id -> Bool
631 externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
632 -- not local => global => externally visible
635 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
636 `Top-levelish Ids'' cannot have any free type variables, so applying
637 the type-env cannot have any effect. (NB: checked in CoreLint?)
640 type TypeEnv = TyVarEnv Type
642 applyTypeEnvToId :: TypeEnv -> Id -> Id
643 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
644 = apply_to_Id ( \ ty ->
645 applyTypeEnvToTy type_env ty
650 apply_to_Id :: (Type -> Type) -> Id -> Id
652 apply_to_Id ty_fn id@(Id u n ty details prag info)
653 | idHasNoFreeTyVars id
656 = Id u n (ty_fn ty) (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
658 apply_to_details (SpecId unspec ty_maybes no_ftvs)
660 new_unspec = apply_to_Id ty_fn unspec
661 new_maybes = map apply_to_maybe ty_maybes
663 SpecId new_unspec new_maybes (no_free_tvs ty)
664 -- ToDo: gratuitous recalc no_ftvs???? (also InstId)
666 apply_to_maybe Nothing = Nothing
667 apply_to_maybe (Just ty) = Just (ty_fn ty)
669 apply_to_details other = other
673 %************************************************************************
675 \subsection[Id-type-funs]{Type-related @Id@ functions}
677 %************************************************************************
680 idName :: GenId ty -> Name
681 idName (Id _ n _ _ _ _) = n
683 idType :: GenId ty -> ty
684 idType (Id _ _ ty _ _ _) = ty
686 idPrimRep i = typePrimRep (idType i)
689 %************************************************************************
691 \subsection[Id-overloading]{Functions related to overloading}
693 %************************************************************************
696 mkSuperDictSelId u clas sc ty
697 = addStandardIdInfo $
698 Id u name ty details NoPragmaInfo noIdInfo
700 name = mkCompoundName name_fn u (getName clas)
701 details = SuperDictSelId clas sc
702 name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
703 (mod,occ) = modAndOcc sc
705 -- For method selectors the clean thing to do is
706 -- to give the method selector the same name as the class op itself.
707 mkMethodSelId op_name rec_c ty
708 = addStandardIdInfo $
709 Id (uniqueOf op_name) op_name ty (MethodSelId rec_c) NoPragmaInfo noIdInfo
711 mkDefaultMethodId dm_name rec_c ty
712 = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c) NoPragmaInfo noIdInfo
714 mkDictFunId dfun_name full_ty clas ity
715 = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
717 details = DictFunId clas ity
719 mkWorkerId u unwrkr ty info
720 = Id u name ty details NoPragmaInfo info
722 details = LocalId (no_free_tvs ty)
723 name = mkCompoundName name_fn u (getName unwrkr)
724 name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
727 = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
730 %************************************************************************
732 \subsection[local-funs]{@LocalId@-related functions}
734 %************************************************************************
737 mkImported n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
739 mkPrimitiveId n ty primop
740 = addStandardIdInfo $
741 Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
742 -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
743 -- It's only true for primitives, because we don't want to make a closure for each of them.
749 type MyTy a b = GenType (GenTyVar a) b
750 type MyId a b = GenId (MyTy a b)
752 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
754 -- SysLocal: for an Id being created by the compiler out of thin air...
755 -- UserLocal: an Id with a name the user might recognize...
756 mkSysLocal :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
757 mkUserLocal :: OccName -> Unique -> MyTy a b -> SrcLoc -> MyId a b
759 mkSysLocal str uniq ty loc
760 = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
762 mkUserLocal occ uniq ty loc
763 = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
765 mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
766 mkUserId name ty pragma_info
767 = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
771 -- See notes with setNameVisibility (Name.lhs)
772 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
773 setIdVisibility maybe_mod u (Id uniq name ty details prag info)
774 = Id uniq (setNameVisibility maybe_mod u name) ty details prag info
776 mkIdWithNewUniq :: Id -> Unique -> Id
777 mkIdWithNewUniq (Id _ n ty details prag info) u
778 = Id u (changeUnique n u) ty details prag info
780 mkIdWithNewName :: Id -> Name -> Id
781 mkIdWithNewName (Id _ _ ty details prag info) new_name
782 = Id (uniqueOf new_name) new_name ty details prag info
784 mkIdWithNewType :: Id -> Type -> Id
785 mkIdWithNewType (Id u name _ details pragma info) ty
786 = Id u name ty details pragma info
788 -- Specialised version of constructor: only used in STG and code generation
789 -- Note: The specialsied Id has the same unique as the unspeced Id
791 mkSameSpecCon ty_maybes unspec@(Id u name ty details pragma info)
792 = ASSERT(isDataCon unspec)
793 ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
794 Id u name new_ty (SpecId unspec ty_maybes (no_free_tvs new_ty)) pragma info
796 new_ty = specialiseTy ty ty_maybes 0
798 -- pprTrace "SameSpecCon:Unique:"
799 -- (ppSep (ppr PprDebug unspec: [pprMaybeTy PprDebug ty | ty <- ty_maybes]))
802 Make some local @Ids@ for a template @CoreExpr@. These have bogus
803 @Uniques@, but that's OK because the templates are supposed to be
804 instantiated before use.
806 mkTemplateLocals :: [Type] -> [Id]
808 = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
809 (getBuiltinUniques (length tys))
814 getIdInfo :: GenId ty -> IdInfo
815 getPragmaInfo :: GenId ty -> PragmaInfo
817 getIdInfo (Id _ _ _ _ _ info) = info
818 getPragmaInfo (Id _ _ _ _ info _) = info
820 replaceIdInfo :: Id -> IdInfo -> Id
821 replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
823 replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
824 replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
827 %************************************************************************
829 \subsection[Id-arities]{Arity-related functions}
831 %************************************************************************
833 For locally-defined Ids, the code generator maintains its own notion
834 of their arities; so it should not be asking... (but other things
835 besides the code-generator need arity info!)
838 getIdArity :: Id -> ArityInfo
839 getIdArity id@(Id _ _ _ _ _ id_info)
842 addIdArity :: Id -> ArityInfo -> Id
843 addIdArity (Id u n ty details pinfo info) arity
844 = Id u n ty details pinfo (info `addArityInfo` arity)
847 %************************************************************************
849 \subsection[Id-arities]{Deforestation related functions}
851 %************************************************************************
854 addIdDeforestInfo :: Id -> DeforestInfo -> Id
855 addIdDeforestInfo (Id u n ty details pinfo info) def_info
856 = Id u n ty details pinfo (info `addDeforestInfo` def_info)
859 %************************************************************************
861 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
863 %************************************************************************
867 -> [StrictnessMark] -> [FieldLabel]
868 -> [TyVar] -> ThetaType
869 -> [TyVar] -> ThetaType
870 -> [TauType] -> TyCon
872 -- can get the tag and all the pieces of the type from the Type
874 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
875 = ASSERT(length stricts == length args_tys)
876 addStandardIdInfo data_con
878 -- NB: data_con self-recursion; should be OK as tags are not
879 -- looked at until late in the game.
884 (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
885 IWantToBeINLINEd -- Always inline constructors if possible
888 data_con_tag = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
889 data_con_family = tyConDataCons tycon
892 = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
893 (mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
896 mkTupleCon :: Arity -> Name -> Type -> Id
897 mkTupleCon arity name ty
898 = addStandardIdInfo tuple_id
900 tuple_id = Id (nameUnique name) name ty
902 IWantToBeINLINEd -- Always inline constructors if possible
906 fIRST_TAG = 1 -- Tags allocated from here for real constructors
909 dataConNumFields gives the number of actual fields in the
910 {\em representation} of the data constructor. This may be more than appear
911 in the source code; the extra ones are the existentially quantified
916 = ASSERT(isDataCon id)
917 case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
918 length con_theta + length arg_tys }
920 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
926 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
927 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
928 dataConTag (Id _ _ _ (TupleConId _) _ _) = fIRST_TAG
929 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _) = dataConTag unspec
931 dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
932 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
933 dataConTyCon (Id _ _ _ (TupleConId a) _ _) = tupleTyCon a
935 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
936 -- will panic if not a DataCon
938 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
939 = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
941 dataConSig (Id _ _ _ (TupleConId arity) _ _)
942 = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
944 tyvars = take arity alphaTyVars
945 tyvar_tys = mkTyVarTys tyvars
946 dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
947 = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
949 (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec
951 ty_env = tyvars `zip` ty_maybes
953 spec_tyvars = foldr nothing_tyvars [] ty_env
954 spec_con_tyvars = foldr nothing_tyvars [] (con_tyvars `zip` ty_maybes) -- Hmm..
956 nothing_tyvars (tyvar, Nothing) l = tyvar : l
957 nothing_tyvars (tyvar, Just ty) l = l
959 spec_env = foldr just_env [] ty_env
960 just_env (tyvar, Nothing) l = l
961 just_env (tyvar, Just ty) l = (tyvar, ty) : l
962 spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
964 spec_theta_ty = if null theta_ty then []
965 else panic "dataConSig:ThetaTy:SpecDataCon1"
966 spec_con_theta = if null con_theta then []
967 else panic "dataConSig:ThetaTy:SpecDataCon2"
968 spec_tycon = mkSpecTyCon tycon ty_maybes
971 -- dataConRepType returns the type of the representation of a contructor
972 -- This may differ from the type of the contructor Id itself for two reasons:
973 -- a) the constructor Id may be overloaded, but the dictionary isn't stored
974 -- b) the constructor may store an unboxed version of a strict field.
975 -- Here's an example illustrating both:
976 -- data Ord a => T a = MkT Int! a
978 -- T :: Ord a => Int -> a -> T a
979 -- but the rep type is
980 -- Trep :: Int# -> a -> T a
981 -- Actually, the unboxed part isn't implemented yet!
983 dataConRepType :: GenId (GenType tv u) -> GenType tv u
985 = mkForAllTys tyvars tau
987 (tyvars, theta, tau) = splitSigmaTy (idType con)
989 dataConFieldLabels :: DataCon -> [FieldLabel]
990 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
991 dataConFieldLabels (Id _ _ _ (TupleConId _) _ _) = []
993 dataConStrictMarks :: DataCon -> [StrictnessMark]
994 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
995 dataConStrictMarks (Id _ _ _ (TupleConId arity) _ _)
996 = nOfThem arity NotMarkedStrict
998 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
999 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
1001 dataConArgTys :: DataCon
1002 -> [Type] -- Instantiated at these types
1003 -> [Type] -- Needs arguments of these types
1004 dataConArgTys con_id inst_tys
1005 = map (instantiateTy tenv) arg_tys
1007 (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
1008 tenv = zipEqual "dataConArgTys" tyvars inst_tys
1012 mkRecordSelId field_label selector_ty
1013 = addStandardIdInfo $ -- Record selectors have a standard unfolding
1014 Id (nameUnique name)
1017 (RecordSelId field_label)
1021 name = fieldLabelName field_label
1023 recordSelectorFieldLabel :: Id -> FieldLabel
1024 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1026 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
1027 isRecordSelector other = False
1031 Data type declarations are of the form:
1033 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1035 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1036 @C1 x y z@, we want a function binding:
1038 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1040 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1041 2nd-order polymorphic lambda calculus with explicit types.
1043 %************************************************************************
1045 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1047 %************************************************************************
1050 getIdUnfolding :: Id -> Unfolding
1052 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1054 addIdUnfolding :: Id -> Unfolding -> Id
1055 addIdUnfolding id@(Id u n ty details prag info) unfolding
1056 = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1059 The inline pragma tells us to be very keen to inline this Id, but it's still
1060 OK not to if optimisation is switched off.
1063 getInlinePragma :: Id -> PragmaInfo
1064 getInlinePragma (Id _ _ _ _ prag _) = prag
1066 idWantsToBeINLINEd :: Id -> Bool
1068 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1069 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1070 idWantsToBeINLINEd _ = False
1072 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1073 idMustNotBeINLINEd _ = False
1075 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1076 idMustBeINLINEd _ = False
1078 addInlinePragma :: Id -> Id
1079 addInlinePragma (Id u sn ty details _ info)
1080 = Id u sn ty details IWantToBeINLINEd info
1082 nukeNoInlinePragma :: Id -> Id
1083 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1084 = Id u sn ty details NoPragmaInfo info
1085 nukeNoInlinePragma id@(Id u sn ty details _ info) = id -- Otherwise no-op
1087 addNoInlinePragma :: Id -> Id
1088 addNoInlinePragma id@(Id u sn ty details _ info)
1089 = Id u sn ty details IMustNotBeINLINEd info
1094 %************************************************************************
1096 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1098 %************************************************************************
1101 getIdDemandInfo :: Id -> DemandInfo
1102 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1104 addIdDemandInfo :: Id -> DemandInfo -> Id
1105 addIdDemandInfo (Id u n ty details prags info) demand_info
1106 = Id u n ty details prags (info `addDemandInfo` demand_info)
1110 getIdUpdateInfo :: Id -> UpdateInfo
1111 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1113 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1114 addIdUpdateInfo (Id u n ty details prags info) upd_info
1115 = Id u n ty details prags (info `addUpdateInfo` upd_info)
1120 getIdArgUsageInfo :: Id -> ArgUsageInfo
1121 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1123 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1124 addIdArgUsageInfo (Id u n ty info details) au_info
1125 = Id u n ty (info `addArgusageInfo` au_info) details
1131 getIdFBTypeInfo :: Id -> FBTypeInfo
1132 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1134 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1135 addIdFBTypeInfo (Id u n ty info details) upd_info
1136 = Id u n ty (info `addFBTypeInfo` upd_info) details
1141 getIdSpecialisation :: Id -> SpecEnv
1142 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1144 addIdSpecialisation :: Id -> SpecEnv -> Id
1145 addIdSpecialisation (Id u n ty details prags info) spec_info
1146 = Id u n ty details prags (info `addSpecInfo` spec_info)
1149 Strictness: we snaffle the info out of the IdInfo.
1152 getIdStrictness :: Id -> StrictnessInfo
1154 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1156 addIdStrictness :: Id -> StrictnessInfo -> Id
1157 addIdStrictness (Id u n ty details prags info) strict_info
1158 = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1161 %************************************************************************
1163 \subsection[Id-comparison]{Comparison functions for @Id@s}
1165 %************************************************************************
1167 Comparison: equality and ordering---this stuff gets {\em hammered}.
1170 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = cmp u1 u2
1171 -- short and very sweet
1175 instance Ord3 (GenId ty) where
1178 instance Eq (GenId ty) where
1179 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
1180 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
1182 instance Ord (GenId ty) where
1183 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
1184 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
1185 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
1186 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
1187 _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1190 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1191 account when comparing two data constructors. We need to do this
1192 because a specialised data constructor has the same Unique as its
1193 unspecialised counterpart.
1196 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1198 cmpId_withSpecDataCon id1 id2
1199 | eq_ids && isDataCon id1 && isDataCon id2
1200 = cmpEqDataCon id1 id2
1205 cmp_ids = cmpId id1 id2
1206 eq_ids = case cmp_ids of { EQ_ -> True; other -> False }
1208 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1209 = panic# "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1211 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT_
1212 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT_
1213 cmpEqDataCon _ _ = EQ_
1216 %************************************************************************
1218 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1220 %************************************************************************
1223 instance Outputable ty => Outputable (GenId ty) where
1224 ppr sty id = pprId sty id
1226 -- and a SPECIALIZEd one:
1227 instance Outputable {-Id, i.e.:-}(GenId Type) where
1228 ppr sty id = pprId sty id
1230 showId :: PprStyle -> Id -> String
1231 showId sty id = show (pprId sty id)
1234 Default printing code (not used for interfaces):
1236 pprId :: Outputable ty => PprStyle -> GenId ty -> Doc
1238 pprId sty (Id u n _ _ prags _)
1239 = hcat [ppr sty n, pp_prags]
1241 pp_prags = ifPprDebug sty (case prags of
1242 IMustNotBeINLINEd -> text "{n}"
1243 IWantToBeINLINEd -> text "{i}"
1244 IMustBeINLINEd -> text "{I}"
1247 -- WDP 96/05/06: We can re-elaborate this as we go along...
1251 idUnique (Id u _ _ _ _ _) = u
1253 instance Uniquable (GenId ty) where
1256 instance NamedThing (GenId ty) where
1257 getName this_id@(Id u n _ details _ _) = n
1260 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1261 the @Uniques@ out of local @Ids@ given to it.
1263 %************************************************************************
1265 \subsection{@IdEnv@s and @IdSet@s}
1267 %************************************************************************
1270 type IdEnv elt = UniqFM elt
1272 nullIdEnv :: IdEnv a
1274 mkIdEnv :: [(GenId ty, a)] -> IdEnv a
1275 unitIdEnv :: GenId ty -> a -> IdEnv a
1276 addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
1277 growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
1278 growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1280 delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
1281 delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
1282 combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1283 mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
1284 modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1285 rngIdEnv :: IdEnv a -> [a]
1287 isNullIdEnv :: IdEnv a -> Bool
1288 lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
1289 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1293 addOneToIdEnv = addToUFM
1294 combineIdEnvs = plusUFM_C
1295 delManyFromIdEnv = delListFromUFM
1296 delOneFromIdEnv = delFromUFM
1298 lookupIdEnv = lookupUFM
1301 nullIdEnv = emptyUFM
1305 growIdEnvList env pairs = plusUFM env (listToUFM pairs)
1306 isNullIdEnv env = sizeUFM env == 0
1307 lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
1309 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1310 -- modify function, and put it back.
1312 modifyIdEnv mangle_fn env key
1313 = case (lookupIdEnv env key) of
1315 Just xx -> addOneToIdEnv env key (mangle_fn xx)
1317 modifyIdEnv_Directly mangle_fn env key
1318 = case (lookupUFM_Directly env key) of
1320 Just xx -> addToUFM_Directly env key (mangle_fn xx)
1324 type GenIdSet ty = UniqSet (GenId ty)
1325 type IdSet = UniqSet (GenId Type)
1327 emptyIdSet :: GenIdSet ty
1328 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1329 unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1330 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1331 idSetToList :: GenIdSet ty -> [GenId ty]
1332 unitIdSet :: GenId ty -> GenIdSet ty
1333 addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
1334 elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
1335 minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1336 isEmptyIdSet :: GenIdSet ty -> Bool
1337 mkIdSet :: [GenId ty] -> GenIdSet ty
1339 emptyIdSet = emptyUniqSet
1340 unitIdSet = unitUniqSet
1341 addOneToIdSet = addOneToUniqSet
1342 intersectIdSets = intersectUniqSets
1343 unionIdSets = unionUniqSets
1344 unionManyIdSets = unionManyUniqSets
1345 idSetToList = uniqSetToList
1346 elementOfIdSet = elementOfUniqSet
1347 minusIdSet = minusUniqSet
1348 isEmptyIdSet = isEmptyUniqSet