import OccName ( occNameUserString )
import TyCon ( tyConDataCons, isEnumerationTyCon, TyCon )
import Type ( typePrimRep )
+import CmdLineOpts
\end{code}
For every constructor we generate the following info tables:
-- C labels are local to this module i.e. static
-- since they may be duplicated in other modules
- mkAbstractCs [ gen_for_tycon tc | tc <- gen_tycons ]
+ mkAbstractCs [ gen_for_tycon tc `mkAbsCStmts` enum_closure_table tc
+ | tc <- gen_tycons ]
where
gen_for_tycon :: TyCon -> AbstractC
- gen_for_tycon tycon
- = mkAbstractCs (map (genConInfo comp_info tycon) (tyConDataCons tycon))
- `mkAbsCStmts` (
- -- after the con decls, so we don't need to declare the constructor labels
- if (isEnumerationTyCon tycon)
- then CClosureTbl tycon
- else AbsCNop
- )
+ gen_for_tycon tycon = mkAbstractCs [ genConInfo comp_info data_con
+ | data_con <- tyConDataCons tycon ]
+
+ enum_closure_table tycon
+ | isEnumerationTyCon tycon = CClosureTbl tycon
+ | otherwise = AbsCNop
+ -- Put the table after the data constructor decls, because the
+ -- datatype closure table (for enumeration types)
+ -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
\end{code}
+
%************************************************************************
%* *
\subsection[CgConTbls-info-tables]{Generating info tables for constructors}
static closure, for a constructor.
\begin{code}
-genConInfo :: CompilationInfo -> TyCon -> DataCon -> AbstractC
+genConInfo :: CompilationInfo -> DataCon -> AbstractC
-genConInfo comp_info tycon data_con
- = mkAbstractCs [
- CSplitMarker,
+genConInfo comp_info data_con
+ = -- Order of things is to reduce forward references
+ mkAbstractCs [if opt_EnsureSplittableC then CSplitMarker else AbsCNop,
closure_code,
static_code]
- -- Order of things is to reduce forward references
where
(closure_info, body_code) = mkConCodeAndInfo data_con
-- info-table contains the information we need.
(static_ci,_) = layOutStaticConstr con_name data_con typePrimRep arg_tys
- body = (initC comp_info (
- profCtrC SLIT("TICK_ENT_CON") [CReg node] `thenC`
- body_code))
+ static_body = initC comp_info (
+ profCtrC FSLIT("TICK_ENT_STATIC_CON") [CReg node] `thenC`
+ ldv_enter_and_body_code)
+
+ closure_body = initC comp_info (
+ profCtrC FSLIT("TICK_ENT_DYN_CON") [CReg node] `thenC`
+ ldv_enter_and_body_code)
+
+ ldv_enter_and_body_code = ldvEnter `thenC` body_code
con_descr = occNameUserString (getOccName data_con)
closure_code = if zero_arity_con then
AbsCNop
else
- CClosureInfoAndCode closure_info body Nothing con_descr
+ CClosureInfoAndCode closure_info closure_body Nothing con_descr
- static_code = CClosureInfoAndCode static_ci body Nothing con_descr
+ static_code = CClosureInfoAndCode static_ci static_body Nothing con_descr
zero_arity_con = isNullaryDataCon data_con
-- We used to check that all the arg-sizes were zero, but we don't
body_code
= -- NB: We don't set CC when entering data (WDP 94/06)
- profCtrC SLIT("TICK_RET_OLD")
+ profCtrC FSLIT("TICK_RET_OLD")
[mkIntCLit (length arg_things)] `thenC`
performReturn AbsCNop -- Ptr to thing already in Node