realWorldPrimId,
unsafeCoerceId,
nullAddrId,
- getTagId,
seqId
]
\end{code}
info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- ty = mkForAllTys [alphaTyVar,betaTyVar]
- (mkFunTy alphaTy (mkFunTy betaTy betaTy))
- [x,y] = mkTemplateLocals [alphaTy, betaTy]
- rhs = mkLams [alphaTyVar,betaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
+ ty = mkForAllTys [alphaTyVar,openBetaTyVar]
+ (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
+ [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
+ rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x [(DEFAULT, [], Var y)])
-- lazy :: forall a?. a? -> a? (i.e. works for unboxed types too)
-- Used to lazify pseq: pseq a b = a `seq` lazy b
[x] = mkTemplateLocals [openAlphaTy]
\end{code}
-@getTag#@ is another function which can't be defined in Haskell. It needs to
-evaluate its argument and call the dataToTag# primitive.
-
-\begin{code}
-getTagId
- = pcMiscPrelId getTagName ty info
- where
- info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
- -- We don't provide a defn for this; you must inline it
-
- ty = mkForAllTys [alphaTyVar] (mkFunTy alphaTy intPrimTy)
- [x,y] = mkTemplateLocals [alphaTy,alphaTy]
- rhs = mkLams [alphaTyVar,x] $
- Case (Var x) y [ (DEFAULT, [], mkApps (Var dataToTagId) [Type alphaTy, Var y]) ]
-
-dataToTagId = mkPrimOpId DataToTagOp
-\end{code}
-
@realWorld#@ used to be a magic literal, \tr{void#}. If things get
nasty as-is, change it back to a literal (@Literal@).
%************************************************************************
\begin{code}
-getTag_RDR = nameRdrName getTagName
-
eq_RDR = nameRdrName eqName
ge_RDR = nameRdrName geName
ne_RDR = varQual_RDR pREL_BASE_Name FSLIT("/=")
compose_RDR = varQual_RDR pREL_BASE_Name FSLIT(".")
not_RDR = varQual_RDR pREL_BASE_Name FSLIT("not")
+getTag_RDR = varQual_RDR pREL_BASE_Name FSLIT("getTag")
succ_RDR = varQual_RDR pREL_ENUM_Name FSLIT("succ")
pred_RDR = varQual_RDR pREL_ENUM_Name FSLIT("pred")
minBound_RDR = varQual_RDR pREL_ENUM_Name FSLIT("minBound")
cCallableClassName = clsQual gHC_PRIM_Name FSLIT("CCallable") cCallableClassKey
cReturnableClassName = clsQual gHC_PRIM_Name FSLIT("CReturnable") cReturnableClassKey
-getTagName = wVarQual gHC_PRIM_Name FSLIT("getTag#") getTagIdKey
unsafeCoerceName = wVarQual gHC_PRIM_Name FSLIT("unsafeCoerce#") unsafeCoerceIdKey
nullAddrName = wVarQual gHC_PRIM_Name FSLIT("nullAddr#") nullAddrIdKey
seqName = wVarQual gHC_PRIM_Name FSLIT("seq") seqIdKey
\begin{code}
absentErrorIdKey = mkPreludeMiscIdUnique 1
-getTagIdKey = mkPreludeMiscIdUnique 2
augmentIdKey = mkPreludeMiscIdUnique 3
appendIdKey = mkPreludeMiscIdUnique 4
buildIdKey = mkPreludeMiscIdUnique 5