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