[m-rev.] diff: extend tabling via extra args

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Jun 21 13:31:29 AEST 2004


compiler/table_gen.m:
	Extend the tabling via extra args scheme. When that option is set,
	make the mark_as_failed goal a foreign_proc instead of a call, and
	merge the duplicate check and answer block creation foreign_procs into
	one.

	The duplicate check and answer block creation foreign_procs
	used to refer to the subgoal and to the output arguments by different
	names. To allow the merge, make the name of the base variable for the
	answer block creation foreign_proc configurable, and consistently
	use a single scheme (var/name pairs) to allocate the C names we use to
	refer to arguments.

tests/tabling/rotate.{m,exp}:
tests/tabling/rotate2.{m,exp}:
	Two new cases. Rotate checks the handling of different types of output
	arguments, while rotate2, a variant, checks the handling of multiple
	arguments.

tests/tabling/Mmakefile:
	Enable the new test cases.

Zoltan.

cvs server: Diffing .
cvs server: Diffing analysis
cvs server: Diffing bindist
cvs server: Diffing boehm_gc
cvs server: Diffing boehm_gc/Mac_files
cvs server: Diffing boehm_gc/cord
cvs server: Diffing boehm_gc/cord/private
cvs server: Diffing boehm_gc/doc
cvs server: Diffing boehm_gc/include
cvs server: Diffing boehm_gc/include/private
cvs server: Diffing boehm_gc/tests
cvs server: Diffing browser
cvs server: Diffing bytecode
cvs server: Diffing compiler
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.63
diff -u -b -r1.63 table_gen.m
--- compiler/table_gen.m	14 Jun 2004 04:16:38 -0000	1.63
+++ compiler/table_gen.m	21 Jun 2004 03:29:24 -0000
@@ -523,8 +523,9 @@
 	goal_info_get_context(OrigGoalInfo, Context),
 
 	ModuleInfo = !.TableInfo ^ table_module_info,
+	allocate_slot_numbers(InputVars, 0, NumberedInputVars),
 	generate_simple_call_table_lookup_goal(loop_status_type,
-		"table_loop_setup", InputVars, PredId, ProcId, Context,
+		"table_loop_setup", NumberedInputVars, PredId, ProcId, Context,
 		!VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar,
 		LookUpGoal, Steps),
 
@@ -687,8 +688,9 @@
 		CodeModel = model_non,
 		error("create_new_memo_goal: model_non")
 	),
+	allocate_slot_numbers(InputVars, 0, NumberedInputVars),
 	generate_simple_call_table_lookup_goal(StatusType, SetupPred,
-		InputVars, PredId, ProcId, Context, !VarTypes, !VarSet,
+		NumberedInputVars, PredId, ProcId, Context, !VarTypes, !VarSet,
 		!TableInfo, TableTipVar, StatusVar, LookUpGoal, Steps),
 
 	generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
@@ -734,9 +736,25 @@
 			det, impure, Context, ThenGoalInfo),
 		ThenGoal = ThenGoalExpr - ThenGoalInfo,
 
