-- And some particular Ids; see below for why they are wired in
wiredInIds,
- unsafeCoerceId, realWorldPrimId,
+ unsafeCoerceId, realWorldPrimId, nullAddrId,
eRROR_ID, eRROR_CSTRING_ID, rEC_SEL_ERROR_ID, pAT_ERROR_ID, rEC_CON_ERROR_ID,
rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID,
nO_METHOD_BINDING_ERROR_ID, aBSENT_ERROR_ID, pAR_ERROR_ID
import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
-import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
+import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, betaTyVar, betaTy,
intPrimTy, realWorldStatePrimTy, addrPrimTy
)
import TysWiredIn ( charTy, mkListTy )
-import PrelRules ( primOpRule )
+import PrelRules ( primOpRules )
import Rules ( addRule )
import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp,
mkTyVarTys, mkClassPred, tcEqPred,
import Module ( Module )
import CoreUtils ( mkInlineMe )
import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
-import Literal ( Literal(..) )
+import Literal ( Literal(..), nullAddrLit )
import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
import Class ( Class, classTyCon, classTyVars, classSelIds )
, rEC_CON_ERROR_ID
, rEC_UPD_ERROR_ID
- -- These three can't be defined in Haskell
+ -- These can't be defined in Haskell, but they have
+ -- perfectly reasonable unfoldings in Core
, realWorldPrimId
, unsafeCoerceId
+ , nullAddrId
, getTagId
+ , seqId
]
\end{code}
`setArityInfo` arity
`setNewStrictnessInfo` Just strict_sig
- arity = dataConRepArity data_con
+ arity = dataConRepArity data_con
+
strict_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) cpr_info)
+ -- Notice that we do *not* say the worker is strict
+ -- even if the data constructor is declared strict
+ -- e.g. data T = MkT !(Int,Int)
+ -- Why? Because the *wrapper* is strict (and its unfolding has case
+ -- expresssions that do the evals) but the *worker* itself is not.
+ -- If we pretend it is strict then when we see
+ -- case x of y -> $wMkT y
+ -- the simplifier thinks that y is "sure to be evaluated" (because
+ -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
+ --
+ -- When the simplifer sees a pattern
+ -- case e of MkT x -> ...
+ -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
+ -- but that's fine... dataConRepStrictness comes from the data con
+ -- not from the worker Id.
tycon = dataConTyCon data_con
cpr_info | isProductTyCon tycon &&
-- applications are treated as values
`setNewStrictnessInfo` Just wrap_sig
- wrap_ty = mkForAllTys all_tyvars $
- mkFunTys all_arg_tys
- result_ty
+ wrap_ty = mkForAllTys all_tyvars (mkFunTys all_arg_tys result_ty)
res_info = strictSigResInfo (idNewStrictness work_id)
wrap_sig = mkStrictSig (mkTopDmdType (replicate arity topDmd) res_info)
`setArityInfo` arity
`setUnfoldingInfo` mkTopUnfolding rhs_w_str
`setNewStrictnessInfo` Just strict_sig
- -- Unfolding and strictness added by dmdAnalTopId
-- Allocate Ids. We do it a funny way round because field_dict_tys is
-- almost always empty. Also note that we use length_tycon_theta
`setNewStrictnessInfo` Just (mkNewStrictnessInfo id arity strict_info NoCPRInfo)
-- Until we modify the primop generation code
- rules = maybe emptyCoreRules (addRule emptyCoreRules id)
- (primOpRule prim_op)
+ rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
-- For each ccall we manufacture a separate CCallOpId, giving it
%* *
%************************************************************************
-These two can't be defined in Haskell.
+These Ids can't be defined in Haskell. They could be defined in
+unfoldings in PrelGHC.hi-boot, but we'd have to ensure that they
+were definitely, definitely inlined, because there is no curried
+identifier for them. That's what mkCompulsoryUnfolding does.
+If we had a way to get a compulsory unfolding from an interface file,
+we could do that, but we don't right now.
unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
just gets expanded into a type coercion wherever it occurs. Hence we
another gun with which to shoot yourself in the foot.
\begin{code}
+-- unsafeCoerce# :: forall a b. a -> b
unsafeCoerceId
= pcMiscPrelId unsafeCoerceIdKey pREL_GHC SLIT("unsafeCoerce#") ty info
where
[x] = mkTemplateLocals [openAlphaTy]
rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
Note (Coerce openBetaTy openAlphaTy) (Var x)
-\end{code}
+-- nullAddr# :: Addr#
+-- The reason is is here is because we don't provide
+-- a way to write this literal in Haskell.
+nullAddrId
+ = pcMiscPrelId nullAddrIdKey pREL_GHC SLIT("nullAddr#") addrPrimTy info
+ where
+ info = noCafNoTyGenIdInfo `setUnfoldingInfo`
+ mkCompulsoryUnfolding (Lit nullAddrLit)
+
+seqId
+ = pcMiscPrelId seqIdKey pREL_GHC SLIT("seq") ty info
+ where
+ info = noCafNoTyGenIdInfo `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)])
+\end{code}
@getTag#@ is another function which can't be defined in Haskell. It needs to
evaluate its argument and call the dataToTag# primitive.
pc_bottoming_Id key mod name ty
= pcMiscPrelId key mod name ty bottoming_info
where
-
- arity = 1
strict_sig = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
bottoming_info = noCafNoTyGenIdInfo `setNewStrictnessInfo` Just strict_sig
-- these "bottom" out, no matter what their arguments
projects / ghc-hetmet.git / blobdiff