2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Id]{@Ids@: Value and constructor identifiers}
9 GenId(..), -- *naughtily* used in some places (e.g., TcHsSyn)
13 DataCon, DictFun, DictVar,
19 mkIdWithNewUniq, mkIdWithNewName, mkIdWithNewType,
33 -- DESTRUCTION (excluding pragmatic info)
49 recordSelectorFieldLabel,
55 cmpId_withSpecDataCon,
58 idWantsToBeINLINEd, getInlinePragma,
59 idMustBeINLINEd, idMustNotBeINLINEd,
61 isDataCon, isAlgCon, isNewCon,
63 isDefaultMethodId_maybe,
75 unfoldingUnfriendlyId,
81 -- PRINTING and RENUMBERING
90 -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
103 replaceIdInfo, replacePragmaInfo,
104 addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
107 IdEnv, GenIdSet, IdSet,
128 modifyIdEnv_Directly,
137 #include "HsVersions.h"
139 import {-# SOURCE #-} CoreUnfold ( Unfolding )
140 import {-# SOURCE #-} StdIdInfo ( addStandardIdInfo )
142 import CmdLineOpts ( opt_PprStyle_All )
143 import SpecEnv ( SpecEnv )
145 import Class ( Class )
146 import BasicTypes ( Arity )
148 import Maybes ( maybeToBool )
149 import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
150 mkCompoundName, occNameString, modAndOcc,
151 changeUnique, isWiredInName, setNameVisibility,
152 ExportFlag(..), Provenance,
153 OccName(..), Name, Module,
156 import PrimOp ( PrimOp )
157 import PrelMods ( pREL_TUP, pREL_BASE )
158 import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
159 import PragmaInfo ( PragmaInfo(..) )
160 import SrcLoc ( mkBuiltinSrcLoc )
161 import TysWiredIn ( tupleTyCon )
162 import TyCon ( TyCon, tyConDataCons, isDataTyCon, isNewTyCon, mkSpecTyCon )
163 import Type ( mkSigmaTy, mkTyVarTys, mkFunTys,
164 mkTyConApp, instantiateTy, mkForAllTys,
165 tyVarsOfType, instantiateTy, typePrimRep,
167 GenType, ThetaType, TauType, Type
169 import TyVar ( TyVar, alphaTyVars, isEmptyTyVarSet,
170 TyVarEnv, zipTyVarEnv, mkTyVarEnv
173 import UniqSet -- practically all of it
174 import Unique ( getBuiltinUniques, Unique, Uniquable(..) )
176 import SrcLoc ( SrcLoc )
177 import Util ( nOfThem, assoc )
178 import GlaExts ( Int# )
181 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
184 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
185 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
186 strictness). The essential info about different kinds of @Ids@ is
189 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
193 Unique -- Key for fast comparison
195 ty -- Id's type; used all the time;
196 IdDetails -- Stuff about individual kinds of Ids.
197 PragmaInfo -- Properties of this Id requested by programmer
198 -- eg specialise-me, inline-me
199 IdInfo -- Properties of this Id deduced by compiler
203 data StrictnessMark = MarkedStrict | NotMarkedStrict
207 ---------------- Local values
209 = LocalId Bool -- Local name; mentioned by the user
210 -- True <=> no free type vars
212 | SysLocalId Bool -- Local name; made up by the compiler
215 | PrimitiveId PrimOp -- The Id for a primitive operation
217 | SpecPragmaId -- Local name; introduced by the compiler
218 (Maybe Id) -- for explicit specid in pragma
219 Bool -- as for LocalId
221 ---------------- Global values
223 | ImportedId -- Global name (Imported or Implicit); Id imported from an interface
225 ---------------- Data constructors
227 | AlgConId -- Used for both data and newtype constructors.
228 -- You can tell the difference by looking at the TyCon
230 [StrictnessMark] -- Strict args; length = arity
231 [FieldLabel] -- Field labels for this constructor;
232 --length = 0 (not a record) or arity
234 [TyVar] ThetaType -- Type vars and context for the data type decl
235 [TyVar] ThetaType -- Ditto for the context of the constructor,
236 -- the existentially quantified stuff
237 [Type] TyCon -- Args and result tycon
239 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
240 -- unitype_1 -> ... -> unitype_n -> tycon tyvars
242 | TupleConId Int -- Its arity
244 | RecordSelId FieldLabel
246 ---------------- Things to do with overloading
248 | DictSelId -- Selector that extracts a method or superclass from a dictionary
251 | DefaultMethodId -- Default method for a particular class op
252 Class -- same class, <blah-blah> info as MethodSelId
255 | DictFunId Class -- A DictFun is uniquely identified
256 [Type] -- by its class and type; this type has free type vars,
257 -- whose identity is irrelevant. Eg Class = Eq
259 -- The "a" is irrelevant. As it is too painful to
260 -- actually do comparisons that way, we kindly supply
261 -- a Unique for that purpose.
263 | SpecId -- A specialisation of another Id
264 Id -- Id of which this is a specialisation
265 [Maybe Type] -- Types at which it is specialised;
266 -- A "Nothing" says this type ain't relevant.
267 Bool -- True <=> no free type vars; it's not enough
268 -- to know about the unspec version, because
269 -- we may specialise to a type w/ free tyvars
270 -- (i.e., in one of the "Maybe Type" dudes).
278 DictFunIds are generated from instance decls.
283 instance Foo a => Foo [a] where
286 generates the dict fun id decl
288 dfun.Foo.[*] = \d -> ...
290 The dfun id is uniquely named by the (class, type) pair. Notice, it
291 isn't a (class,tycon) pair any more, because we may get manually or
292 automatically generated specialisations of the instance decl:
294 instance Foo [Int] where
301 The type variables in the name are irrelevant; we print them as stars.
304 Constant method ids are generated from instance decls where
305 there is no context; that is, no dictionaries are needed to
306 construct the method. Example
308 instance Foo Int where
311 Then we get a constant method
316 It is possible, albeit unusual, to have a constant method
317 for an instance decl which has type vars:
319 instance Foo [a] where
323 We get the constant method
327 So a constant method is identified by a class/op/type triple.
328 The type variables in the type are irrelevant.
331 For Ids whose names must be known/deducible in other modules, we have
332 to conjure up their worker's names (and their worker's worker's
333 names... etc) in a known systematic way.
336 %************************************************************************
338 \subsection[Id-documentation]{Documentation}
340 %************************************************************************
344 The @Id@ datatype describes {\em values}. The basic things we want to
345 know: (1)~a value's {\em type} (@idType@ is a very common
346 operation in the compiler); and (2)~what ``flavour'' of value it might
347 be---for example, it can be terribly useful to know that a value is a
351 %----------------------------------------------------------------------
352 \item[@AlgConId@:] For the data constructors declared by a @data@
353 declaration. Their type is kept in {\em two} forms---as a regular
354 @Type@ (in the usual place), and also in its constituent pieces (in
355 the ``details''). We are frequently interested in those pieces.
357 %----------------------------------------------------------------------
358 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
359 the infinite family of tuples.
361 %----------------------------------------------------------------------
362 \item[@ImportedId@:] These are values defined outside this module.
363 {\em Everything} we want to know about them must be stored here (or in
366 %----------------------------------------------------------------------
367 \item[@MethodSelId@:] A selector from a dictionary; it may select either
368 a method or a dictionary for one of the class's superclasses.
370 %----------------------------------------------------------------------
373 @mkDictFunId [a,b..] theta C T@ is the function derived from the
376 instance theta => C (T a b ..) where
379 It builds function @Id@ which maps dictionaries for theta,
380 to a dictionary for C (T a b ..).
382 *Note* that with the ``Mark Jones optimisation'', the theta may
383 include dictionaries for the immediate superclasses of C at the type
386 %----------------------------------------------------------------------
389 %----------------------------------------------------------------------
390 \item[@LocalId@:] A purely-local value, e.g., a function argument,
391 something defined in a @where@ clauses, ... --- but which appears in
392 the original program text.
394 %----------------------------------------------------------------------
395 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
396 the original program text; these are introduced by the compiler in
399 %----------------------------------------------------------------------
400 \item[@SpecPragmaId@:] Introduced by the compiler to record
401 Specialisation pragmas. It is dead code which MUST NOT be removed
402 before specialisation.
407 %----------------------------------------------------------------------
410 @DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
411 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
415 They have no free type variables, so if you are making a
416 type-variable substitution you don't need to look inside them.
418 They are constants, so they are not free variables. (When the STG
419 machine makes a closure, it puts all the free variables in the
420 closure; the above are not required.)
422 Note that @Locals@ and @SysLocals@ {\em may} have the above
423 properties, but they may not.
426 %************************************************************************
428 \subsection[Id-general-funs]{General @Id@-related functions}
430 %************************************************************************
433 -- isDataCon returns False for @newtype@ constructors
434 isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
435 isDataCon (Id _ _ _ (TupleConId _) _ _) = True
436 isDataCon (Id _ _ _ (SpecId unspec _ _) _ _) = isDataCon unspec
437 isDataCon other = False
439 isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
440 isNewCon other = False
442 -- isAlgCon returns True for @data@ or @newtype@ constructors
443 isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
444 isAlgCon (Id _ _ _ (TupleConId _) _ _) = True
445 isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _) = isAlgCon unspec
446 isAlgCon other = False
448 isTupleCon (Id _ _ _ (TupleConId _) _ _) = True
449 isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _) = isTupleCon unspec
450 isTupleCon other = False
453 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
454 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
455 defined at top level (returns @True@). This is used to decide whether
456 the @Id@ is a candidate free variable. NB: you are only {\em sure}
457 about something if it returns @True@!
460 toplevelishId :: Id -> Bool
461 idHasNoFreeTyVars :: Id -> Bool
463 toplevelishId (Id _ _ _ details _ _)
466 chk (AlgConId _ __ _ _ _ _ _ _) = True
467 chk (TupleConId _) = True
468 chk (RecordSelId _) = True
469 chk ImportedId = True
470 chk (DictSelId _) = True
471 chk (DefaultMethodId _) = True
472 chk (DictFunId _ _) = True
473 chk (SpecId unspec _ _) = toplevelishId unspec
474 -- depends what the unspecialised thing is
475 chk (LocalId _) = False
476 chk (SysLocalId _) = False
477 chk (SpecPragmaId _ _) = False
478 chk (PrimitiveId _) = True
480 idHasNoFreeTyVars (Id _ _ _ details _ info)
483 chk (AlgConId _ _ _ _ _ _ _ _ _) = True
484 chk (TupleConId _) = True
485 chk (RecordSelId _) = True
486 chk ImportedId = True
487 chk (DictSelId _) = True
488 chk (DefaultMethodId _) = True
489 chk (DictFunId _ _) = True
490 chk (SpecId _ _ no_free_tvs) = no_free_tvs
491 chk (LocalId no_free_tvs) = no_free_tvs
492 chk (SysLocalId no_free_tvs) = no_free_tvs
493 chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
494 chk (PrimitiveId _) = True
496 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
497 -- so we don't need to put its signature in an interface file, even if it's mentioned
498 -- in some other interface unfolding.
504 omitIfaceSigForId (Id _ name _ details _ _)
510 ImportedId -> True -- Never put imports in interface file
511 (PrimitiveId _) -> True -- Ditto, for primitives
513 -- This group is Ids that are implied by their type or class decl;
514 -- remember that all type and class decls appear in the interface file.
515 -- The dfun id must *not* be omitted, because it carries version info for
517 (AlgConId _ _ _ _ _ _ _ _ _) -> True
518 (TupleConId _) -> True
519 (RecordSelId _) -> True
520 (DictSelId _) -> True
522 other -> False -- Don't omit!
523 -- NB DefaultMethodIds are not omitted
527 isImportedId (Id _ _ _ ImportedId _ _) = True
528 isImportedId other = False
530 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
532 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
533 isSysLocalId other = False
535 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
536 isSpecPragmaId other = False
538 isSpecId_maybe (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
539 = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
540 Just (unspec, ty_maybes)
541 isSpecId_maybe other_id
544 isDictSelId_maybe (Id _ _ _ (DictSelId cls) _ _) = Just cls
545 isDictSelId_maybe _ = Nothing
547 isDefaultMethodId (Id _ _ _ (DefaultMethodId _) _ _) = True
548 isDefaultMethodId other = False
550 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls) _ _)
552 isDefaultMethodId_maybe other = Nothing
554 isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
555 isDictFunId other = False
557 isWrapperId id = workerExists (getIdStrictness id)
559 isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
560 isPrimitiveId_maybe other = Nothing
564 unfoldingUnfriendlyId -- return True iff it is definitely a bad
565 :: Id -- idea to export an unfolding that
566 -> Bool -- mentions this Id. Reason: it cannot
567 -- possibly be seen in another module.
569 unfoldingUnfriendlyId id = not (externallyVisibleId id)
572 @externallyVisibleId@: is it true that another module might be
573 able to ``see'' this Id in a code generation sense. That
574 is, another .o file might refer to this Id.
576 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
577 local-ness precisely so that the test here would be easy
580 externallyVisibleId :: Id -> Bool
581 externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
582 -- not local => global => externally visible
585 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
586 `Top-levelish Ids'' cannot have any free type variables, so applying
587 the type-env cannot have any effect. (NB: checked in CoreLint?)
590 type TypeEnv = TyVarEnv Type
592 applyTypeEnvToId :: TypeEnv -> Id -> Id
593 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
594 = apply_to_Id ( \ ty ->
595 instantiateTy type_env ty
600 apply_to_Id :: (Type -> Type) -> Id -> Id
602 apply_to_Id ty_fn id@(Id u n ty details prag info)
603 | idHasNoFreeTyVars id
606 = Id u n (ty_fn ty) (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
608 apply_to_details (SpecId unspec ty_maybes no_ftvs)
610 new_unspec = apply_to_Id ty_fn unspec
611 new_maybes = map apply_to_maybe ty_maybes
613 SpecId new_unspec new_maybes (no_free_tvs ty)
614 -- ToDo: gratuitous recalc no_ftvs????
616 apply_to_maybe Nothing = Nothing
617 apply_to_maybe (Just ty) = Just (ty_fn ty)
619 apply_to_details other = other
623 %************************************************************************
625 \subsection[Id-type-funs]{Type-related @Id@ functions}
627 %************************************************************************
630 idName :: GenId ty -> Name
631 idName (Id _ n _ _ _ _) = n
633 idType :: GenId ty -> ty
634 idType (Id _ _ ty _ _ _) = ty
636 idPrimRep i = typePrimRep (idType i)
639 %************************************************************************
641 \subsection[Id-overloading]{Functions related to overloading}
643 %************************************************************************
646 mkSuperDictSelId :: Unique -> Class -> Int -> Type -> Id
647 -- The Int is an arbitrary tag to say which superclass is selected
649 -- class (C a, C b) => Foo a b where ...
650 -- we get superclass selectors
653 mkSuperDictSelId u clas index ty
654 = addStandardIdInfo $
655 Id u name ty details NoPragmaInfo noIdInfo
657 name = mkCompoundName name_fn u (getName clas)
658 details = DictSelId clas
659 name_fn clas_str = clas_str _APPEND_ SLIT("_sc") _APPEND_ (_PK_ (show index))
661 -- For method selectors the clean thing to do is
662 -- to give the method selector the same name as the class op itself.
663 mkMethodSelId op_name clas ty
664 = addStandardIdInfo $
665 Id (uniqueOf op_name) op_name ty (DictSelId clas) NoPragmaInfo noIdInfo
667 mkDefaultMethodId dm_name rec_c ty
668 = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c) NoPragmaInfo noIdInfo
670 mkDictFunId dfun_name full_ty clas itys
671 = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
673 details = DictFunId clas itys
675 mkWorkerId u unwrkr ty info
676 = Id u name ty details NoPragmaInfo info
678 details = LocalId (no_free_tvs ty)
679 name = mkCompoundName name_fn u (getName unwrkr)
680 name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
683 %************************************************************************
685 \subsection[local-funs]{@LocalId@-related functions}
687 %************************************************************************
690 mkImported n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
692 mkPrimitiveId n ty primop
693 = addStandardIdInfo $
694 Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
695 -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
696 -- It's only true for primitives, because we don't want to make a closure for each of them.
701 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
703 -- SysLocal: for an Id being created by the compiler out of thin air...
704 -- UserLocal: an Id with a name the user might recognize...
705 mkSysLocal :: FAST_STRING -> Unique -> GenType flexi -> SrcLoc -> GenId (GenType flexi)
706 mkUserLocal :: OccName -> Unique -> GenType flexi -> SrcLoc -> GenId (GenType flexi)
708 mkSysLocal str uniq ty loc
709 = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
711 mkUserLocal occ uniq ty loc
712 = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
714 mkUserId :: Name -> GenType flexi -> PragmaInfo -> GenId (GenType flexi)
715 mkUserId name ty pragma_info
716 = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
720 -- See notes with setNameVisibility (Name.lhs)
721 setIdVisibility :: Maybe Module -> Unique -> Id -> Id
722 setIdVisibility maybe_mod u (Id uniq name ty details prag info)
723 = Id uniq (setNameVisibility maybe_mod u name) ty details prag info
725 mkIdWithNewUniq :: Id -> Unique -> Id
726 mkIdWithNewUniq (Id _ n ty details prag info) u
727 = Id u (changeUnique n u) ty details prag info
729 mkIdWithNewName :: Id -> Name -> Id
730 mkIdWithNewName (Id _ _ ty details prag info) new_name
731 = Id (uniqueOf new_name) new_name ty details prag info
733 mkIdWithNewType :: Id -> Type -> Id
734 mkIdWithNewType (Id u name _ details pragma info) ty
735 = Id u name ty details pragma info
738 -- Specialised version of constructor: only used in STG and code generation
739 -- Note: The specialsied Id has the same unique as the unspeced Id
741 mkSameSpecCon ty_maybes unspec@(Id u name ty details pragma info)
742 = ASSERT(isDataCon unspec)
743 ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
744 Id u name new_ty (SpecId unspec ty_maybes (no_free_tvs new_ty)) pragma info
746 new_ty = specialiseTy ty ty_maybes 0
748 -- pprTrace "SameSpecCon:Unique:"
749 -- (ppSep (ppr unspec: [pprMaybeTy ty | ty <- ty_maybes]))
753 Make some local @Ids@ for a template @CoreExpr@. These have bogus
754 @Uniques@, but that's OK because the templates are supposed to be
755 instantiated before use.
757 mkTemplateLocals :: [Type] -> [Id]
759 = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
760 (getBuiltinUniques (length tys))
765 getIdInfo :: GenId ty -> IdInfo
766 getPragmaInfo :: GenId ty -> PragmaInfo
768 getIdInfo (Id _ _ _ _ _ info) = info
769 getPragmaInfo (Id _ _ _ _ info _) = info
771 replaceIdInfo :: Id -> IdInfo -> Id
772 replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
774 replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
775 replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
778 %************************************************************************
780 \subsection[Id-arities]{Arity-related functions}
782 %************************************************************************
784 For locally-defined Ids, the code generator maintains its own notion
785 of their arities; so it should not be asking... (but other things
786 besides the code-generator need arity info!)
789 getIdArity :: Id -> ArityInfo
790 getIdArity id@(Id _ _ _ _ _ id_info)
793 addIdArity :: Id -> ArityInfo -> Id
794 addIdArity (Id u n ty details pinfo info) arity
795 = Id u n ty details pinfo (info `addArityInfo` arity)
798 %************************************************************************
800 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
802 %************************************************************************
806 -> [StrictnessMark] -> [FieldLabel]
807 -> [TyVar] -> ThetaType
808 -> [TyVar] -> ThetaType
809 -> [TauType] -> TyCon
811 -- can get the tag and all the pieces of the type from the Type
813 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
814 = ASSERT(length stricts == length args_tys)
815 addStandardIdInfo data_con
817 -- NB: data_con self-recursion; should be OK as tags are not
818 -- looked at until late in the game.
823 (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
824 IWantToBeINLINEd -- Always inline constructors if possible
827 data_con_tag = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
828 data_con_family = tyConDataCons tycon
831 = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
832 (mkFunTys args_tys (mkTyConApp tycon (mkTyVarTys tvs)))
835 mkTupleCon :: Arity -> Name -> Type -> Id
836 mkTupleCon arity name ty
837 = addStandardIdInfo tuple_id
839 tuple_id = Id (nameUnique name) name ty
841 IWantToBeINLINEd -- Always inline constructors if possible
845 fIRST_TAG = 1 -- Tags allocated from here for real constructors
848 dataConNumFields gives the number of actual fields in the
849 {\em representation} of the data constructor. This may be more than appear
850 in the source code; the extra ones are the existentially quantified
855 = ASSERT( if (isDataCon id) then True else
856 pprTrace "dataConNumFields" (ppr id) False )
857 case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
858 length con_theta + length arg_tys }
860 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
866 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
867 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
868 dataConTag (Id _ _ _ (TupleConId _) _ _) = fIRST_TAG
869 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _) = dataConTag unspec
871 dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
872 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
873 dataConTyCon (Id _ _ _ (TupleConId a) _ _) = tupleTyCon a
875 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
876 -- will panic if not a DataCon
878 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
879 = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
881 dataConSig (Id _ _ _ (TupleConId arity) _ _)
882 = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
884 tyvars = take arity alphaTyVars
885 tyvar_tys = mkTyVarTys tyvars
887 dataConSig (Id _ _ _ (SpecId unspec ty_maybes _) _ _)
888 = (spec_tyvars, spec_theta_ty, spec_con_tyvars, spec_con_theta, spec_arg_tys, spec_tycon)
890 (tyvars, theta_ty, con_tyvars, con_theta, arg_tys, tycon) = dataConSig unspec
892 ty_env = tyvars `zip` ty_maybes
894 spec_tyvars = [tyvar | (tyvar, Nothing) <- ty_env]
895 spec_con_tyvars = [tyvar | (tyvar, Nothing) <- con_tyvars `zip` ty_maybes] -- Hmm..
897 spec_env = mkTyVarEnv [(tyvar, ty) | (tyvar, Just ty) <- ty_env]
898 spec_arg_tys = map (instantiateTauTy spec_env) arg_tys
900 spec_theta_ty = if null theta_ty then []
901 else panic "dataConSig:ThetaTy:SpecDataCon1"
902 spec_con_theta = if null con_theta then []
903 else panic "dataConSig:ThetaTy:SpecDataCon2"
904 spec_tycon = mkSpecTyCon tycon ty_maybes
907 -- dataConRepType returns the type of the representation of a contructor
908 -- This may differ from the type of the contructor Id itself for two reasons:
909 -- a) the constructor Id may be overloaded, but the dictionary isn't stored
910 -- e.g. data Eq a => T a = MkT a a
912 -- b) the constructor may store an unboxed version of a strict field.
914 -- Here's an example illustrating both:
915 -- data Ord a => T a = MkT Int! a
917 -- T :: Ord a => Int -> a -> T a
918 -- but the rep type is
919 -- Trep :: Int# -> a -> T a
920 -- Actually, the unboxed part isn't implemented yet!
922 dataConRepType :: Id -> Type
923 dataConRepType (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
924 = mkForAllTys (tyvars++con_tyvars)
925 (mkFunTys arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)))
926 dataConRepType other_id
927 = ASSERT( isDataCon other_id )
930 dataConFieldLabels :: DataCon -> [FieldLabel]
931 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
932 dataConFieldLabels (Id _ _ _ (TupleConId _) _ _) = []
934 dataConFieldLabels x@(Id _ _ _ idt _ _) =
935 panic ("dataConFieldLabel: " ++
940 SpecPragmaId _ _ -> "sp"
944 DefaultMethodId _ -> "d"
945 DictFunId _ _ -> "di"
946 SpecId _ _ _ -> "spec"))
949 dataConStrictMarks :: DataCon -> [StrictnessMark]
950 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
951 dataConStrictMarks (Id _ _ _ (TupleConId arity) _ _)
952 = nOfThem arity NotMarkedStrict
954 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
955 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
957 dataConArgTys :: DataCon
958 -> [Type] -- Instantiated at these types
959 -> [Type] -- Needs arguments of these types
960 dataConArgTys con_id inst_tys
961 = map (instantiateTy tenv) arg_tys
963 (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
964 tenv = zipTyVarEnv tyvars inst_tys
968 mkRecordSelId field_label selector_ty
969 = addStandardIdInfo $ -- Record selectors have a standard unfolding
973 (RecordSelId field_label)
977 name = fieldLabelName field_label
979 recordSelectorFieldLabel :: Id -> FieldLabel
980 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
982 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
983 isRecordSelector other = False
987 Data type declarations are of the form:
989 data Foo a b = C1 ... | C2 ... | ... | Cn ...
991 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
992 @C1 x y z@, we want a function binding:
994 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
996 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
997 2nd-order polymorphic lambda calculus with explicit types.
999 %************************************************************************
1001 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1003 %************************************************************************
1006 getIdUnfolding :: Id -> Unfolding
1008 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1010 addIdUnfolding :: Id -> Unfolding -> Id
1011 addIdUnfolding id@(Id u n ty details prag info) unfolding
1012 = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1015 The inline pragma tells us to be very keen to inline this Id, but it's still
1016 OK not to if optimisation is switched off.
1019 getInlinePragma :: Id -> PragmaInfo
1020 getInlinePragma (Id _ _ _ _ prag _) = prag
1022 idWantsToBeINLINEd :: Id -> Bool
1024 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1025 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1026 idWantsToBeINLINEd _ = False
1028 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1029 idMustNotBeINLINEd _ = False
1031 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1032 idMustBeINLINEd _ = False
1034 addInlinePragma :: Id -> Id
1035 addInlinePragma (Id u sn ty details _ info)
1036 = Id u sn ty details IWantToBeINLINEd info
1038 nukeNoInlinePragma :: Id -> Id
1039 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1040 = Id u sn ty details NoPragmaInfo info
1041 nukeNoInlinePragma id@(Id u sn ty details _ info) = id -- Otherwise no-op
1043 addNoInlinePragma :: Id -> Id
1044 addNoInlinePragma id@(Id u sn ty details _ info)
1045 = Id u sn ty details IMustNotBeINLINEd info
1050 %************************************************************************
1052 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1054 %************************************************************************
1057 getIdDemandInfo :: Id -> DemandInfo
1058 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1060 addIdDemandInfo :: Id -> DemandInfo -> Id
1061 addIdDemandInfo (Id u n ty details prags info) demand_info
1062 = Id u n ty details prags (info `addDemandInfo` demand_info)
1066 getIdUpdateInfo :: Id -> UpdateInfo
1067 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1069 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1070 addIdUpdateInfo (Id u n ty details prags info) upd_info
1071 = Id u n ty details prags (info `addUpdateInfo` upd_info)
1076 getIdArgUsageInfo :: Id -> ArgUsageInfo
1077 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1079 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1080 addIdArgUsageInfo (Id u n ty info details) au_info
1081 = Id u n ty (info `addArgusageInfo` au_info) details
1087 getIdFBTypeInfo :: Id -> FBTypeInfo
1088 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1090 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1091 addIdFBTypeInfo (Id u n ty info details) upd_info
1092 = Id u n ty (info `addFBTypeInfo` upd_info) details
1097 getIdSpecialisation :: Id -> IdSpecEnv
1098 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1100 addIdSpecialisation :: Id -> IdSpecEnv -> Id
1101 addIdSpecialisation (Id u n ty details prags info) spec_info
1102 = Id u n ty details prags (info `addSpecInfo` spec_info)
1105 Strictness: we snaffle the info out of the IdInfo.
1108 getIdStrictness :: Id -> StrictnessInfo
1110 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1112 addIdStrictness :: Id -> StrictnessInfo -> Id
1113 addIdStrictness (Id u n ty details prags info) strict_info
1114 = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1117 %************************************************************************
1119 \subsection[Id-comparison]{Comparison functions for @Id@s}
1121 %************************************************************************
1123 Comparison: equality and ordering---this stuff gets {\em hammered}.
1126 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = compare u1 u2
1127 -- short and very sweet
1131 instance Eq (GenId ty) where
1132 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
1133 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
1135 instance Ord (GenId ty) where
1136 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
1137 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
1138 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
1139 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
1140 compare a b = cmpId a b
1143 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1144 account when comparing two data constructors. We need to do this
1145 because a specialised data constructor has the same Unique as its
1146 unspecialised counterpart.
1149 cmpId_withSpecDataCon :: Id -> Id -> Ordering
1151 cmpId_withSpecDataCon id1 id2
1152 | eq_ids && isDataCon id1 && isDataCon id2
1153 = cmpEqDataCon id1 id2
1158 cmp_ids = cmpId id1 id2
1159 eq_ids = case cmp_ids of { EQ -> True; other -> False }
1161 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1162 = panic "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1164 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT
1165 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT
1166 cmpEqDataCon _ _ = EQ
1169 %************************************************************************
1171 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1173 %************************************************************************
1176 instance Outputable ty => Outputable (GenId ty) where
1179 showId :: Id -> String
1180 showId id = showSDoc (pprId id)
1183 Default printing code (not used for interfaces):
1185 pprId :: Outputable ty => GenId ty -> SDoc
1187 pprId (Id u n _ _ prags _)
1188 = hcat [ppr n, pp_prags]
1190 pp_prags | opt_PprStyle_All = case prags of
1191 IMustNotBeINLINEd -> text "{n}"
1192 IWantToBeINLINEd -> text "{i}"
1193 IMustBeINLINEd -> text "{I}"
1197 -- WDP 96/05/06: We can re-elaborate this as we go along...
1201 idUnique (Id u _ _ _ _ _) = u
1203 instance Uniquable (GenId ty) where
1206 instance NamedThing (GenId ty) where
1207 getName this_id@(Id u n _ details _ _) = n
1210 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1211 the @Uniques@ out of local @Ids@ given to it.
1213 %************************************************************************
1215 \subsection{@IdEnv@s and @IdSet@s}
1217 %************************************************************************
1220 type IdEnv elt = UniqFM elt
1222 nullIdEnv :: IdEnv a
1224 mkIdEnv :: [(GenId ty, a)] -> IdEnv a
1225 unitIdEnv :: GenId ty -> a -> IdEnv a
1226 addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
1227 growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
1228 growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1230 delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
1231 delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
1232 combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1233 mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
1234 modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1235 rngIdEnv :: IdEnv a -> [a]
1237 isNullIdEnv :: IdEnv a -> Bool
1238 lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
1239 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1243 addOneToIdEnv = addToUFM
1244 combineIdEnvs = plusUFM_C
1245 delManyFromIdEnv = delListFromUFM
1246 delOneFromIdEnv = delFromUFM
1248 lookupIdEnv = lookupUFM
1251 nullIdEnv = emptyUFM
1255 growIdEnvList env pairs = plusUFM env (listToUFM pairs)
1256 isNullIdEnv env = sizeUFM env == 0
1257 lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
1259 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1260 -- modify function, and put it back.
1262 modifyIdEnv mangle_fn env key
1263 = case (lookupIdEnv env key) of
1265 Just xx -> addOneToIdEnv env key (mangle_fn xx)
1267 modifyIdEnv_Directly mangle_fn env key
1268 = case (lookupUFM_Directly env key) of
1270 Just xx -> addToUFM_Directly env key (mangle_fn xx)
1274 type GenIdSet ty = UniqSet (GenId ty)
1275 type IdSet = UniqSet (GenId Type)
1277 emptyIdSet :: GenIdSet ty
1278 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1279 unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1280 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1281 idSetToList :: GenIdSet ty -> [GenId ty]
1282 unitIdSet :: GenId ty -> GenIdSet ty
1283 addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
1284 elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
1285 minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1286 isEmptyIdSet :: GenIdSet ty -> Bool
1287 mkIdSet :: [GenId ty] -> GenIdSet ty
1289 emptyIdSet = emptyUniqSet
1290 unitIdSet = unitUniqSet
1291 addOneToIdSet = addOneToUniqSet
1292 intersectIdSets = intersectUniqSets
1293 unionIdSets = unionUniqSets
1294 unionManyIdSets = unionManyUniqSets
1295 idSetToList = uniqSetToList
1296 elementOfIdSet = elementOfUniqSet
1297 minusIdSet = minusUniqSet
1298 isEmptyIdSet = isEmptyUniqSet