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),
22 mkIdWithNewUniq, mkIdWithNewName,
37 -- DESTRUCTION (excluding pragmatic info)
52 recordSelectorFieldLabel,
58 cmpId_withSpecDataCon,
61 idWantsToBeINLINEd, getInlinePragma,
62 idMustBeINLINEd, idMustNotBeINLINEd,
65 isConstMethodId_maybe,
66 isDataCon, isAlgCon, isNewCon,
68 isDefaultMethodId_maybe,
75 isSuperDictSelId_maybe,
82 unfoldingUnfriendlyId,
88 -- PRINTING and RENUMBERING
99 -- UNFOLDING, ARITY, UPDATE, AND STRICTNESS STUFF (etc)
113 replaceIdInfo, replacePragmaInfo,
114 addInlinePragma, nukeNoInlinePragma, addNoInlinePragma,
117 SYN_IE(IdEnv), SYN_IE(GenIdSet), SYN_IE(IdSet),
138 modifyIdEnv_Directly,
149 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
150 IMPORT_DELOOPER(IdLoop) -- for paranoia checking
151 IMPORT_DELOOPER(TyLoop) -- for paranoia checking
153 import {-# SOURCE #-} SpecEnv ( SpecEnv )
154 import {-# SOURCE #-} CoreUnfold ( Unfolding )
155 import {-# SOURCE #-} StdIdInfo ( addStandardIdInfo )
156 -- Let's see how much we can leave out..
157 --import {-# SOURCE #-} TyCon
158 --import {-# SOURCE #-} Type
159 --import {-# SOURCE #-} Class
160 --import {-# SOURCE #-} TysWiredIn
161 --import {-# SOURCE #-} TysPrim
162 --import {-# SOURCE #-} TyVar
166 import Class ( classOpString, SYN_IE(Class), GenClass, SYN_IE(ClassOp), GenClassOp )
168 import Maybes ( maybeToBool )
169 import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
170 mkCompoundName, mkInstDeclName,
171 isLocallyDefinedName, occNameString, modAndOcc,
172 isLocallyDefined, changeUnique, isWiredInName,
173 nameString, getOccString, setNameVisibility,
174 isExported, ExportFlag(..), DefnInfo, Provenance,
175 OccName(..), Name, SYN_IE(Module),
178 import PrelMods ( pREL_TUP, pREL_BASE )
179 import Lex ( mkTupNameStr )
180 import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
181 import PragmaInfo ( PragmaInfo(..) )
182 #if __GLASGOW_HASKELL__ >= 202
183 import PrimOp ( PrimOp )
185 import PprEnv -- ( SYN_IE(NmbrM), NmbrEnv(..) )
186 import PprType ( getTypeString, specMaybeTysSuffix,
191 import MatchEnv ( MatchEnv )
192 import SrcLoc --( mkBuiltinSrcLoc )
193 import TysWiredIn ( tupleTyCon )
194 import TyCon --( TyCon, tyConDataCons )
195 import Type {- ( mkSigmaTy, mkTyVarTys, mkFunTys, mkDictTy,
196 applyTyCon, instantiateTy, mkForAllTys,
197 tyVarsOfType, applyTypeEnvToTy, typePrimRep,
198 GenType, SYN_IE(ThetaType), SYN_IE(TauType), SYN_IE(Type)
200 import TyVar --( alphaTyVars, isEmptyTyVarSet, SYN_IE(TyVarEnv) )
201 import Usage ( SYN_IE(UVar) )
203 import UniqSet -- practically all of it
204 import Unique ( getBuiltinUniques, pprUnique, showUnique,
206 Unique{-instance Ord3-},
209 import Outputable ( ifPprDebug, Outputable(..), PprStyle(..) )
210 import Util {- ( mapAccumL, nOfThem, zipEqual, assoc,
211 panic, panic#, pprPanic, assertPanic
215 Here are the @Id@ and @IdDetails@ datatypes; also see the notes that
218 Every @Id@ has a @Unique@, to uniquify it and for fast comparison, a
219 @Type@, and an @IdInfo@ (non-essential info about it, e.g.,
220 strictness). The essential info about different kinds of @Ids@ is
223 ToDo: possibly cache other stuff in the single-constructor @Id@ type.
227 Unique -- Key for fast comparison
229 ty -- Id's type; used all the time;
230 IdDetails -- Stuff about individual kinds of Ids.
231 PragmaInfo -- Properties of this Id requested by programmer
232 -- eg specialise-me, inline-me
233 IdInfo -- Properties of this Id deduced by compiler
237 data StrictnessMark = MarkedStrict | NotMarkedStrict
241 ---------------- Local values
243 = LocalId Bool -- Local name; mentioned by the user
244 -- True <=> no free type vars
246 | SysLocalId Bool -- Local name; made up by the compiler
249 | PrimitiveId PrimOp -- The Id for a primitive operation
251 | SpecPragmaId -- Local name; introduced by the compiler
252 (Maybe Id) -- for explicit specid in pragma
253 Bool -- as for LocalId
255 ---------------- Global values
257 | ImportedId -- Global name (Imported or Implicit); Id imported from an interface
259 ---------------- Data constructors
261 | AlgConId -- Used for both data and newtype constructors.
262 -- You can tell the difference by looking at the TyCon
264 [StrictnessMark] -- Strict args; length = arity
265 [FieldLabel] -- Field labels for this constructor;
266 --length = 0 (not a record) or arity
268 [TyVar] [(Class,Type)] -- Type vars and context for the data type decl
269 [TyVar] [(Class,Type)] -- Ditto for the context of the constructor,
270 -- the existentially quantified stuff
271 [Type] TyCon -- Args and result tycon
273 -- forall tyvars1 ++ tyvars2. theta1 ++ theta2 =>
274 -- unitype_1 -> ... -> unitype_n -> tycon tyvars
276 | TupleConId Int -- Its arity
278 | RecordSelId FieldLabel
280 ---------------- Things to do with overloading
282 | SuperDictSelId -- Selector for superclass dictionary
283 Class -- The class (input dict)
284 Class -- The superclass (result dict)
286 | MethodSelId Class -- An overloaded class operation, with
287 -- a fully polymorphic type. Its code
288 -- just selects a method from the
289 -- dictionary. The class.
290 ClassOp -- The operation
292 -- NB: The IdInfo for a MethodSelId has all the info about its
293 -- related "constant method Ids", which are just
294 -- specialisations of this general one.
296 | DefaultMethodId -- Default method for a particular class op
297 Class -- same class, <blah-blah> info as MethodSelId
298 ClassOp -- (surprise, surprise)
299 Bool -- True <=> I *know* this default method Id
300 -- is a generated one that just says
301 -- `error "No default method for <op>"'.
304 | DictFunId Class -- A DictFun is uniquely identified
305 Type -- by its class and type; this type has free type vars,
306 -- whose identity is irrelevant. Eg Class = Eq
308 -- The "a" is irrelevant. As it is too painful to
309 -- actually do comparisons that way, we kindly supply
310 -- a Unique for that purpose.
313 | ConstMethodId -- A method which depends only on the type of the
314 -- instance, and not on any further dictionaries etc.
315 Class -- Uniquely identified by:
316 Type -- (class, type, classop) triple
318 Module -- module where instance came from
320 | InstId -- An instance of a dictionary, class operation,
321 -- or overloaded value (Local name)
322 Bool -- as for LocalId
324 | SpecId -- A specialisation of another Id
325 Id -- Id of which this is a specialisation
326 [Maybe Type] -- Types at which it is specialised;
327 -- A "Nothing" says this type ain't relevant.
328 Bool -- True <=> no free type vars; it's not enough
329 -- to know about the unspec version, because
330 -- we may specialise to a type w/ free tyvars
331 -- (i.e., in one of the "Maybe Type" dudes).
333 -- Scheduled for deletion: SLPJ Nov 96
334 -- Nobody seems to depend on knowing this.
335 | WorkerId -- A "worker" for some other Id
336 Id -- Id for which this is a worker
344 DictFunIds are generated from instance decls.
349 instance Foo a => Foo [a] where
352 generates the dict fun id decl
354 dfun.Foo.[*] = \d -> ...
356 The dfun id is uniquely named by the (class, type) pair. Notice, it
357 isn't a (class,tycon) pair any more, because we may get manually or
358 automatically generated specialisations of the instance decl:
360 instance Foo [Int] where
367 The type variables in the name are irrelevant; we print them as stars.
370 Constant method ids are generated from instance decls where
371 there is no context; that is, no dictionaries are needed to
372 construct the method. Example
374 instance Foo Int where
377 Then we get a constant method
382 It is possible, albeit unusual, to have a constant method
383 for an instance decl which has type vars:
385 instance Foo [a] where
389 We get the constant method
393 So a constant method is identified by a class/op/type triple.
394 The type variables in the type are irrelevant.
397 For Ids whose names must be known/deducible in other modules, we have
398 to conjure up their worker's names (and their worker's worker's
399 names... etc) in a known systematic way.
402 %************************************************************************
404 \subsection[Id-documentation]{Documentation}
406 %************************************************************************
410 The @Id@ datatype describes {\em values}. The basic things we want to
411 know: (1)~a value's {\em type} (@idType@ is a very common
412 operation in the compiler); and (2)~what ``flavour'' of value it might
413 be---for example, it can be terribly useful to know that a value is a
417 %----------------------------------------------------------------------
418 \item[@AlgConId@:] For the data constructors declared by a @data@
419 declaration. Their type is kept in {\em two} forms---as a regular
420 @Type@ (in the usual place), and also in its constituent pieces (in
421 the ``details''). We are frequently interested in those pieces.
423 %----------------------------------------------------------------------
424 \item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
425 the infinite family of tuples.
427 %----------------------------------------------------------------------
428 \item[@ImportedId@:] These are values defined outside this module.
429 {\em Everything} we want to know about them must be stored here (or in
432 %----------------------------------------------------------------------
433 \item[@MethodSelId@:] A selector from a dictionary; it may select either
434 a method or a dictionary for one of the class's superclasses.
436 %----------------------------------------------------------------------
439 @mkDictFunId [a,b..] theta C T@ is the function derived from the
442 instance theta => C (T a b ..) where
445 It builds function @Id@ which maps dictionaries for theta,
446 to a dictionary for C (T a b ..).
448 *Note* that with the ``Mark Jones optimisation'', the theta may
449 include dictionaries for the immediate superclasses of C at the type
452 %----------------------------------------------------------------------
455 %----------------------------------------------------------------------
458 %----------------------------------------------------------------------
461 %----------------------------------------------------------------------
462 \item[@LocalId@:] A purely-local value, e.g., a function argument,
463 something defined in a @where@ clauses, ... --- but which appears in
464 the original program text.
466 %----------------------------------------------------------------------
467 \item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
468 the original program text; these are introduced by the compiler in
471 %----------------------------------------------------------------------
472 \item[@SpecPragmaId@:] Introduced by the compiler to record
473 Specialisation pragmas. It is dead code which MUST NOT be removed
474 before specialisation.
479 %----------------------------------------------------------------------
482 @DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
483 @MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
487 They have no free type variables, so if you are making a
488 type-variable substitution you don't need to look inside them.
490 They are constants, so they are not free variables. (When the STG
491 machine makes a closure, it puts all the free variables in the
492 closure; the above are not required.)
494 Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
495 properties, but they may not.
498 %************************************************************************
500 \subsection[Id-general-funs]{General @Id@-related functions}
502 %************************************************************************
505 -- isDataCon returns False for @newtype@ constructors
506 isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
507 isDataCon (Id _ _ _ (TupleConId _) _ _) = True
508 isDataCon (Id _ _ _ (SpecId unspec _ _) _ _) = isDataCon unspec
509 isDataCon other = False
511 isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
512 isNewCon other = False
514 -- isAlgCon returns True for @data@ or @newtype@ constructors
515 isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
516 isAlgCon (Id _ _ _ (TupleConId _) _ _) = True
517 isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _) = isAlgCon unspec
518 isAlgCon other = False
520 isTupleCon (Id _ _ _ (TupleConId _) _ _) = True
521 isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _) = isTupleCon unspec
522 isTupleCon other = False
525 @toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
526 @let(rec)@ (returns @False@), or whether it is {\em sure} to be
527 defined at top level (returns @True@). This is used to decide whether
528 the @Id@ is a candidate free variable. NB: you are only {\em sure}
529 about something if it returns @True@!
532 toplevelishId :: Id -> Bool
533 idHasNoFreeTyVars :: Id -> Bool
535 toplevelishId (Id _ _ _ details _ _)
538 chk (AlgConId _ __ _ _ _ _ _ _) = True
539 chk (TupleConId _) = True
540 chk (RecordSelId _) = True
541 chk ImportedId = True
542 chk (SuperDictSelId _ _) = True
543 chk (MethodSelId _ _) = True
544 chk (DefaultMethodId _ _ _) = True
545 chk (DictFunId _ _) = True
546 chk (ConstMethodId _ _ _ _) = True
547 chk (SpecId unspec _ _) = toplevelishId unspec
548 -- depends what the unspecialised thing is
549 chk (WorkerId unwrkr) = toplevelishId unwrkr
550 chk (InstId _) = False -- these are local
551 chk (LocalId _) = False
552 chk (SysLocalId _) = False
553 chk (SpecPragmaId _ _) = False
554 chk (PrimitiveId _) = True
556 idHasNoFreeTyVars (Id _ _ _ details _ info)
559 chk (AlgConId _ _ _ _ _ _ _ _ _) = True
560 chk (TupleConId _) = True
561 chk (RecordSelId _) = True
562 chk ImportedId = True
563 chk (SuperDictSelId _ _) = True
564 chk (MethodSelId _ _) = True
565 chk (DefaultMethodId _ _ _) = True
566 chk (DictFunId _ _) = True
567 chk (ConstMethodId _ _ _ _) = True
568 chk (WorkerId unwrkr) = idHasNoFreeTyVars unwrkr
569 chk (SpecId _ _ no_free_tvs) = no_free_tvs
570 chk (InstId no_free_tvs) = no_free_tvs
571 chk (LocalId no_free_tvs) = no_free_tvs
572 chk (SysLocalId no_free_tvs) = no_free_tvs
573 chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
574 chk (PrimitiveId _) = True
576 -- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
577 -- so we don't need to put its signature in an interface file, even if it's mentioned
578 -- in some other interface unfolding.
584 omitIfaceSigForId (Id _ name _ details _ _)
590 ImportedId -> True -- Never put imports in interface file
591 (PrimitiveId _) -> True -- Ditto, for primitives
593 -- This group is Ids that are implied by their type or class decl;
594 -- remember that all type and class decls appear in the interface file.
595 -- The dfun id must *not* be omitted, because it carries version info for
597 (AlgConId _ _ _ _ _ _ _ _ _) -> True
598 (TupleConId _) -> True
599 (RecordSelId _) -> True
600 (SuperDictSelId _ _) -> True
601 (MethodSelId _ _) -> True
603 other -> False -- Don't omit!
604 -- NB DefaultMethodIds are not omitted
608 isImportedId (Id _ _ _ ImportedId _ _) = True
609 isImportedId other = False
611 isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
613 isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
614 isSysLocalId other = False
616 isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
617 isSpecPragmaId other = False
619 isMethodSelId_maybe (Id _ _ _ (MethodSelId cls op) _ _) = Just (cls,op)
620 isMethodSelId_maybe _ = Nothing
622 isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
623 isDefaultMethodId other = False
625 isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
626 = Just (cls, clsop, err)
627 isDefaultMethodId_maybe other = Nothing
629 isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
630 isDictFunId other = False
632 isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
633 isConstMethodId other = False
635 isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
636 = Just (cls, ty, clsop)
637 isConstMethodId_maybe other = Nothing
639 isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
640 isSuperDictSelId_maybe other_id = Nothing
642 isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
643 isWorkerId other = False
645 isWrapperId id = workerExists (getIdStrictness id)
647 isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
648 isPrimitiveId_maybe other = Nothing
651 Tell them who my wrapper function is.
654 myWrapperMaybe :: Id -> Maybe Id
656 myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
657 myWrapperMaybe other_id = Nothing
662 unfoldingUnfriendlyId -- return True iff it is definitely a bad
663 :: Id -- idea to export an unfolding that
664 -> Bool -- mentions this Id. Reason: it cannot
665 -- possibly be seen in another module.
667 unfoldingUnfriendlyId id = not (externallyVisibleId id)
670 @externallyVisibleId@: is it true that another module might be
671 able to ``see'' this Id in a code generation sense. That
672 is, another .o file might refer to this Id.
674 In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
675 local-ness precisely so that the test here would be easy
678 externallyVisibleId :: Id -> Bool
679 externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
680 -- not local => global => externally visible
683 CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
684 `Top-levelish Ids'' cannot have any free type variables, so applying
685 the type-env cannot have any effect. (NB: checked in CoreLint?)
687 The special casing is in @applyTypeEnvToId@, not @apply_to_Id@, as the
688 former ``should be'' the usual crunch point.
691 type TypeEnv = TyVarEnv Type
693 applyTypeEnvToId :: TypeEnv -> Id -> Id
695 applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
696 | idHasNoFreeTyVars id
699 = apply_to_Id ( \ ty ->
700 applyTypeEnvToTy type_env ty
705 apply_to_Id :: (Type -> Type) -> Id -> Id
707 apply_to_Id ty_fn (Id u n ty details prag info)
711 Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
713 apply_to_details (SpecId unspec ty_maybes no_ftvs)
715 new_unspec = apply_to_Id ty_fn unspec
716 new_maybes = map apply_to_maybe ty_maybes
718 SpecId new_unspec new_maybes (no_free_tvs ty)
719 -- ToDo: gratuitous recalc no_ftvs???? (also InstId)
721 apply_to_maybe Nothing = Nothing
722 apply_to_maybe (Just ty) = Just (ty_fn ty)
724 apply_to_details (WorkerId unwrkr)
726 new_unwrkr = apply_to_Id ty_fn unwrkr
730 apply_to_details other = other
733 Sadly, I don't think the one using the magic typechecker substitution
734 can be done with @apply_to_Id@. Here we go....
736 Strictness is very important here. We can't leave behind thunks
737 with pointers to the substitution: it {\em must} be single-threaded.
741 applySubstToId :: Subst -> Id -> (Subst, Id)
743 applySubstToId subst id@(Id u n ty info details)
744 -- *cannot* have a "idHasNoFreeTyVars" get-out clause
745 -- because, in the typechecker, we are still
746 -- *concocting* the types.
747 = case (applySubstToTy subst ty) of { (s2, new_ty) ->
748 case (applySubstToIdInfo s2 info) of { (s3, new_info) ->
749 case (apply_to_details s3 new_ty details) of { (s4, new_details) ->
750 (s4, Id u n new_ty new_info new_details) }}}
752 apply_to_details subst _ (InstId inst no_ftvs)
753 = case (applySubstToInst subst inst) of { (s2, new_inst) ->
754 (s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
756 apply_to_details subst new_ty (SpecId unspec ty_maybes _)
757 = case (applySubstToId subst unspec) of { (s2, new_unspec) ->
758 case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
759 (s3, SpecId new_unspec new_maybes (no_free_tvs new_ty)) }}
760 -- NB: recalc no_ftvs (I think it's necessary (?) WDP 95/04)
762 apply_to_maybe subst Nothing = (subst, Nothing)
763 apply_to_maybe subst (Just ty)
764 = case (applySubstToTy subst ty) of { (s2, new_ty) ->
767 apply_to_details subst _ (WorkerId unwrkr)
768 = case (applySubstToId subst unwrkr) of { (s2, new_unwrkr) ->
769 (s2, WorkerId new_unwrkr) }
771 apply_to_details subst _ other = (subst, other)
775 %************************************************************************
777 \subsection[Id-type-funs]{Type-related @Id@ functions}
779 %************************************************************************
782 idType :: GenId ty -> ty
784 idType (Id _ _ ty _ _ _) = ty
789 getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
791 getMentionedTyConsAndClassesFromId id
792 = getMentionedTyConsAndClassesFromType (idType id)
797 idPrimRep i = typePrimRep (idType i)
800 %************************************************************************
802 \subsection[Id-overloading]{Functions related to overloading}
804 %************************************************************************
807 mkSuperDictSelId u clas sc ty
808 = addStandardIdInfo $
809 Id u name ty details NoPragmaInfo noIdInfo
811 name = mkCompoundName name_fn u (getName clas)
812 details = SuperDictSelId clas sc
813 name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
814 (mod,occ) = modAndOcc sc
816 -- For method selectors the clean thing to do is
817 -- to give the method selector the same name as the class op itself.
818 mkMethodSelId op_name rec_c op ty
819 = addStandardIdInfo $
820 Id (uniqueOf op_name) op_name ty (MethodSelId rec_c op) NoPragmaInfo noIdInfo
822 mkDefaultMethodId dm_name rec_c op gen ty
823 = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c op gen) NoPragmaInfo noIdInfo
825 mkDictFunId dfun_name full_ty clas ity
826 = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
828 details = DictFunId clas ity
830 mkConstMethodId uniq clas op ity full_ty from_here locn mod info
831 = Id uniq name full_ty details NoPragmaInfo info
833 name = mkInstDeclName uniq mod (VarOcc occ_name) locn from_here
834 details = ConstMethodId clas ity op mod
835 occ_name = classOpString op _APPEND_
836 SLIT("_cm_") _APPEND_ renum_type_string full_ty ity
838 mkWorkerId u unwrkr ty info
839 = Id u name ty details NoPragmaInfo info
841 name = mkCompoundName name_fn u (getName unwrkr)
842 details = WorkerId unwrkr
843 name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
846 = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
849 getConstMethodId clas op ty
850 = -- constant-method info is hidden in the IdInfo of
851 -- the class-op id (as mentioned up above).
853 sel_id = getMethodSelId clas op
855 case (lookupConstMethodId (getIdSpecialisation sel_id) ty) of
857 Nothing -> pprError "ERROR: getConstMethodId:" (vcat [
858 hsep [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
859 ppr PprDebug sel_id],
860 text "(This can arise if an interface pragma refers to an instance",
861 text "but there is no imported interface which *defines* that instance.",
862 text "The info above, however ugly, should indicate what else you need to import."
867 renum_type_string full_ty ity
869 nmbrType full_ty `thenNmbr` \ _ -> -- so all the tyvars get added to renumbering...
870 nmbrType ity `thenNmbr` \ rn_ity ->
871 returnNmbr (getTypeString rn_ity)
875 %************************************************************************
877 \subsection[local-funs]{@LocalId@-related functions}
879 %************************************************************************
882 mkImported n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
884 mkPrimitiveId n ty primop
885 = addStandardIdInfo $
886 Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
887 -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
888 -- It's only true for primitives, because we don't want to make a closure for each of them.
893 type MyTy a b = GenType (GenTyVar a) b
894 type MyId a b = GenId (MyTy a b)
896 no_free_tvs ty = isEmptyTyVarSet (tyVarsOfType ty)
898 -- SysLocal: for an Id being created by the compiler out of thin air...
899 -- UserLocal: an Id with a name the user might recognize...
900 mkSysLocal :: FAST_STRING -> Unique -> MyTy a b -> SrcLoc -> MyId a b
901 mkUserLocal :: OccName -> Unique -> MyTy a b -> SrcLoc -> MyId a b
903 mkSysLocal str uniq ty loc
904 = Id uniq (mkSysLocalName uniq str loc) ty (SysLocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
906 mkUserLocal occ uniq ty loc
907 = Id uniq (mkLocalName uniq occ loc) ty (LocalId (no_free_tvs ty)) NoPragmaInfo noIdInfo
909 mkUserId :: Name -> MyTy a b -> PragmaInfo -> MyId a b
910 mkUserId name ty pragma_info
911 = Id (nameUnique name) name ty (LocalId (no_free_tvs ty)) pragma_info noIdInfo
918 -- for a SpecPragmaId being created by the compiler out of thin air...
919 mkSpecPragmaId :: OccName -> Unique -> Type -> Maybe Id -> SrcLoc -> Id
920 mkSpecPragmaId str uniq ty specid loc
921 = Id uniq (mkShortName str loc) ty noIdInfo (SpecPragmaId specid (no_free_tvs ty))
924 mkSpecId u unspec ty_maybes ty info
925 = ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
926 Id u n ty info (SpecId unspec ty_maybes (no_free_tvs ty))
928 -- Specialised version of constructor: only used in STG and code generation
929 -- Note: The specialsied Id has the same unique as the unspeced Id
931 mkSameSpecCon ty_maybes unspec@(Id u n ty info details)
932 = ASSERT(isDataCon unspec)
933 ASSERT(not (maybeToBool (isSpecId_maybe unspec)))
934 Id u n new_ty info (SpecId unspec ty_maybes (no_free_tvs new_ty))
936 new_ty = specialiseTy ty ty_maybes 0
938 localiseId :: Id -> Id
939 localiseId id@(Id u n ty info details)
940 = Id u (mkShortName name loc) ty info (LocalId (no_free_tvs ty))
946 -- See notes with setNameVisibility (Name.lhs)
947 setIdVisibility :: Module -> Id -> Id
948 setIdVisibility mod (Id uniq name ty details prag info)
949 = Id uniq (setNameVisibility mod name) ty details prag info
951 mkIdWithNewUniq :: Id -> Unique -> Id
952 mkIdWithNewUniq (Id _ n ty details prag info) u
953 = Id u (changeUnique n u) ty details prag info
955 mkIdWithNewName :: Id -> Name -> Id
956 mkIdWithNewName (Id _ _ ty details prag info) new_name
957 = Id (uniqueOf new_name) new_name ty details prag info
960 Make some local @Ids@ for a template @CoreExpr@. These have bogus
961 @Uniques@, but that's OK because the templates are supposed to be
962 instantiated before use.
964 mkTemplateLocals :: [Type] -> [Id]
966 = zipWith (\ u -> \ ty -> mkSysLocal SLIT("tpl") u ty mkBuiltinSrcLoc)
967 (getBuiltinUniques (length tys))
972 getIdInfo :: GenId ty -> IdInfo
973 getPragmaInfo :: GenId ty -> PragmaInfo
975 getIdInfo (Id _ _ _ _ _ info) = info
976 getPragmaInfo (Id _ _ _ _ info _) = info
978 replaceIdInfo :: Id -> IdInfo -> Id
979 replaceIdInfo (Id u n ty details pinfo _) info = Id u n ty details pinfo info
981 replacePragmaInfo :: GenId ty -> PragmaInfo -> GenId ty
982 replacePragmaInfo (Id u sn ty details _ info) prag = Id u sn ty details prag info
985 %************************************************************************
987 \subsection[Id-arities]{Arity-related functions}
989 %************************************************************************
991 For locally-defined Ids, the code generator maintains its own notion
992 of their arities; so it should not be asking... (but other things
993 besides the code-generator need arity info!)
996 getIdArity :: Id -> ArityInfo
997 getIdArity id@(Id _ _ _ _ _ id_info)
1000 addIdArity :: Id -> ArityInfo -> Id
1001 addIdArity (Id u n ty details pinfo info) arity
1002 = Id u n ty details pinfo (info `addArityInfo` arity)
1005 %************************************************************************
1007 \subsection[Id-arities]{Deforestation related functions}
1009 %************************************************************************
1012 addIdDeforestInfo :: Id -> DeforestInfo -> Id
1013 addIdDeforestInfo (Id u n ty details pinfo info) def_info
1014 = Id u n ty details pinfo (info `addDeforestInfo` def_info)
1017 %************************************************************************
1019 \subsection[constructor-funs]{@DataCon@-related functions (incl.~tuples)}
1021 %************************************************************************
1025 -> [StrictnessMark] -> [FieldLabel]
1026 -> [TyVar] -> ThetaType
1027 -> [TyVar] -> ThetaType
1028 -> [TauType] -> TyCon
1030 -- can get the tag and all the pieces of the type from the Type
1032 mkDataCon n stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon
1033 = ASSERT(length stricts == length args_tys)
1034 addStandardIdInfo data_con
1036 -- NB: data_con self-recursion; should be OK as tags are not
1037 -- looked at until late in the game.
1042 (AlgConId data_con_tag stricts fields tvs ctxt con_tvs con_ctxt args_tys tycon)
1043 IWantToBeINLINEd -- Always inline constructors if possible
1046 data_con_tag = assoc "mkDataCon" (data_con_family `zip` [fIRST_TAG..]) data_con
1047 data_con_family = tyConDataCons tycon
1050 = mkSigmaTy (tvs++con_tvs) (ctxt++con_ctxt)
1051 (mkFunTys args_tys (applyTyCon tycon (mkTyVarTys tvs)))
1054 mkTupleCon :: Arity -> Name -> Type -> Id
1055 mkTupleCon arity name ty
1056 = addStandardIdInfo tuple_id
1058 tuple_id = Id (nameUnique name) name ty
1060 IWantToBeINLINEd -- Always inline constructors if possible
1064 fIRST_TAG = 1 -- Tags allocated from here for real constructors
1067 dataConNumFields gives the number of actual fields in the
1068 {\em representation} of the data constructor. This may be more than appear
1069 in the source code; the extra ones are the existentially quantified
1074 = ASSERT(isDataCon id)
1075 case (dataConSig id) of { (_, _, _, con_theta, arg_tys, _) ->
1076 length con_theta + length arg_tys }
1078 isNullaryDataCon con = dataConNumFields con == 0 -- function of convenience
1083 dataConTag :: DataCon -> ConTag -- will panic if not a DataCon
1084 dataConTag (Id _ _ _ (AlgConId tag _ _ _ _ _ _ _ _) _ _) = tag
1085 dataConTag (Id _ _ _ (TupleConId _) _ _) = fIRST_TAG
1086 dataConTag (Id _ _ _ (SpecId unspec _ _) _ _) = dataConTag unspec
1088 dataConTyCon :: DataCon -> TyCon -- will panic if not a DataCon
1089 dataConTyCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tycon) _ _) = tycon
1090 dataConTyCon (Id _ _ _ (TupleConId a) _ _) = tupleTyCon a
1092 dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [TauType], TyCon)
1093 -- will panic if not a DataCon
1095 dataConSig (Id _ _ _ (AlgConId _ _ _ tyvars theta con_tyvars con_theta arg_tys tycon) _ _)
1096 = (tyvars, theta, con_tyvars, con_theta, arg_tys, tycon)
1098 dataConSig (Id _ _ _ (TupleConId arity) _ _)
1099 = (tyvars, [], [], [], tyvar_tys, tupleTyCon arity)
1101 tyvars = take arity alphaTyVars
1102 tyvar_tys = mkTyVarTys tyvars
1105 -- dataConRepType returns the type of the representation of a contructor
1106 -- This may differ from the type of the contructor Id itself for two reasons:
1107 -- a) the constructor Id may be overloaded, but the dictionary isn't stored
1108 -- b) the constructor may store an unboxed version of a strict field.
1109 -- Here's an example illustrating both:
1110 -- data Ord a => T a = MkT Int! a
1112 -- T :: Ord a => Int -> a -> T a
1113 -- but the rep type is
1114 -- Trep :: Int# -> a -> T a
1115 -- Actually, the unboxed part isn't implemented yet!
1117 dataConRepType :: GenId (GenType tv u) -> GenType tv u
1119 = mkForAllTys tyvars tau
1121 (tyvars, theta, tau) = splitSigmaTy (idType con)
1123 dataConFieldLabels :: DataCon -> [FieldLabel]
1124 dataConFieldLabels (Id _ _ _ (AlgConId _ _ fields _ _ _ _ _ _) _ _) = fields
1125 dataConFieldLabels (Id _ _ _ (TupleConId _) _ _) = []
1127 dataConStrictMarks :: DataCon -> [StrictnessMark]
1128 dataConStrictMarks (Id _ _ _ (AlgConId _ stricts _ _ _ _ _ _ _) _ _) = stricts
1129 dataConStrictMarks (Id _ _ _ (TupleConId arity) _ _)
1130 = nOfThem arity NotMarkedStrict
1132 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
1133 dataConRawArgTys con = case (dataConSig con) of { (_,_, _, _, arg_tys,_) -> arg_tys }
1135 dataConArgTys :: DataCon
1136 -> [Type] -- Instantiated at these types
1137 -> [Type] -- Needs arguments of these types
1138 dataConArgTys con_id inst_tys
1139 = map (instantiateTy tenv) arg_tys
1141 (tyvars, _, _, _, arg_tys, _) = dataConSig con_id
1142 tenv = zipEqual "dataConArgTys" tyvars inst_tys
1146 mkRecordSelId field_label selector_ty
1147 = addStandardIdInfo $ -- Record selectors have a standard unfolding
1148 Id (nameUnique name)
1151 (RecordSelId field_label)
1155 name = fieldLabelName field_label
1157 recordSelectorFieldLabel :: Id -> FieldLabel
1158 recordSelectorFieldLabel (Id _ _ _ (RecordSelId lbl) _ _) = lbl
1160 isRecordSelector (Id _ _ _ (RecordSelId lbl) _ _) = True
1161 isRecordSelector other = False
1165 Data type declarations are of the form:
1167 data Foo a b = C1 ... | C2 ... | ... | Cn ...
1169 For each constructor @Ci@, we want to generate a curried function; so, e.g., for
1170 @C1 x y z@, we want a function binding:
1172 fun_C1 = /\ a -> /\ b -> \ [x, y, z] -> Con C1 [a, b] [x, y, z]
1174 Notice the ``big lambdas'' and type arguments to @Con@---we are producing
1175 2nd-order polymorphic lambda calculus with explicit types.
1177 %************************************************************************
1179 \subsection[unfolding-Ids]{Functions related to @Ids@' unfoldings}
1181 %************************************************************************
1184 getIdUnfolding :: Id -> Unfolding
1186 getIdUnfolding (Id _ _ _ _ _ info) = unfoldInfo info
1188 addIdUnfolding :: Id -> Unfolding -> Id
1189 addIdUnfolding id@(Id u n ty details prag info) unfolding
1190 = Id u n ty details prag (info `addUnfoldInfo` unfolding)
1193 The inline pragma tells us to be very keen to inline this Id, but it's still
1194 OK not to if optimisation is switched off.
1197 getInlinePragma :: Id -> PragmaInfo
1198 getInlinePragma (Id _ _ _ _ prag _) = prag
1200 idWantsToBeINLINEd :: Id -> Bool
1202 idWantsToBeINLINEd (Id _ _ _ _ IWantToBeINLINEd _) = True
1203 idWantsToBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1204 idWantsToBeINLINEd _ = False
1206 idMustNotBeINLINEd (Id _ _ _ _ IMustNotBeINLINEd _) = True
1207 idMustNotBeINLINEd _ = False
1209 idMustBeINLINEd (Id _ _ _ _ IMustBeINLINEd _) = True
1210 idMustBeINLINEd _ = False
1212 addInlinePragma :: Id -> Id
1213 addInlinePragma (Id u sn ty details _ info)
1214 = Id u sn ty details IWantToBeINLINEd info
1216 nukeNoInlinePragma :: Id -> Id
1217 nukeNoInlinePragma id@(Id u sn ty details IMustNotBeINLINEd info)
1218 = Id u sn ty details NoPragmaInfo info
1219 nukeNoInlinePragma id@(Id u sn ty details _ info) = id -- Otherwise no-op
1221 addNoInlinePragma :: Id -> Id
1222 addNoInlinePragma id@(Id u sn ty details _ info)
1223 = Id u sn ty details IMustNotBeINLINEd info
1228 %************************************************************************
1230 \subsection[IdInfo-funs]{Functions related to @Ids@' @IdInfos@}
1232 %************************************************************************
1235 getIdDemandInfo :: Id -> DemandInfo
1236 getIdDemandInfo (Id _ _ _ _ _ info) = demandInfo info
1238 addIdDemandInfo :: Id -> DemandInfo -> Id
1239 addIdDemandInfo (Id u n ty details prags info) demand_info
1240 = Id u n ty details prags (info `addDemandInfo` demand_info)
1244 getIdUpdateInfo :: Id -> UpdateInfo
1245 getIdUpdateInfo (Id _ _ _ _ _ info) = updateInfo info
1247 addIdUpdateInfo :: Id -> UpdateInfo -> Id
1248 addIdUpdateInfo (Id u n ty details prags info) upd_info
1249 = Id u n ty details prags (info `addUpdateInfo` upd_info)
1254 getIdArgUsageInfo :: Id -> ArgUsageInfo
1255 getIdArgUsageInfo (Id u n ty info details) = argUsageInfo info
1257 addIdArgUsageInfo :: Id -> ArgUsageInfo -> Id
1258 addIdArgUsageInfo (Id u n ty info details) au_info
1259 = Id u n ty (info `addArgusageInfo` au_info) details
1265 getIdFBTypeInfo :: Id -> FBTypeInfo
1266 getIdFBTypeInfo (Id u n ty info details) = fbTypeInfo info
1268 addIdFBTypeInfo :: Id -> FBTypeInfo -> Id
1269 addIdFBTypeInfo (Id u n ty info details) upd_info
1270 = Id u n ty (info `addFBTypeInfo` upd_info) details
1275 getIdSpecialisation :: Id -> SpecEnv
1276 getIdSpecialisation (Id _ _ _ _ _ info) = specInfo info
1278 addIdSpecialisation :: Id -> SpecEnv -> Id
1279 addIdSpecialisation (Id u n ty details prags info) spec_info
1280 = Id u n ty details prags (info `addSpecInfo` spec_info)
1283 Strictness: we snaffle the info out of the IdInfo.
1286 getIdStrictness :: Id -> StrictnessInfo Id
1288 getIdStrictness (Id _ _ _ _ _ info) = strictnessInfo info
1290 addIdStrictness :: Id -> StrictnessInfo Id -> Id
1291 addIdStrictness (Id u n ty details prags info) strict_info
1292 = Id u n ty details prags (info `addStrictnessInfo` strict_info)
1295 %************************************************************************
1297 \subsection[Id-comparison]{Comparison functions for @Id@s}
1299 %************************************************************************
1301 Comparison: equality and ordering---this stuff gets {\em hammered}.
1304 cmpId (Id u1 _ _ _ _ _) (Id u2 _ _ _ _ _) = cmp u1 u2
1305 -- short and very sweet
1309 instance Ord3 (GenId ty) where
1312 instance Eq (GenId ty) where
1313 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
1314 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
1316 instance Ord (GenId ty) where
1317 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
1318 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
1319 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
1320 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
1321 _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
1324 @cmpId_withSpecDataCon@ ensures that any spectys are taken into
1325 account when comparing two data constructors. We need to do this
1326 because a specialised data constructor has the same Unique as its
1327 unspecialised counterpart.
1330 cmpId_withSpecDataCon :: Id -> Id -> TAG_
1332 cmpId_withSpecDataCon id1 id2
1333 | eq_ids && isDataCon id1 && isDataCon id2
1334 = cmpEqDataCon id1 id2
1339 cmp_ids = cmpId id1 id2
1340 eq_ids = case cmp_ids of { EQ_ -> True; other -> False }
1342 cmpEqDataCon (Id _ _ _ (SpecId _ mtys1 _) _ _) (Id _ _ _ (SpecId _ mtys2 _) _ _)
1343 = panic# "Id.cmpEqDataCon:cmpUniTypeMaybeList mtys1 mtys2"
1345 cmpEqDataCon _ (Id _ _ _ (SpecId _ _ _) _ _) = LT_
1346 cmpEqDataCon (Id _ _ _ (SpecId _ _ _) _ _) _ = GT_
1347 cmpEqDataCon _ _ = EQ_
1350 %************************************************************************
1352 \subsection[Id-other-instances]{Other instance declarations for @Id@s}
1354 %************************************************************************
1357 instance Outputable ty => Outputable (GenId ty) where
1358 ppr sty id = pprId sty id
1360 -- and a SPECIALIZEd one:
1361 instance Outputable {-Id, i.e.:-}(GenId Type) where
1362 ppr sty id = pprId sty id
1364 showId :: PprStyle -> Id -> String
1365 showId sty id = show (pprId sty id)
1368 Default printing code (not used for interfaces):
1370 pprId :: Outputable ty => PprStyle -> GenId ty -> Doc
1372 pprId sty (Id u n _ _ prags _)
1373 = hcat [ppr sty n, pp_prags]
1375 pp_prags = ifPprDebug sty (case prags of
1376 IMustNotBeINLINEd -> text "{n}"
1377 IWantToBeINLINEd -> text "{i}"
1378 IMustBeINLINEd -> text "{I}"
1381 -- WDP 96/05/06: We can re-elaborate this as we go along...
1385 idUnique (Id u _ _ _ _ _) = u
1387 instance Uniquable (GenId ty) where
1390 instance NamedThing (GenId ty) where
1391 getName this_id@(Id u n _ details _ _) = n
1394 Note: The code generator doesn't carry a @UniqueSupply@, so it uses
1395 the @Uniques@ out of local @Ids@ given to it.
1397 %************************************************************************
1399 \subsection{@IdEnv@s and @IdSet@s}
1401 %************************************************************************
1404 type IdEnv elt = UniqFM elt
1406 nullIdEnv :: IdEnv a
1408 mkIdEnv :: [(GenId ty, a)] -> IdEnv a
1409 unitIdEnv :: GenId ty -> a -> IdEnv a
1410 addOneToIdEnv :: IdEnv a -> GenId ty -> a -> IdEnv a
1411 growIdEnv :: IdEnv a -> IdEnv a -> IdEnv a
1412 growIdEnvList :: IdEnv a -> [(GenId ty, a)] -> IdEnv a
1414 delManyFromIdEnv :: IdEnv a -> [GenId ty] -> IdEnv a
1415 delOneFromIdEnv :: IdEnv a -> GenId ty -> IdEnv a
1416 combineIdEnvs :: (a -> a -> a) -> IdEnv a -> IdEnv a -> IdEnv a
1417 mapIdEnv :: (a -> b) -> IdEnv a -> IdEnv b
1418 modifyIdEnv :: (a -> a) -> IdEnv a -> GenId ty -> IdEnv a
1419 rngIdEnv :: IdEnv a -> [a]
1421 isNullIdEnv :: IdEnv a -> Bool
1422 lookupIdEnv :: IdEnv a -> GenId ty -> Maybe a
1423 lookupNoFailIdEnv :: IdEnv a -> GenId ty -> a
1427 addOneToIdEnv = addToUFM
1428 combineIdEnvs = plusUFM_C
1429 delManyFromIdEnv = delListFromUFM
1430 delOneFromIdEnv = delFromUFM
1432 lookupIdEnv = lookupUFM
1435 nullIdEnv = emptyUFM
1439 growIdEnvList env pairs = plusUFM env (listToUFM pairs)
1440 isNullIdEnv env = sizeUFM env == 0
1441 lookupNoFailIdEnv env id = case (lookupIdEnv env id) of { Just xx -> xx }
1443 -- modifyIdEnv: Look up a thing in the IdEnv, then mash it with the
1444 -- modify function, and put it back.
1446 modifyIdEnv mangle_fn env key
1447 = case (lookupIdEnv env key) of
1449 Just xx -> addOneToIdEnv env key (mangle_fn xx)
1451 modifyIdEnv_Directly mangle_fn env key
1452 = case (lookupUFM_Directly env key) of
1454 Just xx -> addToUFM_Directly env key (mangle_fn xx)
1458 type GenIdSet ty = UniqSet (GenId ty)
1459 type IdSet = UniqSet (GenId Type)
1461 emptyIdSet :: GenIdSet ty
1462 intersectIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1463 unionIdSets :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1464 unionManyIdSets :: [GenIdSet ty] -> GenIdSet ty
1465 idSetToList :: GenIdSet ty -> [GenId ty]
1466 unitIdSet :: GenId ty -> GenIdSet ty
1467 addOneToIdSet :: GenIdSet ty -> GenId ty -> GenIdSet ty
1468 elementOfIdSet :: GenId ty -> GenIdSet ty -> Bool
1469 minusIdSet :: GenIdSet ty -> GenIdSet ty -> GenIdSet ty
1470 isEmptyIdSet :: GenIdSet ty -> Bool
1471 mkIdSet :: [GenId ty] -> GenIdSet ty
1473 emptyIdSet = emptyUniqSet
1474 unitIdSet = unitUniqSet
1475 addOneToIdSet = addOneToUniqSet
1476 intersectIdSets = intersectUniqSets
1477 unionIdSets = unionUniqSets
1478 unionManyIdSets = unionManyUniqSets
1479 idSetToList = uniqSetToList
1480 elementOfIdSet = elementOfUniqSet
1481 minusIdSet = minusUniqSet
1482 isEmptyIdSet = isEmptyUniqSet
1487 addId, nmbrId, nmbrDataCon :: Id -> NmbrM Id
1489 addId id@(Id u n ty det prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1490 = case (lookupUFM_Directly idenv u) of
1491 Just xx -> trace "addId: already in map!" $
1494 if toplevelishId id then
1495 trace "addId: can't add toplevelish!" $
1497 else -- alloc a new unique for this guy
1498 -- and add an entry in the idenv
1499 -- NB: *** KNOT-TYING ***
1501 nenv_plus_id = NmbrEnv (incrUnique ui) ut uu
1502 (addToUFM_Directly idenv u new_id)
1505 (nenv2, new_ty) = nmbrType ty nenv_plus_id
1506 (nenv3, new_det) = nmbr_details det nenv2
1508 new_id = Id ui n new_ty new_det prag info
1512 nmbrId id@(Id u n ty det prag info) nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1513 = case (lookupUFM_Directly idenv u) of
1514 Just xx -> (nenv, xx)
1516 if not (toplevelishId id) then
1517 trace "nmbrId: lookup failed" $
1521 (nenv2, new_ty) = nmbrType ty nenv
1522 (nenv3, new_det) = nmbr_details det nenv2
1524 new_id = Id u n new_ty new_det prag info
1528 -- used when renumbering TyCons to produce data decls...
1529 nmbrDataCon id@(Id _ _ _ (TupleConId _) _ _) nenv
1530 = (nenv, id) -- nothing to do for tuples
1532 nmbrDataCon id@(Id u n ty (AlgConId tag marks fields tvs theta con_tvs con_theta arg_tys tc) prag info)
1533 nenv@(NmbrEnv ui ut uu idenv tvenv uvenv)
1534 = case (lookupUFM_Directly idenv u) of
1535 Just xx -> trace "nmbrDataCon: in env???\n" (nenv, xx)
1538 (nenv2, new_fields) = (mapNmbr nmbrField fields) nenv
1539 (nenv3, new_arg_tys) = (mapNmbr nmbrType arg_tys) nenv2
1541 new_det = AlgConId tag marks new_fields (bottom "tvs") (bottom "theta") (bottom "tvs") (bottom "theta") new_arg_tys tc
1542 new_id = Id u n (bottom "ty") new_det prag info
1546 bottom msg = panic ("nmbrDataCon"++msg)
1549 nmbr_details :: IdDetails -> NmbrM IdDetails
1551 nmbr_details (AlgConId tag marks fields tvs theta con_tvs con_theta arg_tys tc)
1552 = mapNmbr nmbrTyVar tvs `thenNmbr` \ new_tvs ->
1553 mapNmbr nmbrTyVar con_tvs `thenNmbr` \ new_con_tvs ->
1554 mapNmbr nmbrField fields `thenNmbr` \ new_fields ->
1555 mapNmbr nmbr_theta theta `thenNmbr` \ new_theta ->
1556 mapNmbr nmbr_theta con_theta `thenNmbr` \ new_con_theta ->
1557 mapNmbr nmbrType arg_tys `thenNmbr` \ new_arg_tys ->
1558 returnNmbr (AlgConId tag marks new_fields new_tvs new_theta new_con_tvs new_con_theta new_arg_tys tc)
1561 = --nmbrClass c `thenNmbr` \ new_c ->
1562 nmbrType t `thenNmbr` \ new_t ->
1563 returnNmbr (c, new_t)
1565 -- ToDo:add more cases as needed
1566 nmbr_details other_details = returnNmbr other_details
1569 nmbrField (FieldLabel n ty tag)
1570 = nmbrType ty `thenNmbr` \ new_ty ->
1571 returnNmbr (FieldLabel n new_ty tag)