projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
More small fixes to generics branch (doesn't compile yet)
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
MkId.lhs
diff --git
a/compiler/basicTypes/MkId.lhs
b/compiler/basicTypes/MkId.lhs
index
7bd9910
..
a251734
100644
(file)
--- a/
compiler/basicTypes/MkId.lhs
+++ b/
compiler/basicTypes/MkId.lhs
@@
-13,7
+13,7
@@
have a standard form, namely:
\begin{code}
module MkId (
\begin{code}
module MkId (
- mkDictFunId, mkDictFunTy, mkDefaultMethodId, mkDictSelId,
+ mkDictFunId, mkDictFunTy, mkDictSelId,
mkDataConIds,
mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
mkDataConIds,
mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
@@
-235,9
+235,9
@@
mkDataConIds wrap_name wkr_name data_con
wkr_arity = dataConRepArity data_con
wkr_info = noCafIdInfo
wkr_arity = dataConRepArity data_con
wkr_info = noCafIdInfo
- `setArityInfo` wkr_arity
+ `setArityInfo` wkr_arity
`setStrictnessInfo` Just wkr_sig
`setStrictnessInfo` Just wkr_sig
- `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
+ `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
-- even if arity = 0
wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
-- even if arity = 0
wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
@@
-270,6
+270,7
@@
mkDataConIds wrap_name wkr_name data_con
nt_work_id = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info
nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` 1 -- Arity 1
nt_work_id = mkGlobalId (DataConWrapId data_con) wkr_name wrap_ty nt_work_info
nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` 1 -- Arity 1
+ `setInlinePragInfo` alwaysInlinePragma
`setUnfoldingInfo` newtype_unf
id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
newtype_unf = ASSERT2( isVanillaDataCon data_con &&
`setUnfoldingInfo` newtype_unf
id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
newtype_unf = ASSERT2( isVanillaDataCon data_con &&
@@
-825,11
+826,6
@@
BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
that they aren't discarded by the occurrence analyser.
\begin{code}
that they aren't discarded by the occurrence analyser.
\begin{code}
-mkDefaultMethodId :: Id -- Selector Id
- -> Name -- Default method name
- -> Id -- Default method Id
-mkDefaultMethodId sel_id dm_name = mkExportedLocalId dm_name (idType sel_id)
-
mkDictFunId :: Name -- Name to use for the dict fun;
-> [TyVar]
-> ThetaType
mkDictFunId :: Name -- Name to use for the dict fun;
-> [TyVar]
-> ThetaType
@@
-899,7
+895,8
@@
unsafeCoerceId :: Id
unsafeCoerceId
= pcMiscPrelId unsafeCoerceName ty info
where
unsafeCoerceId
= pcMiscPrelId unsafeCoerceName ty info
where
- info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+ info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+ `setUnfoldingInfo` mkCompulsoryUnfolding rhs
ty = mkForAllTys [argAlphaTyVar,openBetaTyVar]
ty = mkForAllTys [argAlphaTyVar,openBetaTyVar]
@@
-915,15
+912,16
@@
nullAddrId :: Id
-- a way to write this literal in Haskell.
nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
where
-- a way to write this literal in Haskell.
nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
where
- info = noCafIdInfo `setUnfoldingInfo`
- mkCompulsoryUnfolding (Lit nullAddrLit)
+ info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+ `setUnfoldingInfo` mkCompulsoryUnfolding (Lit nullAddrLit)
------------------------------------------------
seqId :: Id -- See Note [seqId magic]
seqId = pcMiscPrelId seqName ty info
where
------------------------------------------------
seqId :: Id -- See Note [seqId magic]
seqId = pcMiscPrelId seqName ty info
where
- info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- `setSpecInfo` mkSpecInfo [seq_cast_rule]
+ info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+ `setUnfoldingInfo` mkCompulsoryUnfolding rhs
+ `setSpecInfo` mkSpecInfo [seq_cast_rule]
ty = mkForAllTys [alphaTyVar,argBetaTyVar]
ty = mkForAllTys [alphaTyVar,argBetaTyVar]