+		tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+		MarkAsFailedPred = "table_memo_mark_as_failed",
+		(
+			TablingViaExtraArgs = yes,
+			TableTipArg = foreign_arg(TableTipVar,
+				yes(cur_table_node_name - in_mode),
+				trie_node_type),
+			MarkAsFailedCode = "MR_" ++ MarkAsFailedPred ++
+				"(" ++ cur_table_node_name ++ ");",
+			generate_foreign_proc(MarkAsFailedPred, failure,
+				tabling_c_attributes, [TableTipArg], [],
+				"", MarkAsFailedCode, "", yes(impure), [],
+				ModuleInfo, Context, ElseGoal)
+		;
+			TablingViaExtraArgs = no,
 		generate_call("table_memo_mark_as_failed", failure,
-			[TableTipVar], yes(impure), [], ModuleInfo, Context,
-			ElseGoal),
+				[TableTipVar], yes(impure), [], ModuleInfo,
+				Context, ElseGoal)
+		),
 		InactiveGoalExpr = if_then_else([], RenamedOrigGoal,
 			ThenGoal, ElseGoal),
 		goal_info_init_hide(InactiveNonLocals, InactiveInstmapDelta,
@@ -1098,10 +1116,11 @@
 	goal_info_get_context(OrigGoalInfo, Context),
 
 	ModuleInfo = !.TableInfo ^ table_module_info,
+	allocate_slot_numbers(InputVars, 0, NumberedInputVars),
 	allocate_slot_numbers(OutputVars, 0, NumberedOutputVars),
 	list__length(NumberedOutputVars, BlockSize),
-	generate_mm_call_table_lookup_goal(InputVars, PredId, ProcId, Context,
-		!VarTypes, !VarSet, !TableInfo, SubgoalVar, StatusVar,
+	generate_mm_call_table_lookup_goal(NumberedInputVars, PredId, ProcId,
+		Context, !VarTypes, !VarSet, !TableInfo, SubgoalVar, StatusVar,
 		LookUpGoal, Steps),
 	generate_mm_save_goals(NumberedOutputVars, SubgoalVar, BlockSize,
 		Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
@@ -1206,15 +1225,16 @@
 	% loopcheck and memo predicates.
 
 :- pred generate_simple_call_table_lookup_goal((type)::in, string::in,
-	list(prog_var)::in, pred_id::in, proc_id::in, term__context::in,
-	vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
-	table_info::in, table_info::out, prog_var::out, prog_var::out,
-	hlds_goal::out, list(table_trie_step)::out) is det.
+	assoc_list(prog_var, int)::in, pred_id::in, proc_id::in,
+	term__context::in, vartypes::in, vartypes::out,
+	prog_varset::in, prog_varset::out, table_info::in, table_info::out,
+	prog_var::out, prog_var::out, hlds_goal::out,
+	list(table_trie_step)::out) is det.
 
-generate_simple_call_table_lookup_goal(StatusType, SetupPred, Vars,
+generate_simple_call_table_lookup_goal(StatusType, SetupPred, NumberedVars,
 		PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
 		TableTipVar, StatusVar, Goal, Steps) :-
-	generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
+	generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
 		!VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
 		Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
 		LookupCodeStr),
@@ -1237,7 +1257,7 @@
 			cur_table_node_name ++ ", " ++
 			StatusVarName ++ ");\n",
 		(
-			Vars = [_ | _],
+			NumberedVars = [_ | _],
 			Args = [PredTableArg, TableTipArg, StatusArg],
 			BoundVars = [TableTipVar, StatusVar],
 			CalledPred = SetupPred ++ "_shortcut",
@@ -1249,7 +1269,7 @@
 				TableTipVarName ++ ", " ++
 				StatusVarName ++ ");\n"
 		;
-			Vars = [],
+			NumberedVars = [],
 			Args = [PredTableArg, StatusArg],
 			BoundVars = [StatusVar],
 			CalledPred = SetupPred,
@@ -1278,6 +1298,7 @@
 		list__append(LookupGoals, [SetupGoal], LookupSetupGoals)
 	),
 	GoalExpr = conj(LookupSetupGoals),
+	assoc_list__keys(NumberedVars, Vars),
 	set__list_to_set([StatusVar, TableTipVar | Vars], NonLocals),
 	goal_info_init_hide(NonLocals, bind_vars([TableTipVar, StatusVar]),
 		det, impure, Context, GoalInfo),
@@ -1286,16 +1307,16 @@
 	% Generate a goal for doing lookups in call tables for
 	% minimal model predicates.
 
-:- pred generate_mm_call_table_lookup_goal(list(prog_var)::in,
+:- pred generate_mm_call_table_lookup_goal(assoc_list(prog_var, int)::in,
 	pred_id::in, proc_id::in, term__context::in,
 	vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
 	table_info::in, table_info::out, prog_var::out, prog_var::out,
 	hlds_goal::out, list(table_trie_step)::out) is det.
 
-generate_mm_call_table_lookup_goal(Vars, PredId, ProcId, Context,
+generate_mm_call_table_lookup_goal(NumberedVars, PredId, ProcId, Context,
 		!VarTypes, !VarSet, !TableInfo, SubgoalVar, StatusVar,
 		Goal, Steps) :-
-	generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
+	generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
 		!VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
 		Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
 		LookupCodeStr),
@@ -1345,6 +1366,7 @@
 		list__append(LookupGoals, [SetupGoal], LookupSetupGoals)
 	),
 	GoalExpr = conj(LookupSetupGoals),
+	assoc_list__keys(NumberedVars, Vars),
 	set__list_to_set([StatusVar, SubgoalVar | Vars], NonLocals),
 	goal_info_init_hide(NonLocals, bind_vars([SubgoalVar, StatusVar]),
 		det, impure, Context, GoalInfo),
@@ -1354,19 +1376,19 @@
 
 % Utility predicates used when creating call table lookup goals.
 
-:- pred generate_call_table_lookup_goals(list(prog_var)::in,
+:- pred generate_call_table_lookup_goals(assoc_list(prog_var, int)::in,
 	pred_id::in, proc_id::in, term__context::in,
 	vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
 	table_info::in, table_info::out, prog_var::out,
 	list(hlds_goal)::out, list(table_trie_step)::out, prog_var::out,
 	list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
 
-generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
+generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
 		!VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps,
 		PredTableVar, ForeignArgs, PrefixGoals, CodeStr) :-
 	generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet,
 		PredTableVar, GetTableGoal),
-	generate_table_lookup_goals(Vars, "CallTableNode", 1, Context,
+	generate_table_lookup_goals(NumberedVars, "CallTableNode", Context,
 		PredTableVar, TableTipVar, !VarTypes, !VarSet,
 		!TableInfo, LookupGoals, Steps, ForeignArgs,
 		LookupPrefixGoals, CodeStr),
@@ -1400,16 +1422,16 @@
 	% The generated code is used for lookups in both call tables
 	% and answer tables.
 
-:- pred generate_table_lookup_goals(list(prog_var)::in, string::in, int::in,
+:- pred generate_table_lookup_goals(assoc_list(prog_var, int)::in, string::in,
 	term__context::in, prog_var::in, prog_var::out,
 	vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
 	table_info::in, table_info::out, list(hlds_goal)::out,
 	list(table_trie_step)::out, list(foreign_arg)::out,
 	list(hlds_goal)::out, string::out) is det.
 
-generate_table_lookup_goals([], _, _, _, !TableVar, !VarTypes, !VarSet,
+generate_table_lookup_goals([], _, _, !TableVar, !VarTypes, !VarSet,
 		!TableInfo, [], [], [], [], "").
-generate_table_lookup_goals([Var | Vars], Prefix, VarSeqNum, Context,
+generate_table_lookup_goals([Var - VarSeqNum | NumberedVars], Prefix, Context,
 		!TableVar, !VarTypes, !VarSet, !TableInfo, Goals ++ RestGoals,
 		[Step | Steps], ForeignArgs ++ RestForeignArgs,
 		PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
@@ -1419,7 +1441,7 @@
 	gen_lookup_call_for_type(TypeCat, VarType, Var, Prefix, VarSeqNum,
 		Context, !VarTypes, !VarSet, !TableInfo, !TableVar,
 		Goals, Step, ForeignArgs, PrefixGoals, CodeStr),
-	generate_table_lookup_goals(Vars, Prefix, VarSeqNum + 1, Context,
+	generate_table_lookup_goals(NumberedVars, Prefix, Context,
 		!TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps,
 		RestForeignArgs, RestPrefixGoals, RestCodeStr).
 
@@ -1438,7 +1460,7 @@
 	generate_new_table_var(VarName, trie_node_type, !VarTypes, !VarSet,
 		NextTableVar),
 	BindNextTableVar = ground_vars([NextTableVar]),
-	ArgName = "input_arg" ++ int_to_string(VarSeqNum),
+	ArgName = arg_name(VarSeqNum),
 	ForeignArg = foreign_arg(ArgVar, yes(ArgName - in_mode), Type),
 	( TypeCat = enum_type ->
 		( type_to_ctor_and_args(Type, TypeCtor, _) ->
@@ -1524,7 +1546,6 @@
 	CodeStr = CodeStr0 ++ "\t" ++ cur_table_node_name ++ " = " ++
 		next_table_node_name ++ ";\n".
 
-
 %-----------------------------------------------------------------------------%
 
 	% Generate a goal for saving the output arguments in an answer block
@@ -1535,19 +1556,35 @@
 	vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
 	table_info::in, table_info::out, list(hlds_goal)::out) is det.
 
-generate_memo_save_goals(NumberedSaveVars, TableVar, BlockSize, Context,
+generate_memo_save_goals(NumberedSaveVars, TableTipVar, BlockSize, Context,
 		!VarTypes, !VarSet, !TableInfo, Goals) :-
 	ModuleInfo = !.TableInfo ^ table_module_info,
 	( BlockSize > 0 ->
 		CreatePredName = "table_memo_create_answer_block",
 		ShortcutPredName = "table_memo_fill_answer_block_shortcut",
-		generate_all_save_goals(NumberedSaveVars, TableVar,
-			trie_node_type, BlockSize,
+		generate_all_save_goals(NumberedSaveVars, TableTipVar,
+			trie_node_type, base_name, BlockSize,
 			CreatePredName, ShortcutPredName, Context,
-			!VarTypes, !VarSet, !TableInfo, Goals)
+			!VarTypes, !VarSet, !TableInfo, Goals, _, _)
 	;
-		generate_call("table_memo_mark_as_succeeded", det, [TableVar],
-			yes(impure), [], ModuleInfo, Context, Goal),
+		tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+		MarkAsSucceededPred = "table_memo_mark_as_succeeded",
+		(
+			TablingViaExtraArgs = yes,
+			TableArg = foreign_arg(TableTipVar,
+				yes(cur_table_node_name - in_mode),
+				trie_node_type),
+			MarkAsSucceededCode = "MR_" ++ MarkAsSucceededPred ++
+				"(" ++ cur_table_node_name ++ ");",
+			generate_foreign_proc(MarkAsSucceededPred, det,
+				tabling_c_attributes, [TableArg], [],
+				"", MarkAsSucceededCode, "", yes(impure), [],
+				ModuleInfo, Context, Goal)
+		;
+			TablingViaExtraArgs = no,
+			generate_call(MarkAsSucceededPred, det, [TableTipVar],
+				yes(impure), [], ModuleInfo, Context, Goal)
+		),
 		Goals = [Goal]
 	).
 
@@ -1568,59 +1605,74 @@
 	generate_call(GetPredName, det, [TableVar, AnswerTableVar],
 		yes(semipure), ground_vars([AnswerTableVar]),
 		ModuleInfo, Context, GetAnswerTableGoal),
-	assoc_list__keys(NumberedSaveVars, SaveVars),
-	generate_table_lookup_goals(SaveVars, "AnswerTableNode", 1, Context,
-		AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
+	generate_table_lookup_goals(NumberedSaveVars, "AnswerTableNode",
+		Context, AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
 		!TableInfo, LookupAnswerGoals, _, LookupForeignArgs,
 		LookupPrefixGoals, LookupCodeStr),
-	PredName = "table_mm_answer_is_not_duplicate",
+
+	CreatePredName = "table_mm_create_answer_block",
+	ShortcutCreatePredName = "table_mm_fill_answer_block_shortcut",
+	generate_all_save_goals(NumberedSaveVars,
+		TableVar, subgoal_type, subgoal_name, BlockSize,
+		CreatePredName, ShortcutCreatePredName, Context,
+		!VarTypes, !VarSet, !TableInfo, SaveGoals,
+		SaveDeclCode, CreateSaveCode),
+
+	DuplCheckPredName = "table_mm_answer_is_not_duplicate",
 	tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
 	(
 		TablingViaExtraArgs = yes,
 		SubgoalName = subgoal_name,
 		Args = [foreign_arg(TableVar, yes(SubgoalName - in_mode),
 			subgoal_type)],
+		SuccName = "succeeded",
 		LookupDeclCodeStr =
 			"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
 			"\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
+			"\tMR_bool " ++ SuccName ++ ";\n",
+		GetLookupCodeStr =
 			"\tMR_" ++ GetPredName ++ "(" ++ SubgoalName ++ ", " ++
 				cur_table_node_name ++ ");\n" ++
 			LookupCodeStr,
-		DuplCheckCodeStr = "\tMR_" ++ PredName ++ "(" ++
+		DuplCheckCodeStr =
+			"\tMR_" ++ DuplCheckPredName ++ "(" ++
 			cur_table_node_name ++ ", " ++
-			success_indicator_name ++ ");\n",
-		generate_foreign_proc(PredName, semidet, tabling_c_attributes,
-			Args, LookupForeignArgs, LookupDeclCodeStr,
-			DuplCheckCodeStr, "", yes(impure), [],
-			ModuleInfo, Context, DuplicateCheckGoal),
-		list__append(LookupPrefixGoals, [DuplicateCheckGoal],
-			LookupCheckGoals)
+				SuccName ++ ");\n",
+		AssignSuccessCodeStr =
+			"\t" ++ success_indicator_name ++ " = " ++
+				SuccName ++ ";\n",
+		PreStr = LookupDeclCodeStr ++ SaveDeclCode ++ GetLookupCodeStr,
+		PostStr = "\tif (" ++ SuccName ++ ") {\n" ++
+			CreateSaveCode ++ "\t}\n" ++
+			AssignSuccessCodeStr,
+		generate_foreign_proc(DuplCheckPredName, semidet,
+			tabling_c_attributes, Args, LookupForeignArgs,
+			PreStr, DuplCheckCodeStr, PostStr, yes(impure), [],
+			ModuleInfo, Context, DuplicateCheckSaveGoal),
+		list__append(LookupPrefixGoals, [DuplicateCheckSaveGoal],
+			Goals)
 	;
 		TablingViaExtraArgs = no,
-		generate_call(PredName, semidet, [AnswerTableTipVar],
+		generate_call(DuplCheckPredName, semidet, [AnswerTableTipVar],
 			yes(impure), [], ModuleInfo, Context,
 			DuplicateCheckGoal),
 		list__append([GetAnswerTableGoal | LookupAnswerGoals],
-			[DuplicateCheckGoal], LookupCheckGoals)
-	),
-	CreatePredName = "table_mm_create_answer_block",
-	ShortcutPredName = "table_mm_fill_answer_block_shortcut",
-	generate_all_save_goals(NumberedSaveVars, TableVar, subgoal_type,
-		BlockSize, CreatePredName, ShortcutPredName, Context,
-		!VarTypes, !VarSet, !TableInfo, SaveGoals),
-	list__append(LookupCheckGoals, SaveGoals, Goals).
+			[DuplicateCheckGoal], LookupCheckGoals),
+		list__append(LookupCheckGoals, SaveGoals, Goals)
+	).
 
 	% Generate a save goal for the given variables.
 
 :- pred generate_all_save_goals(assoc_list(prog_var, int)::in,
-	prog_var::in, (type)::in, int::in, string::in, string::in,
+	prog_var::in, (type)::in, string::in, int::in, string::in, string::in,
 	term__context::in, vartypes::in, vartypes::out,
 	prog_varset::in, prog_varset::out, table_info::in, table_info::out,
-	list(hlds_goal)::out) is det.
+	list(hlds_goal)::out, string::out, string::out) is det.
 
-generate_all_save_goals(NumberedSaveVars, BaseVar, BaseVarType, BlockSize,
-		CreatePredName, ShortcutPredName, Context, !VarTypes, !VarSet,
-		!TableInfo, Goals) :-
+generate_all_save_goals(NumberedSaveVars, BaseVar, BaseVarType, BaseVarName,
+		BlockSize, CreatePredName, ShortcutPredName, Context,
+		!VarTypes, !VarSet, !TableInfo, Goals,
+		SaveDeclCodeStr, CreateSaveCodeStr) :-
 	generate_new_table_var("AnswerBlock", answer_block_type,
 		!VarTypes, !VarSet, AnswerBlockVar),
 	generate_save_goals(NumberedSaveVars, AnswerBlockVar, Context,
@@ -1630,25 +1682,25 @@
 	tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
 	(
 		TablingViaExtraArgs = yes,
-		BaseVarName = base_name,
 		TableArg = foreign_arg(BaseVar, yes(BaseVarName - in_mode),
 			BaseVarType),
 		Args = [TableArg],
 		SaveDeclCodeStr = "\tMR_AnswerBlock " ++
-			answer_block_name ++ ";\n" ++
+			answer_block_name ++ ";\n",
+		CreateCodeStr =
 			"\tMR_" ++ CreatePredName ++ "(" ++
 			BaseVarName ++ ", " ++
 			int_to_string(BlockSize) ++ ", " ++
-			answer_block_name ++ ");\n" ++
-			SaveCodeStr,
-		ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
+				answer_block_name ++ ");\n",
+		CreateSaveCodeStr = CreateCodeStr ++ SaveCodeStr,
+		ShortcutStr =
+			"\tMR_" ++ ShortcutPredName ++ "(" ++
 			BaseVarName ++ ");\n",
 		generate_foreign_proc(ShortcutPredName, det,
 			tabling_c_attributes, Args, SaveArgs,
-			SaveDeclCodeStr, ShortcutStr, "", yes(impure),
-			[], ModuleInfo, Context, ShortcutGoal),
-		list__append(SavePrefixGoals, [ShortcutGoal],
-			Goals)
+			SaveDeclCodeStr ++ CreateSaveCodeStr, ShortcutStr, "",
+			yes(impure), [], ModuleInfo, Context, ShortcutGoal),
+		list__append(SavePrefixGoals, [ShortcutGoal], Goals)
 	;
 		TablingViaExtraArgs = no,
 		gen_int_construction("BlockSize", BlockSize, !VarTypes,
@@ -1658,7 +1710,9 @@
 			yes(impure), ground_vars([AnswerBlockVar]),
 			ModuleInfo, Context, CreateAnswerBlockGoal),
 		Goals = [BlockSizeVarUnifyGoal, CreateAnswerBlockGoal |
-			SaveGoals]
+			SaveGoals],
+		SaveDeclCodeStr = "",
+		CreateSaveCodeStr = ""
 	).
 
 %-----------------------------------------------------------------------------%
@@ -1700,7 +1754,7 @@
 		Context, !VarTypes, !VarSet, !TableInfo, Goals,
 		Args, PrefixGoals, CodeStr) :-
 	ModuleInfo = !.TableInfo ^ table_module_info,
-	Name = "save_arg" ++ int_to_string(Offset),
+	Name = arg_name(Offset),
 	ForeignArg = foreign_arg(Var, yes(Name - in_mode), Type),
 	( type_util__type_is_io_state(Type) ->
 		SavePredName = "table_save_io_state_answer",
@@ -2352,6 +2406,7 @@
 :- func status_name = string.
 :- func answer_block_name = string.
 :- func success_indicator_name = string.
+:- func arg_name(int) = string.
 
 pred_table_name = "pred_table".
 cur_table_node_name = "cur_node".
@@ -2362,6 +2417,7 @@
 status_name = "status".
 answer_block_name = "answerblock".
 success_indicator_name = "SUCCESS_INDICATOR".
+arg_name(VarSeqNum) = "arg" ++ int_to_string(VarSeqNum).
 
 %-----------------------------------------------------------------------------%
 
cvs server: Diffing compiler/notes
cvs server: Diffing debian
cvs server: Diffing deep_profiler
cvs server: Diffing deep_profiler/notes
cvs server: Diffing doc
cvs server: Diffing extras
cvs server: Diffing extras/aditi
cvs server: Diffing extras/cgi
cvs server: Diffing extras/complex_numbers
cvs server: Diffing extras/complex_numbers/samples
cvs server: Diffing extras/complex_numbers/tests
cvs server: Diffing extras/concurrency
cvs server: Diffing extras/curs
cvs server: Diffing extras/curs/samples
cvs server: Diffing extras/curses
cvs server: Diffing extras/curses/sample
cvs server: Diffing extras/dynamic_linking
cvs server: Diffing extras/error
cvs server: Diffing extras/graphics
cvs server: Diffing extras/graphics/mercury_glut
cvs server: Diffing extras/graphics/mercury_opengl
cvs server: Diffing extras/graphics/mercury_tcltk
cvs server: Diffing extras/graphics/samples
cvs server: Diffing extras/graphics/samples/calc
cvs server: Diffing extras/graphics/samples/gears
cvs server: Diffing extras/graphics/samples/maze
cvs server: Diffing extras/graphics/samples/pent
cvs server: Diffing extras/lazy_evaluation
cvs server: Diffing extras/lex
cvs server: Diffing extras/lex/samples
cvs server: Diffing extras/lex/tests
cvs server: Diffing extras/logged_output
cvs server: Diffing extras/moose
cvs server: Diffing extras/moose/samples
cvs server: Diffing extras/moose/tests
cvs server: Diffing extras/morphine
cvs server: Diffing extras/morphine/non-regression-tests
cvs server: Diffing extras/morphine/scripts
cvs server: Diffing extras/morphine/source
cvs server: Diffing extras/odbc
cvs server: Diffing extras/posix
cvs server: Diffing extras/quickcheck
cvs server: Diffing extras/quickcheck/tutes
cvs server: Diffing extras/references
cvs server: Diffing extras/references/samples
cvs server: Diffing extras/references/tests
cvs server: Diffing extras/stream
cvs server: Diffing extras/trailed_update
cvs server: Diffing extras/trailed_update/samples
cvs server: Diffing extras/trailed_update/tests
cvs server: Diffing extras/xml
cvs server: Diffing extras/xml/samples
cvs server: Diffing java
cvs server: Diffing java/runtime
cvs server: Diffing library
cvs server: Diffing profiler
cvs server: Diffing robdd
cvs server: Diffing runtime
cvs server: Diffing runtime/GETOPT
cvs server: Diffing runtime/machdeps
cvs server: Diffing samples
cvs server: Diffing samples/c_interface
cvs server: Diffing samples/c_interface/c_calls_mercury
cvs server: Diffing samples/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/c_interface/mercury_calls_c
cvs server: Diffing samples/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/c_interface/mercury_calls_fortran
cvs server: Diffing samples/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/diff
cvs server: Diffing samples/muz
cvs server: Diffing samples/rot13
cvs server: Diffing samples/solutions
cvs server: Diffing samples/tests
cvs server: Diffing samples/tests/c_interface
cvs server: Diffing samples/tests/c_interface/c_calls_mercury
cvs server: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/tests/c_interface/mercury_calls_c
cvs server: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs server: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/tests/diff
cvs server: Diffing samples/tests/muz
cvs server: Diffing samples/tests/rot13
cvs server: Diffing samples/tests/solutions
cvs server: Diffing samples/tests/toplevel
cvs server: Diffing scripts
cvs server: Diffing tests
cvs server: Diffing tests/benchmarks
cvs server: Diffing tests/debugger
cvs server: Diffing tests/debugger/declarative
cvs server: Diffing tests/dppd
cvs server: Diffing tests/general
cvs server: Diffing tests/general/accumulator
cvs server: Diffing tests/general/string_format
cvs server: Diffing tests/general/structure_reuse
cvs server: Diffing tests/grade_subdirs
cvs server: Diffing tests/hard_coded
cvs server: Diffing tests/hard_coded/exceptions
cvs server: Diffing tests/hard_coded/purity
cvs server: Diffing tests/hard_coded/sub-modules
cvs server: Diffing tests/hard_coded/typeclasses
cvs server: Diffing tests/invalid
cvs server: Diffing tests/invalid/purity
cvs server: Diffing tests/misc_tests
cvs server: Diffing tests/mmc_make
cvs server: Diffing tests/mmc_make/lib
cvs server: Diffing tests/recompilation
cvs server: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.31
diff -u -b -r1.31 Mmakefile
--- tests/tabling/Mmakefile	7 Jun 2004 09:07:22 -0000	1.31
+++ tests/tabling/Mmakefile	21 Jun 2004 03:29:24 -0000
@@ -37,6 +37,8 @@
 	generator_in_commit \
 	mday \
 	repeat \
+	rotate \
+	rotate2 \
 	seq \
 	seq2 \
 	seq3 \
Index: tests/tabling/rotate.exp
===================================================================
RCS file: tests/tabling/rotate.exp
diff -N tests/tabling/rotate.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/rotate.exp	21 Jun 2004 03:29:24 -0000
@@ -0,0 +1,60 @@
+rotations(3, 2, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+	soln 1: [40, 50, 10, 20, 30]
+
+rotations(3, 2, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+	soln 1: [40, 50, 10, 20, 30]
+
+rotations(3, 2, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["forty", "fifty", "ten", "twenty", "thirty"]
+	soln 1: ["thirty", "forty", "fifty", "ten", "twenty"]
+
+rotations(3, 2, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[3, 0], [4, 0], [5, 0], [1, 0], [2, 0]]
+	soln 1: [[4, 0], [5, 0], [1, 0], [2, 0], [3, 0]]
+
+rotations(3, 2, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3], [1, 2, 3, 4], [1], [1, 2]]
+	soln 1: [[1, 2, 3, 4], [1], [1, 2], [1, 2, 3]]
+
+rotations(3, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [40, 50, 10, 20, 30]
+
+rotations(3, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [40, 50, 10, 20, 30]
+
+rotations(3, 1, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["forty", "fifty", "ten", "twenty", "thirty"]
+
+rotations(3, 1, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[4, 0], [5, 0], [1, 0], [2, 0], [3, 0]]
+
+rotations(3, 1, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3, 4], [1], [1, 2], [1, 2, 3]]
+
+rotations(2, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+
+rotations(2, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+
+rotations(2, 1, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["thirty", "forty", "fifty", "ten", "twenty"]
+
+rotations(2, 1, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[3, 0], [4, 0], [5, 0], [1, 0], [2, 0]]
+
+rotations(2, 1, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3], [1, 2, 3, 4], [1], [1, 2]]
+
+rotations(2, 0, [10, 20, 30, 40, 50]) =
+
+rotations(2, 0, [10, 20, 30, 40, 50]) =
+
+rotations(2, 0, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+
+rotations(2, 0, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+
+rotations(2, 0, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+
Index: tests/tabling/rotate.m
===================================================================
RCS file: tests/tabling/rotate.m
diff -N tests/tabling/rotate.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/rotate.m	21 Jun 2004 03:29:24 -0000
@@ -0,0 +1,81 @@
+% This test case checks the correctness of the code that saves and restores
+% answers of different types, including both builtin and user-defined types.
+
+:- module rotate.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module std_util, int, list, set.
+
+main(!IO) :-
+	testgroup(3, 2, !IO),
+	testgroup(3, 1, !IO),
+	testgroup(2, 1, !IO),
+	testgroup(2, 0, !IO).
+
+:- pred testgroup(int::in, int::in, io::di, io::uo) is det.
+
+testgroup(E, R, !IO) :-
+	test(E, R, [10, 20, 30, 40, 50], !IO),
+	test(E, R, [10, 20, 30, 40, 50], !IO),
+	test(E, R, ["ten", "twenty", "thirty", "forty", "fifty"], !IO),
+	test(E, R, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]], !IO),
+	test(E, R, [set_func([1]), set_func([1, 2]),
+		set_func([1, 2, 3]), set_func([1, 2, 3, 4])], !IO).
+
+:- pred test(int::in, int::in, list(T)::in, io::di, io::uo) is det.
+
+test(NumElements, NumRotations, BaseList, !IO) :-
+	solutions(rotations(NumElements, NumRotations, BaseList), Solns),
+	io__write_string("rotations(", !IO),
+	io__write_int(NumElements, !IO),
+	io__write_string(", ", !IO),
+	io__write_int(NumRotations, !IO),
+	io__write_string(", ", !IO),
+	io__write(BaseList, !IO),
+	io__write_string(") =\n", !IO),
+	write_solns(Solns, 0, !IO),
+	io__write_string("\n", !IO).
+
+:- pred rotations(int::in, int::in, list(T)::in, list(T)::out) is nondet.
+:- pragma minimal_model(rotations/4).
+
+rotations(NumElements, NumRotations, In, Out) :-
+	NumRotations > 0,
+	(
+		rotate(NumElements, In, Out)
+	;
+		rotations(NumElements - 1, NumRotations - 1, In, Out)
+	).
+
+:- pred rotate(int::in, list(T)::in, list(T)::out) is semidet.
+
+rotate(N, In, Out) :-
+	list__split_list(N, In, Start, End),
+	list__append(End, Start, Out).
+
+:- func set_func(list(T)) = set(T).
+
+set_func(List) = set__list_to_set(List).
+
+:- pred write_solns(list(list(T))::in, int::in, io::di, io::uo) is det.
+
+write_solns([], _, !IO).
+write_solns([Soln | Solns], N, !IO) :-
+	write_soln(Soln, N, !IO),
+	write_solns(Solns, N + 1, !IO).
+
+:- pred write_soln(list(T)::in, int::in, io::di, io::uo) is det.
+
+write_soln(Soln, Seq, !IO) :-
+	io__write_string("\tsoln ", !IO),
+	io__write_int(Seq, !IO),
+	io__write_string(": ", !IO),
+	io__write(Soln, !IO),
+	io__write_string("\n", !IO).
Index: tests/tabling/rotate2.exp
===================================================================
RCS file: tests/tabling/rotate2.exp
diff -N tests/tabling/rotate2.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/rotate2.exp	21 Jun 2004 03:29:24 -0000
@@ -0,0 +1,60 @@
+rotations(3, 2, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+	soln 1: [40, 50, 10, 20, 30]
+
+rotations(3, 2, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+	soln 1: [40, 50, 10, 20, 30]
+
+rotations(3, 2, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["forty", "fifty", "ten", "twenty", "thirty"]
+	soln 1: ["thirty", "forty", "fifty", "ten", "twenty"]
+
+rotations(3, 2, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[3, 0], [4, 0], [5, 0], [1, 0], [2, 0]]
+	soln 1: [[4, 0], [5, 0], [1, 0], [2, 0], [3, 0]]
+
+rotations(3, 2, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3], [1, 2, 3, 4], [1], [1, 2]]
+	soln 1: [[1, 2, 3, 4], [1], [1, 2], [1, 2, 3]]
+
+rotations(3, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [40, 50, 10, 20, 30]
+
+rotations(3, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [40, 50, 10, 20, 30]
+
+rotations(3, 1, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["forty", "fifty", "ten", "twenty", "thirty"]
+
+rotations(3, 1, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[4, 0], [5, 0], [1, 0], [2, 0], [3, 0]]
+
+rotations(3, 1, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3, 4], [1], [1, 2], [1, 2, 3]]
+
+rotations(2, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+
+rotations(2, 1, [10, 20, 30, 40, 50]) =
+	soln 0: [30, 40, 50, 10, 20]
+
+rotations(2, 1, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+	soln 0: ["thirty", "forty", "fifty", "ten", "twenty"]
+
+rotations(2, 1, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+	soln 0: [[3, 0], [4, 0], [5, 0], [1, 0], [2, 0]]
+
+rotations(2, 1, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+	soln 0: [[1, 2, 3], [1, 2, 3, 4], [1], [1, 2]]
+
+rotations(2, 0, [10, 20, 30, 40, 50]) =
+
+rotations(2, 0, [10, 20, 30, 40, 50]) =
+
+rotations(2, 0, ["ten", "twenty", "thirty", "forty", "fifty"]) =
+
+rotations(2, 0, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]]) =
+
+rotations(2, 0, [[1], [1, 2], [1, 2, 3], [1, 2, 3, 4]]) =
+
Index: tests/tabling/rotate2.m
===================================================================
RCS file: tests/tabling/rotate2.m
diff -N tests/tabling/rotate2.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/tabling/rotate2.m	21 Jun 2004 03:29:24 -0000
@@ -0,0 +1,127 @@
+% This test case checks the correctness of the code that saves and restores
+% answers for a predicate with multiple arguments (in this case, do_rotate).
+
+:- module rotate2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module std_util, int, list, set.
+
+main(!IO) :-
+	testgroup(3, 2, !IO),
+	testgroup(3, 1, !IO),
+	testgroup(2, 1, !IO),
+	testgroup(2, 0, !IO).
+
+:- pred testgroup(int::in, int::in, io::di, io::uo) is det.
+
+testgroup(E, R, !IO) :-
+	test(E, R, [10, 20, 30, 40, 50], !IO),
+	test(E, R, [10, 20, 30, 40, 50], !IO),
+	test(E, R, ["ten", "twenty", "thirty", "forty", "fifty"], !IO),
+	test(E, R, [[1, 0], [2, 0], [3, 0], [4, 0], [5, 0]], !IO),
+	test(E, R, [set_func([1]), set_func([1, 2]),
+		set_func([1, 2, 3]), set_func([1, 2, 3, 4])], !IO).
+
+:- pred test(int::in, int::in, list(T)::in, io::di, io::uo) is det.
+
+test(NumElements, NumRotations, BaseList, !IO) :-
+	solutions(rotations(NumElements, NumRotations, BaseList), Solns),
+	io__write_string("rotations(", !IO),
+	io__write_int(NumElements, !IO),
+	io__write_string(", ", !IO),
+	io__write_int(NumRotations, !IO),
+	io__write_string(", ", !IO),
+	io__write(BaseList, !IO),
+	io__write_string(") =\n", !IO),
+	write_solns(Solns, 0, !IO),
+	io__write_string("\n", !IO).
+
+:- pred rotations(int::in, int::in, list(T)::in, list(T)::out) is nondet.
+:- pragma minimal_model(rotations/4).
+
+rotations(NumElements, NumRotations, In, Out) :-
+	NumRotations > 0,
+	(
+		test_rotate(NumElements, In, Out)
+	;
+		rotations(NumElements - 1, NumRotations - 1, In, Out)
+	).
+
+:- pred test_rotate(int::in, list(T)::in, list(T)::out) is semidet.
+
+test_rotate(N, In, Out) :-
+	do_rotate(N, In, M1, M2, M3, Rest),
+	(
+		M3 = yes(E3),
+		L3 = [E3 | Rest]
+	;
+		M3 = no,
+		L3 = Rest
+	),
+	(
+		M2 = yes(E2),
+		L2 = [E2 | L3]
+	;
+		M2 = no,
+		L2 = L3
+	),
+	(
+		M1 = yes(E1),
+		L1 = [E1 | L2]
+	;
+		M1 = no,
+		L1 = L2
+	),
+	Out = L1.
+
+:- pred do_rotate(int::in, list(T)::in,
+	maybe(T)::out, maybe(T)::out, maybe(T)::out, list(T)::out) is semidet.
+
+do_rotate(N, In, M1, M2, M3, Rest) :-
+	rotate(N, In, Out),
+	(
+		Out = [],
+		M1 = no, M2 = no, M3 = no, Rest = []
+	;
+		Out = [E1],
+		M1 = yes(E1), M2 = no, M3 = no, Rest = []
+	;
+		Out = [E1, E2],
+		M1 = yes(E1), M2 = yes(E2), M3 = no, Rest = []
+	;
+		Out = [E1, E2, E3 | Rest],
+		M1 = yes(E1), M2 = yes(E2), M3 = yes(E3)
+	).
+
+:- pred rotate(int::in, list(T)::in, list(T)::out) is semidet.
+
+rotate(N, In, Out) :-
+	list__split_list(N, In, Start, End),
+	list__append(End, Start, Out).
+
+:- func set_func(list(T)) = set(T).
+
+set_func(List) = set__list_to_set(List).
+
+:- pred write_solns(list(list(T))::in, int::in, io::di, io::uo) is det.
+
+write_solns([], _, !IO).
+write_solns([Soln | Solns], N, !IO) :-
+	write_soln(Soln, N, !IO),
+	write_solns(Solns, N + 1, !IO).
+
+:- pred write_soln(list(T)::in, int::in, io::di, io::uo) is det.
+
+write_soln(Soln, Seq, !IO) :-
+	io__write_string("\tsoln ", !IO),
+	io__write_int(Seq, !IO),
+	io__write_string(": ", !IO),
+	io__write(Soln, !IO),
+	io__write_string("\n", !IO).
cvs server: Diffing tests/term
cvs server: Diffing tests/valid
cvs server: Diffing tests/warnings
cvs server: Diffing tools
cvs server: Diffing trace
cvs server: Diffing util
cvs server: Diffing vim
cvs server: Diffing vim/after
cvs server: Diffing vim/ftplugin
cvs server: Diffing vim/syntax
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list