-[A BIT DATED [WDP]]
-
-The @Id@ datatype describes {\em values}. The basic things we want to
-know: (1)~a value's {\em type} (@idType@ is a very common
-operation in the compiler); and (2)~what ``flavour'' of value it might
-be---for example, it can be terribly useful to know that a value is a
-class method.
-
-\begin{description}
-%----------------------------------------------------------------------
-\item[@AlgConId@:] For the data constructors declared by a @data@
-declaration. Their type is kept in {\em two} forms---as a regular
-@Type@ (in the usual place), and also in its constituent pieces (in
-the ``details''). We are frequently interested in those pieces.
-
-%----------------------------------------------------------------------
-\item[@TupleConId@:] This is just a special shorthand for @DataCons@ for
-the infinite family of tuples.
-
-%----------------------------------------------------------------------
-\item[@ImportedId@:] These are values defined outside this module.
-{\em Everything} we want to know about them must be stored here (or in
-their @IdInfo@).
-
-%----------------------------------------------------------------------
-\item[@MethodSelId@:] A selector from a dictionary; it may select either
-a method or a dictionary for one of the class's superclasses.
-
-%----------------------------------------------------------------------
-\item[@DictFunId@:]
-
-@mkDictFunId [a,b..] theta C T@ is the function derived from the
-instance declaration
-
- instance theta => C (T a b ..) where
- ...
-
-It builds function @Id@ which maps dictionaries for theta,
-to a dictionary for C (T a b ..).
-
-*Note* that with the ``Mark Jones optimisation'', the theta may
-include dictionaries for the immediate superclasses of C at the type
-(T a b ..).
-
-%----------------------------------------------------------------------
-\item[@InstId@:]
-
-%----------------------------------------------------------------------
-\item[@SpecId@:]
-
-%----------------------------------------------------------------------
-\item[@WorkerId@:]
-
-%----------------------------------------------------------------------
-\item[@LocalId@:] A purely-local value, e.g., a function argument,
-something defined in a @where@ clauses, ... --- but which appears in
-the original program text.
-
-%----------------------------------------------------------------------
-\item[@SysLocalId@:] Same as a @LocalId@, except does {\em not} appear in
-the original program text; these are introduced by the compiler in
-doing its thing.
-
-%----------------------------------------------------------------------
-\item[@SpecPragmaId@:] Introduced by the compiler to record
-Specialisation pragmas. It is dead code which MUST NOT be removed
-before specialisation.
-\end{description}
-
-Further remarks:
-\begin{enumerate}
-%----------------------------------------------------------------------
-\item
-
-@DataCons@ @TupleCons@, @Importeds@, @SuperDictSelIds@,
-@MethodSelIds@, @DictFunIds@, and @DefaultMethodIds@ have the following
-properties:
-\begin{itemize}
-\item
-They have no free type variables, so if you are making a
-type-variable substitution you don't need to look inside them.
-\item
-They are constants, so they are not free variables. (When the STG
-machine makes a closure, it puts all the free variables in the
-closure; the above are not required.)
-\end{itemize}
-Note that @InstIds@, @Locals@ and @SysLocals@ {\em may} have the above
-properties, but they may not.
-\end{enumerate}
-
-%************************************************************************
-%* *
-\subsection[Id-general-funs]{General @Id@-related functions}
-%* *
-%************************************************************************
-
-\begin{code}
--- isDataCon returns False for @newtype@ constructors
-isDataCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isDataTyCon tc
-isDataCon (Id _ _ _ (TupleConId _) _ _) = True
-isDataCon (Id _ _ _ (SpecId unspec _ _) _ _) = isDataCon unspec
-isDataCon other = False
-
-isNewCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ tc) _ _) = isNewTyCon tc
-isNewCon other = False
-
--- isAlgCon returns True for @data@ or @newtype@ constructors
-isAlgCon (Id _ _ _ (AlgConId _ _ _ _ _ _ _ _ _) _ _) = True
-isAlgCon (Id _ _ _ (TupleConId _) _ _) = True
-isAlgCon (Id _ _ _ (SpecId unspec _ _) _ _) = isAlgCon unspec
-isAlgCon other = False
-
-isTupleCon (Id _ _ _ (TupleConId _) _ _) = True
-isTupleCon (Id _ _ _ (SpecId unspec _ _) _ _) = isTupleCon unspec
-isTupleCon other = False
-\end{code}
-
-@toplevelishId@ tells whether an @Id@ {\em may} be defined in a nested
-@let(rec)@ (returns @False@), or whether it is {\em sure} to be
-defined at top level (returns @True@). This is used to decide whether
-the @Id@ is a candidate free variable. NB: you are only {\em sure}
-about something if it returns @True@!
-
-\begin{code}
-toplevelishId :: Id -> Bool
-idHasNoFreeTyVars :: Id -> Bool
-
-toplevelishId (Id _ _ _ details _ _)
- = chk details
- where
- chk (AlgConId _ __ _ _ _ _ _ _) = True
- chk (TupleConId _) = True
- chk (RecordSelId _) = True
- chk ImportedId = True
- chk (SuperDictSelId _ _) = True
- chk (MethodSelId _ _) = True
- chk (DefaultMethodId _ _ _) = True
- chk (DictFunId _ _) = True
- chk (ConstMethodId _ _ _ _) = True
- chk (SpecId unspec _ _) = toplevelishId unspec
- -- depends what the unspecialised thing is
- chk (WorkerId unwrkr) = toplevelishId unwrkr
- chk (InstId _) = False -- these are local
- chk (LocalId _) = False
- chk (SysLocalId _) = False
- chk (SpecPragmaId _ _) = False
- chk (PrimitiveId _) = True
-
-idHasNoFreeTyVars (Id _ _ _ details _ info)
- = chk details
- where
- chk (AlgConId _ _ _ _ _ _ _ _ _) = True
- chk (TupleConId _) = True
- chk (RecordSelId _) = True
- chk ImportedId = True
- chk (SuperDictSelId _ _) = True
- chk (MethodSelId _ _) = True
- chk (DefaultMethodId _ _ _) = True
- chk (DictFunId _ _) = True
- chk (ConstMethodId _ _ _ _) = True
- chk (WorkerId unwrkr) = idHasNoFreeTyVars unwrkr
- chk (SpecId _ _ no_free_tvs) = no_free_tvs
- chk (InstId no_free_tvs) = no_free_tvs
- chk (LocalId no_free_tvs) = no_free_tvs
- chk (SysLocalId no_free_tvs) = no_free_tvs
- chk (SpecPragmaId _ no_free_tvs) = no_free_tvs
- chk (PrimitiveId _) = True
-
--- omitIfaceSigForId tells whether an Id's info is implied by other declarations,
--- so we don't need to put its signature in an interface file, even if it's mentioned
--- in some other interface unfolding.
-
-omitIfaceSigForId
- :: Id
- -> Bool
-
-omitIfaceSigForId (Id _ name _ details _ _)
- | isWiredInName name
- = True
-
- | otherwise
- = case details of
- ImportedId -> True -- Never put imports in interface file
- (PrimitiveId _) -> True -- Ditto, for primitives
-
- -- This group is Ids that are implied by their type or class decl;
- -- remember that all type and class decls appear in the interface file.
- -- The dfun id must *not* be omitted, because it carries version info for
- -- the instance decl
- (AlgConId _ _ _ _ _ _ _ _ _) -> True
- (TupleConId _) -> True
- (RecordSelId _) -> True
- (SuperDictSelId _ _) -> True
- (MethodSelId _ _) -> True
-
- other -> False -- Don't omit!
- -- NB DefaultMethodIds are not omitted
-\end{code}
-
-\begin{code}
-isImportedId (Id _ _ _ ImportedId _ _) = True
-isImportedId other = False
-
-isBottomingId (Id _ _ _ _ _ info) = bottomIsGuaranteed (strictnessInfo info)
-
-isSysLocalId (Id _ _ _ (SysLocalId _) _ _) = True
-isSysLocalId other = False
-
-isSpecPragmaId (Id _ _ _ (SpecPragmaId _ _) _ _) = True
-isSpecPragmaId other = False
-
-isMethodSelId_maybe (Id _ _ _ (MethodSelId cls op) _ _) = Just (cls,op)
-isMethodSelId_maybe _ = Nothing
-
-isDefaultMethodId (Id _ _ _ (DefaultMethodId _ _ _) _ _) = True
-isDefaultMethodId other = False
-
-isDefaultMethodId_maybe (Id _ _ _ (DefaultMethodId cls clsop err) _ _)
- = Just (cls, clsop, err)
-isDefaultMethodId_maybe other = Nothing
-
-isDictFunId (Id _ _ _ (DictFunId _ _) _ _) = True
-isDictFunId other = False
-
-isConstMethodId (Id _ _ _ (ConstMethodId _ _ _ _) _ _) = True
-isConstMethodId other = False
-
-isConstMethodId_maybe (Id _ _ _ (ConstMethodId cls ty clsop _) _ _)
- = Just (cls, ty, clsop)
-isConstMethodId_maybe other = Nothing
-
-isSuperDictSelId_maybe (Id _ _ _ (SuperDictSelId c sc) _ _) = Just (c, sc)
-isSuperDictSelId_maybe other_id = Nothing
-
-isWorkerId (Id _ _ _ (WorkerId _) _ _) = True
-isWorkerId other = False
-
-isWrapperId id = workerExists (getIdStrictness id)
-
-isPrimitiveId_maybe (Id _ _ _ (PrimitiveId primop) _ _) = Just primop
-isPrimitiveId_maybe other = Nothing
-\end{code}
-
-Tell them who my wrapper function is.
-\begin{code}
-{-LATER:
-myWrapperMaybe :: Id -> Maybe Id
-
-myWrapperMaybe (Id _ _ _ (WorkerId my_wrapper) _ _) = Just my_wrapper
-myWrapperMaybe other_id = Nothing
--}
-\end{code}
-
-\begin{code}
-unfoldingUnfriendlyId -- return True iff it is definitely a bad
- :: Id -- idea to export an unfolding that
- -> Bool -- mentions this Id. Reason: it cannot
- -- possibly be seen in another module.
-
-unfoldingUnfriendlyId id = not (externallyVisibleId id)
-\end{code}
-
-@externallyVisibleId@: is it true that another module might be
-able to ``see'' this Id in a code generation sense. That
-is, another .o file might refer to this Id.
-
-In tidyCorePgm (SimplCore.lhs) we carefully set each top level thing's
-local-ness precisely so that the test here would be easy
-
-\begin{code}
-externallyVisibleId :: Id -> Bool
-externallyVisibleId id@(Id _ name _ _ _ _) = not (isLocalName name)
- -- not local => global => externally visible
-\end{code}
-
-CLAIM (not ASSERTed) for @applyTypeEnvToId@ and @applySubstToId@:
-`Top-levelish Ids'' cannot have any free type variables, so applying
-the type-env cannot have any effect. (NB: checked in CoreLint?)
-
-The special casing is in @applyTypeEnvToId@, not @apply_to_Id@, as the
-former ``should be'' the usual crunch point.
-
-\begin{code}
-type TypeEnv = TyVarEnv Type
-
-applyTypeEnvToId :: TypeEnv -> Id -> Id
-
-applyTypeEnvToId type_env id@(Id _ _ ty _ _ _)
- | idHasNoFreeTyVars id
- = id
- | otherwise
- = apply_to_Id ( \ ty ->
- applyTypeEnvToTy type_env ty
- ) id
-\end{code}
-
-\begin{code}
-apply_to_Id :: (Type -> Type) -> Id -> Id
-
-apply_to_Id ty_fn (Id u n ty details prag info)
- = let
- new_ty = ty_fn ty
- in
- Id u n new_ty (apply_to_details details) prag (apply_to_IdInfo ty_fn info)
- where
- apply_to_details (SpecId unspec ty_maybes no_ftvs)
- = let
- new_unspec = apply_to_Id ty_fn unspec
- new_maybes = map apply_to_maybe ty_maybes
- in
- SpecId new_unspec new_maybes (no_free_tvs ty)
- -- ToDo: gratuitous recalc no_ftvs???? (also InstId)
- where
- apply_to_maybe Nothing = Nothing
- apply_to_maybe (Just ty) = Just (ty_fn ty)
-
- apply_to_details (WorkerId unwrkr)
- = let
- new_unwrkr = apply_to_Id ty_fn unwrkr
- in
- WorkerId new_unwrkr
-
- apply_to_details other = other
-\end{code}
-
-Sadly, I don't think the one using the magic typechecker substitution
-can be done with @apply_to_Id@. Here we go....
-
-Strictness is very important here. We can't leave behind thunks
-with pointers to the substitution: it {\em must} be single-threaded.
-
-\begin{code}
-{-LATER:
-applySubstToId :: Subst -> Id -> (Subst, Id)
-
-applySubstToId subst id@(Id u n ty info details)
- -- *cannot* have a "idHasNoFreeTyVars" get-out clause
- -- because, in the typechecker, we are still
- -- *concocting* the types.
- = case (applySubstToTy subst ty) of { (s2, new_ty) ->
- case (applySubstToIdInfo s2 info) of { (s3, new_info) ->
- case (apply_to_details s3 new_ty details) of { (s4, new_details) ->
- (s4, Id u n new_ty new_info new_details) }}}
- where
- apply_to_details subst _ (InstId inst no_ftvs)
- = case (applySubstToInst subst inst) of { (s2, new_inst) ->
- (s2, InstId new_inst no_ftvs{-ToDo:right???-}) }
-
- apply_to_details subst new_ty (SpecId unspec ty_maybes _)
- = case (applySubstToId subst unspec) of { (s2, new_unspec) ->
- case (mapAccumL apply_to_maybe s2 ty_maybes) of { (s3, new_maybes) ->
- (s3, SpecId new_unspec new_maybes (no_free_tvs new_ty)) }}
- -- NB: recalc no_ftvs (I think it's necessary (?) WDP 95/04)
- where
- apply_to_maybe subst Nothing = (subst, Nothing)
- apply_to_maybe subst (Just ty)
- = case (applySubstToTy subst ty) of { (s2, new_ty) ->
- (s2, Just new_ty) }
-
- apply_to_details subst _ (WorkerId unwrkr)
- = case (applySubstToId subst unwrkr) of { (s2, new_unwrkr) ->
- (s2, WorkerId new_unwrkr) }
-
- apply_to_details subst _ other = (subst, other)
--}
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Id-type-funs]{Type-related @Id@ functions}
-%* *
-%************************************************************************
-
-\begin{code}
-idType :: GenId ty -> ty
-
-idType (Id _ _ ty _ _ _) = ty
-\end{code}
-
-\begin{code}
-{-LATER:
-getMentionedTyConsAndClassesFromId :: Id -> (Bag TyCon, Bag Class)
-
-getMentionedTyConsAndClassesFromId id
- = getMentionedTyConsAndClassesFromType (idType id)
--}
-\end{code}
-
-\begin{code}
-idPrimRep i = typePrimRep (idType i)
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Id-overloading]{Functions related to overloading}
-%* *
-%************************************************************************
-
-\begin{code}
-mkSuperDictSelId u clas sc ty
- = addStandardIdInfo $
- Id u name ty details NoPragmaInfo noIdInfo
- where
- name = mkCompoundName name_fn u (getName clas)
- details = SuperDictSelId clas sc
- name_fn clas_str = SLIT("scsel_") _APPEND_ clas_str _APPEND_ mod _APPEND_ occNameString occ
- (mod,occ) = modAndOcc sc
-
- -- For method selectors the clean thing to do is
- -- to give the method selector the same name as the class op itself.
-mkMethodSelId op_name rec_c op ty
- = addStandardIdInfo $
- Id (uniqueOf op_name) op_name ty (MethodSelId rec_c op) NoPragmaInfo noIdInfo
-
-mkDefaultMethodId dm_name rec_c op gen ty
- = Id (uniqueOf dm_name) dm_name ty (DefaultMethodId rec_c op gen) NoPragmaInfo noIdInfo
-
-mkDictFunId dfun_name full_ty clas ity
- = Id (nameUnique dfun_name) dfun_name full_ty details NoPragmaInfo noIdInfo
- where
- details = DictFunId clas ity
-
-mkConstMethodId uniq clas op ity full_ty from_here locn mod info
- = Id uniq name full_ty details NoPragmaInfo info
- where
- name = mkInstDeclName uniq mod (VarOcc occ_name) locn from_here
- details = ConstMethodId clas ity op mod
- occ_name = classOpString op _APPEND_
- SLIT("_cm_") _APPEND_ renum_type_string full_ty ity
-
-mkWorkerId u unwrkr ty info
- = Id u name ty details NoPragmaInfo info
- where
- name = mkCompoundName name_fn u (getName unwrkr)
- details = WorkerId unwrkr
- name_fn wkr_str = SLIT("$w") _APPEND_ wkr_str
-
-mkInstId u ty name
- = Id u name ty (InstId (no_free_tvs ty)) NoPragmaInfo noIdInfo
-
-{-LATER:
-getConstMethodId clas op ty
- = -- constant-method info is hidden in the IdInfo of
- -- the class-op id (as mentioned up above).
- let
- sel_id = getMethodSelId clas op
- in
- case (lookupConstMethodId (getIdSpecialisation sel_id) ty) of
- Just xx -> xx
- Nothing -> pprError "ERROR: getConstMethodId:" (vcat [
- hsep [ppr PprDebug ty, ppr PprDebug ops, ppr PprDebug op_ids,
- ppr PprDebug sel_id],
- text "(This can arise if an interface pragma refers to an instance",
- text "but there is no imported interface which *defines* that instance.",
- text "The info above, however ugly, should indicate what else you need to import."
- ])
--}
-
-
-renum_type_string full_ty ity
- = initNmbr (
- nmbrType full_ty `thenNmbr` \ _ -> -- so all the tyvars get added to renumbering...
- nmbrType ity `thenNmbr` \ rn_ity ->
- returnNmbr (getTypeString rn_ity)
- )
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[local-funs]{@LocalId@-related functions}
-%* *
-%************************************************************************
-
-\begin{code}
-mkImported n ty info = Id (nameUnique n) n ty ImportedId NoPragmaInfo info
-
-mkPrimitiveId n ty primop
- = addStandardIdInfo $
- Id (nameUnique n) n ty (PrimitiveId primop) IMustBeINLINEd noIdInfo
- -- The pragma @IMustBeINLINEd@ says that this Id absolutely must be inlined.
- -- It's only true for primitives, because we don't want to make a closure for each of them.
-\end{code}
-