mkDataConIds,
mkRecordSelId,
- mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBinaryTickBoxOpId,
+ mkPrimOpId, mkFCallId, mkTickBoxOpId, mkBreakPointOpId,
mkReboxingAlt, wrapNewTypeBody, unwrapNewTypeBody,
mkUnpackCase, mkProductBox,
-- arguments to the universals of the data constructor
-- (crucial when type checking interfaces)
dict_tys = mkPredTys theta
- result_ty_args = map (substTyVar subst) univ_tvs
+ result_ty_args = substTyVars subst univ_tvs
result_ty = case tyConFamInst_maybe tycon of
-- ordinary constructor
Nothing -> mkTyConApp tycon result_ty_args
arity = length arg_tys
strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
-mkTickBoxOpId :: Unique
- -> Module
- -> TickBoxId
- -> Id
-mkTickBoxOpId uniq mod ix = mkGlobalId (TickBoxOpId tickbox) name ty info
+-- Tick boxes and breakpoints are both represented as TickBoxOpIds,
+-- except for the type:
+--
+-- a plain HPC tick box has type (State# RealWorld)
+-- a breakpoint Id has type forall a.a
+--
+-- The breakpoint Id will be applied to a list of arbitrary free variables,
+-- which is why it needs a polymorphic type.
+
+mkTickBoxOpId :: Unique -> Module -> TickBoxId -> Id
+mkTickBoxOpId uniq mod ix = mkTickBox' uniq mod ix realWorldStatePrimTy
+
+mkBreakPointOpId :: Unique -> Module -> TickBoxId -> Id
+mkBreakPointOpId uniq mod ix = mkTickBox' uniq mod ix ty
+ where ty = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
+
+mkTickBox' uniq mod ix ty = mkGlobalId (TickBoxOpId tickbox) name ty info
where
tickbox = TickBox mod ix
occ_str = showSDoc (braces (ppr tickbox))
name = mkTickBoxOpName uniq occ_str
info = noCafIdInfo
- ty = realWorldStatePrimTy
-
-mkBinaryTickBoxOpId
- :: Unique
- -> Module
- -> TickBoxId
- -> TickBoxId
- -> Id
-mkBinaryTickBoxOpId uniq mod ixT ixF = mkGlobalId (TickBoxOpId tickbox) name ty info
- where
- tickbox = BinaryTickBox mod ixT ixF
- occ_str = showSDoc (braces (ppr tickbox))
- name = mkTickBoxOpName uniq occ_str
- info = noCafIdInfo
- `setArityInfo` arity
- `setAllStrictnessInfo` Just strict_sig
- ty = mkFunTy boolTy boolTy
-
- arity = 1
- strict_sig = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
- --- ?? mkStrictSig (mkTopDmdType [seqDmd] TopRes)
\end{code}
(mkFunTy openAlphaTy openBetaTy)
[x] = mkTemplateLocals [openAlphaTy]
rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
--- Note (Coerce openBetaTy openAlphaTy) (Var x)
- Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
+ Cast (Var x) (mkUnsafeCoercion openAlphaTy openBetaTy)
-- nullAddr# :: Addr#
-- The reason is is here is because we don't provide