[m-rev.] for review: fix HLDS dumps

[Zoltan Somogyi]

Fix a problem in Fergus's recent change that broke HLDS dumps.

The change to make_hlds.m is by Fergus and is intended to prevent future
problems; the change to hlds_out.m is enough to fix the HLDS dump problem.

compiler/hlds_out.m:
	When a clause is recorded as being applicable to a mode (procedure)
	that doesn't exit, ignore the mode instead of generating a lookup
	failure. The procedure may have been deleted by the dead procedure
	removal pass.

	Also clean up an auxiliary procedure that was in the way.

compiler/make_hlds.m:
	When a clause applies to all modes, record this fact using an abstract
	representation of "all modes", instead of enumerating all modes
	currently existing.

Zoltan.

Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.260
diff -u -b -r1.260 hlds_out.m
--- compiler/hlds_out.m	2001/05/31 05:59:36	1.260
+++ compiler/hlds_out.m	2001/06/01 08:10:55
@@ -964,18 +964,14 @@
 	( { Modes = [] ; Modes = ProcIds } ->
 		hlds_out__write_clause_head(ModuleInfo, PredId, VarSet,
 			AppendVarnums, HeadTerms, PredOrFunc)
-	; { Modes = [SingleMode] } ->
-		{ module_info_pred_proc_info(ModuleInfo, PredId, SingleMode,
-			_PredInfo, ProcInfo) },
-		{ proc_info_argmodes(ProcInfo, ArgModes) },
-		{ assoc_list__from_corresponding_lists(HeadTerms, ArgModes, 
-			AnnotatedPairs) },
-		{ AnnotatedHeadTerms = list__map(add_mode_qualifier(Context),
-			AnnotatedPairs) },
-		hlds_out__write_clause_head(ModuleInfo, PredId, VarSet,
-			AppendVarnums, AnnotatedHeadTerms, PredOrFunc)
 	;
-		{ error("No syntax for clause which applies to >1 mode") }
+		% If Modes contains more than one mode, the output will have
+		% multiple clause heads. This won't be pretty and it won't be 
+		% syntactically valid, but it is more useful for debugging
+		% than a compiler abort during the dumping process.
+		hlds_out__write_annotated_clause_heads(ModuleInfo, Context,
+			PredId, Modes, VarSet, AppendVarnums, HeadTerms,
+			PredOrFunc)
 	),
 	( { Goal = conj([]) - _GoalInfo } ->
 		io__write_string(".\n")
@@ -985,36 +981,41 @@
 			Indent1, ".\n", TypeQual)
 	).
 
-:- pred hlds_out__write_intlist(list(int), io__state, io__state).
-:- mode hlds_out__write_intlist(in, di, uo) is det.
+:- pred hlds_out__write_annotated_clause_heads(module_info::in,
+	term__context::in, pred_id::in, list(proc_id)::in, prog_varset::in,
+	bool::in, list(prog_term)::in, pred_or_func::in,
+	io__state::di, io__state::uo) is det.
+
+hlds_out__write_annotated_clause_heads(_, _, _, [], _, _, _, _) --> [].
+hlds_out__write_annotated_clause_heads(ModuleInfo, Context, PredId,
+		[ProcId | ProcIds], VarSet, AppendVarnums, HeadTerms,
+		PredOrFunc) -->
+	hlds_out__write_annotated_clause_head(ModuleInfo, Context, PredId,
+		ProcId, VarSet, AppendVarnums, HeadTerms, PredOrFunc),
+	hlds_out__write_annotated_clause_heads(ModuleInfo, Context, PredId,
+		ProcIds, VarSet, AppendVarnums, HeadTerms, PredOrFunc).
+
+:- pred hlds_out__write_annotated_clause_head(module_info::in,
+	term__context::in, pred_id::in, proc_id::in, prog_varset::in,
+	bool::in, list(prog_term)::in, pred_or_func::in,
+	io__state::di, io__state::uo) is det.
 
-hlds_out__write_intlist(IntList) -->
-	(
-		{ IntList = [] }
-	->
-		io__write_string("[]")
-	;
-		io__write_string("[ "),
-		hlds_out__write_intlist_2(IntList),
-		io__write_string("]")
-	).
-
-:- pred hlds_out__write_intlist_2(list(int), io__state, io__state).
-:- mode hlds_out__write_intlist_2(in, di, uo) is det.
-
-hlds_out__write_intlist_2(Ns0) -->
-	(
-		{ Ns0 = [N] }
-	->
-		io__write_int(N)
-	;
-		{ Ns0 = [N|Ns] }
-	->
-		io__write_int(N),
-		io__write_string(", "),
-		hlds_out__write_intlist_2(Ns)
+hlds_out__write_annotated_clause_head(ModuleInfo, Context, PredId, ProcId,
+		VarSet, AppendVarnums, HeadTerms, PredOrFunc) -->
+	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+	{ pred_info_procedures(PredInfo, Procedures) },
+	( { map__search(Procedures, ProcId, ProcInfo) } ->
+		{ proc_info_argmodes(ProcInfo, ArgModes) },
+		{ assoc_list__from_corresponding_lists(HeadTerms, ArgModes, 
+			AnnotatedPairs) },
+		{ AnnotatedHeadTerms = list__map(add_mode_qualifier(Context),
+			AnnotatedPairs) },
+		hlds_out__write_clause_head(ModuleInfo, PredId, VarSet,
+			AppendVarnums, AnnotatedHeadTerms, PredOrFunc)
 	;
-		{ error("This should be unreachable.") }
+		% This procedure, even though it existed in the past, has been
+		% eliminated.
+		[]
 	).
 
 :- pred hlds_out__write_clause_head(module_info, pred_id, prog_varset, bool,
@@ -3171,6 +3172,33 @@
 		io__write_char('\t'),
 		{ Indent1 is Indent - 1 },
 		hlds_out__write_indent(Indent1)
+	).
+
+:- pred hlds_out__write_intlist(list(int), io__state, io__state).
+:- mode hlds_out__write_intlist(in, di, uo) is det.
+
+hlds_out__write_intlist(IntList) -->
+	(
+		{ IntList = [] },
+		io__write_string("[]")
+	;
+		{ IntList = [H | T] },
+		io__write_string("[ "),
+		hlds_out__write_intlist_2(H, T),
+		io__write_string("]")
+	).
+
+:- pred hlds_out__write_intlist_2(int, list(int), io__state, io__state).
+:- mode hlds_out__write_intlist_2(in, in, di, uo) is det.
+
+hlds_out__write_intlist_2(H, T) -->
+	io__write_int(H),
+	(
+		{ T = [TH | TT] },
+		io__write_string(", "),
+		hlds_out__write_intlist_2(TH, TT)
+	;
+		{ T = [] }
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.371
diff -u -b -r1.371 make_hlds.m
--- compiler/make_hlds.m	2001/05/16 04:50:46	1.371
+++ compiler/make_hlds.m	2001/06/01 09:03:13
@@ -3816,12 +3816,12 @@
 		)
 	;
 		{ ModeAnnotations = empty },
-		{ pred_info_all_procids(PredInfo, ProcIds) },
+		{ ProcIds = [] }, % this means the clauses applies to all modes
 		{ ModuleInfo = ModuleInfo0 },
 		{ Info = Info0 }
 	;
 		{ ModeAnnotations = none },
-		{ pred_info_all_procids(PredInfo, ProcIds) },
+		{ ProcIds = [] }, % this means the clauses applies to all modes
 		{ ModuleInfo = ModuleInfo0 },
 		{ Info = Info0 }
 	;
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------