trivial diff: HLDS dumps of tabling pointers
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Feb 18 12:30:35 AEDT 1999
Allow HLDS dumps to contain references to the pointers used by tabling.
Without this chance, HLDS dumps can abort on modules containing tabled
procedures.
compiler/hlds_out.m:
Allow HLDS dumps to contain references to the pointers used by tabling.
This requires adding an extra argument to an exported procedure.
compiler/mode_errors.m:
compiler/typecheck.m:
Pass the extra argument that exported procedure.
Zoltan.
Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.213
diff -u -u -r1.213 hlds_out.m
--- hlds_out.m 1999/02/12 03:46:54 1.213
+++ hlds_out.m 1999/02/17 07:16:11
@@ -147,8 +147,8 @@
% print out a cons_id and arguments
:- pred hlds_out__write_functor_cons_id(cons_id, list(prog_var), prog_varset,
- bool, io__state, io__state).
-:- mode hlds_out__write_functor_cons_id(in, in, in, in, di, uo) is det.
+ module_info, bool, io__state, io__state).
+:- mode hlds_out__write_functor_cons_id(in, in, in, in, in, di, uo) is det.
% print out the right-hand-side of a unification
@@ -1458,9 +1458,10 @@
hlds_out__write_unify_rhs_3(var(Var), _, VarSet, _, AppendVarnums, _, _, _) -->
mercury_output_var(Var, VarSet, AppendVarnums).
-hlds_out__write_unify_rhs_3(functor(ConsId, ArgVars), _, VarSet, _,
+hlds_out__write_unify_rhs_3(functor(ConsId, ArgVars), ModuleInfo, VarSet, _,
AppendVarnums, _Indent, MaybeType, TypeQual) -->
- hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, AppendVarnums),
+ hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, ModuleInfo,
+ AppendVarnums),
( { MaybeType = yes(Type), TypeQual = yes(TVarSet, _) } ->
io__write_string(" TYPE_QUAL_OP "),
mercury_output_term(Type, TVarSet, no)
@@ -1551,7 +1552,8 @@
hlds_out__write_functor(Functor, ArgVars, VarSet, AppendVarnums,
next_to_graphic_token).
-hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, AppendVarnums) -->
+hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, ModuleInfo,
+ AppendVarnums) -->
(
{ ConsId = cons(SymName, _) },
(
@@ -1605,8 +1607,13 @@
io__write_string(Instance),
io__write_string(")")
;
- { ConsId = tabling_pointer_const(_, _) },
- { error("hlds_out__write_functor_cons_id: tabling_pointer_const") }
+ { ConsId = tabling_pointer_const(PredId, ProcId) },
+ io__write_string("tabling_pointer_const("),
+ hlds_out__write_pred_id(ModuleInfo, PredId),
+ io__write_string(", "),
+ { proc_id_to_int(ProcId, ProcIdInt) },
+ io__write_int(ProcIdInt),
+ io__write_string(")")
).
hlds_out__write_var_modes([], [], _, _, _) --> [].
Index: mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.60
diff -u -u -r1.60 mode_errors.m
--- mode_errors.m 1998/11/20 04:08:26 1.60
+++ mode_errors.m 1999/02/17 06:47:59
@@ -635,7 +635,9 @@
mercury_output_var(Y, VarSet, no)
;
{ RHS = error_at_functor(ConsId, ArgVars) },
- hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, no)
+ { mode_info_get_module_info(ModeInfo, ModuleInfo) },
+ hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet,
+ ModuleInfo, no)
;
{ RHS = error_at_lambda(ArgVars, ArgModes) },
io__write_string("lambda(["),
@@ -739,12 +741,13 @@
{ mode_info_get_context(ModeInfo, Context) },
{ mode_info_get_varset(ModeInfo, VarSet) },
{ mode_info_get_instvarset(ModeInfo, InstVarSet) },
+ { mode_info_get_module_info(ModeInfo, ModuleInfo) },
mode_info_write_context(ModeInfo),
prog_out__write_context(Context),
io__write_string(" mode error in unification of `"),
mercury_output_var(X, VarSet, no),
io__write_string("' and `"),
- hlds_out__write_functor_cons_id(ConsId, Args, VarSet, no),
+ hlds_out__write_functor_cons_id(ConsId, Args, VarSet, ModuleInfo, no),
io__write_string("'.\n"),
prog_out__write_context(Context),
io__write_string(" Variable `"),
@@ -754,7 +757,7 @@
io__write_string("',\n"),
prog_out__write_context(Context),
io__write_string(" term `"),
- hlds_out__write_functor_cons_id(ConsId, Args, VarSet, no),
+ hlds_out__write_functor_cons_id(ConsId, Args, VarSet, ModuleInfo, no),
( { Args \= [] } ->
io__write_string("'\n"),
prog_out__write_context(Context),
Index: typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.256
diff -u -u -r1.256 typecheck.m
--- typecheck.m 1998/11/20 04:09:34 1.256
+++ typecheck.m 1999/02/17 06:48:46
@@ -4066,6 +4066,7 @@
{ typecheck_info_get_context(TypeCheckInfo, Context) },
{ typecheck_info_get_varset(TypeCheckInfo, VarSet) },
{ typecheck_info_get_unify_context(TypeCheckInfo, UnifyContext) },
+ { typecheck_info_get_module_info(TypeCheckInfo, ModuleInfo) },
{ list__length(Args, Arity) },
write_context_and_pred_id(TypeCheckInfo),
@@ -4078,7 +4079,7 @@
prog_out__write_context(Context),
io__write_string(" and term `"),
{ strip_builtin_qualifier_from_cons_id(Functor, Functor1) },
- hlds_out__write_functor_cons_id(Functor1, Args, VarSet, no),
+ hlds_out__write_functor_cons_id(Functor1, Args, VarSet, ModuleInfo, no),
io__write_string("':\n"),
prog_out__write_context(Context),
io__write_string(" type error in argument(s) of "),
More information about the developers
mailing list