[m-rev.] diff: tabling via extra args (part 4 of 4)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jun 7 19:04:40 AEST 2004
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.86
diff -u -b -r1.86 store_alloc.m
--- compiler/store_alloc.m 10 Apr 2004 10:33:02 -0000 1.86
+++ compiler/store_alloc.m 7 Jun 2004 08:49:55 -0000
@@ -216,18 +216,17 @@
store_alloc_in_goal(Goal0, Goal, !Liveness, !LastLocns,
ResumeVars0, StoreAllocInfo).
-store_alloc_in_goal_2(generic_call(A, B, C, D), generic_call(A, B, C, D),
+store_alloc_in_goal_2(Goal @ generic_call(_, _, _, _), Goal,
!Liveness, !LastLocns, _, _, _).
-store_alloc_in_goal_2(call(A, B, C, D, E, F), call(A, B, C, D, E, F),
+store_alloc_in_goal_2(Goal @ call(_, _, _, _, _, _), Goal,
!Liveness, !LastLocns, _, _, _).
-store_alloc_in_goal_2(unify(A, B, C, D, E), unify(A, B, C, D, E),
+store_alloc_in_goal_2(Goal @ unify(_, _, _, _, _), Goal,
!Liveness, !LastLocns, _, _, _).
-store_alloc_in_goal_2(foreign_proc(A, B, C, D, E, F, G),
- foreign_proc(A, B, C, D, E, F, G), !Liveness, !LastLocns,
- _, _, _).
+store_alloc_in_goal_2(Goal @ foreign_proc(_, _, _, _, _, _), Goal,
+ !Liveness, !LastLocns, _, _, _).
store_alloc_in_goal_2(shorthand(_), _, _, _, _, _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.31
diff -u -b -r1.31 stratify.m
--- compiler/stratify.m 24 Oct 2003 06:17:49 -0000 1.31
+++ compiler/stratify.m 7 Jun 2004 08:49:55 -0000
@@ -189,8 +189,7 @@
WholeScc, ThisPredProcId, Error, Module0, Module) -->
first_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
Error, Module0, Module).
-first_order_check_goal(foreign_proc(_Attributes, CPred,
- CProc, _, _, _, _),
+first_order_check_goal(foreign_proc(_Attributes, CPred, CProc, _, _, _),
GoalInfo, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module) -->
(
@@ -346,7 +345,7 @@
ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
higher_order_check_goal(Goal, GoalInfo, yes, WholeScc, ThisPredProcId,
HighOrderLoops, Error, Module0, Module).
-higher_order_check_goal(foreign_proc(_IsRec, _, _, _, _, _, _),
+higher_order_check_goal(foreign_proc(_IsRec, _, _, _, _, _),
_GoalInfo, _Negated, _WholeScc, _ThisPredProcId, _HighOrderLoops,
_, Module, Module) --> [].
higher_order_check_goal(unify(_Var, _RHS, _Mode, _Uni, _Context), _GoalInfo,
@@ -827,7 +826,7 @@
CallsHO) :-
check_goal1(Goal, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
-check_goal1(foreign_proc(_Attrib, _CPred, _CProc, _, _, _, _),
+check_goal1(foreign_proc(_Attrib, _CPred, _CProc, _, _, _),
Calls, Calls, HasAT, HasAT, CallsHO, CallsHO).
check_goal1(shorthand(_), _, _, _, _, _, _) :-
@@ -913,8 +912,7 @@
get_called_procs(Goal, Calls0, Calls).
get_called_procs(not(Goal - _GoalInfo), Calls0, Calls) :-
get_called_procs(Goal, Calls0, Calls).
-get_called_procs(foreign_proc(_Attrib, _CPred, _CProc,
- _, _, _, _), Calls, Calls).
+get_called_procs(foreign_proc(_Attrib, _CPred, _CProc, _, _, _), Calls, Calls).
get_called_procs(shorthand(_), _, _) :-
% these should have been expanded out by now
error("get_called_procs: unexpected shorthand").
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.103
diff -u -b -r1.103 switch_detection.m
--- compiler/switch_detection.m 20 Feb 2004 01:58:50 -0000 1.103
+++ compiler/switch_detection.m 7 Jun 2004 08:49:55 -0000
@@ -217,7 +217,7 @@
switch(Var, CanFail, Cases0), switch(Var, CanFail, Cases)) :-
detect_switches_in_cases(ModuleInfo, VarTypes, InstMap, Cases0, Cases).
-detect_switches_in_goal_2(_, _, _, _, Goal @ foreign_proc(_, _, _, _, _, _, _),
+detect_switches_in_goal_2(_, _, _, _, Goal @ foreign_proc(_, _, _, _, _, _),
Goal).
detect_switches_in_goal_2(_, _, _, _, shorthand(_), _) :-
% these should have been expanded out by now
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.61
diff -u -b -r1.61 table_gen.m
--- compiler/table_gen.m 31 May 2004 04:12:54 -0000 1.61
+++ compiler/table_gen.m 7 Jun 2004 08:49:55 -0000
@@ -4,7 +4,7 @@
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
-% Main authors: ohutch, zs.
+% Main authors: zs, ohutch.
%
% This module transforms HLDS code to implement loop detection, memoing,
% minimal model evaluation, or I/O idempotence. The transformation involves
@@ -266,7 +266,7 @@
subgoal_may_call_mercury_attribute(Goal, MayCallMercuryAttr) :-
some [SubGoal,Attrs] (
goal_contains_goal(Goal, SubGoal),
- SubGoal = foreign_proc(Attrs, _, _, _, _, _, _) - _,
+ SubGoal = foreign_proc(Attrs, _, _, _, _, _) - _,
MayCallMercuryAttr = may_call_mercury(Attrs)
).
@@ -282,7 +282,7 @@
subgoal_tabled_for_io_attribute(Goal, TabledForIoAttr) :-
some [SubGoal,Attrs] (
goal_contains_goal(Goal, SubGoal),
- SubGoal = foreign_proc(Attrs, _,_,_,_,_,_) - _,
+ SubGoal = foreign_proc(Attrs, _, _, _, _, _) - _,
TabledForIoAttr = tabled_for_io(Attrs),
\+ TabledForIoAttr = not_tabled_for_io
).
@@ -531,7 +531,7 @@
generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
!VarTypes, !VarSet, ActiveGoal),
- generate_call("table_loop_mark_as_inactive", [TableTipVar], det,
+ generate_call("table_loop_mark_as_inactive", det, [TableTipVar],
yes(impure), [], ModuleInfo, Context, MarkInactiveGoal),
determinism_to_code_model(Detism, CodeModel),
@@ -600,8 +600,8 @@
% impure table_memo_setup(T, Status),
% (
% Status = memo_det_succeeded,
-% semipure table_memo_get_answer_block(T, AnswerBlock),
-% semipure table_restore_int_answer(AnswerBlock, 0, B)
+% semipure table_memo_get_answer_block(T, Block),
+% semipure table_restore_int_answer(Block, 0, B)
% ;
% Status = memo_det_active,
% error("detected infinite recursion in ...")
@@ -609,8 +609,8 @@
% Status = memo_det_inactive,
% % status has been changed to active by the setup predicate
% <original code>
-% impure table_memo_create_answer_block(T, 1, AnswerBlock),
-% impure table_save_int_answer(AnswerBlock, 0, B)
+% impure table_memo_create_answer_block(T, 1, Block),
+% impure table_save_int_answer(Block, 0, B)
% ).
%
% Example of transformation for model_semi memo:
@@ -631,8 +631,8 @@
% fail
% ;
% Status = memo_semi_succeeded,
-% semipure table_memo_get_answer_block(T, AnswerBlock),
-% semipure table_restore_int_answer(AnswerBlock, 0, B)
+% semipure table_memo_get_answer_block(T, Block),
+% semipure table_restore_int_answer(Block, 0, B)
% ;
% Status = memo_semi_active,
% error("detected infinite recursion in ...")
@@ -643,9 +643,8 @@
% <original code>, with B replaced by C
% then
% B = C,
-% impure table_memo_create_answer_block(T, 1,
-% AnswerBlock),
-% impure table_save_int_answer(AnswerBlock, 0, B)
+% impure table_memo_create_answer_block(T, 1, Block),
+% impure table_save_int_answer(Block, 0, B)
% else
% impure table_memo_mark_as_failed(T),
% fail
@@ -699,8 +698,9 @@
list__length(NumberedOutputVars, BlockSize),
generate_memo_save_goals(NumberedOutputVars, TableTipVar, BlockSize,
Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
- generate_memo_restore_goal(NumberedOutputVars, TableTipVar, ModuleInfo,
- Context, !VarTypes, !VarSet, RestoreAnswerGoal),
+ generate_memo_restore_goal(NumberedOutputVars, OrigInstMapDelta,
+ TableTipVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ RestoreAnswerGoal),
SucceededGoal = RestoreAnswerGoal,
set__list_to_set([TableTipVar | HeadVars], InactiveNonLocals),
@@ -734,12 +734,9 @@
det, impure, Context, ThenGoalInfo),
ThenGoal = ThenGoalExpr - ThenGoalInfo,
- generate_call("table_memo_mark_as_failed", [TableTipVar],
- failure, yes(impure), [], ModuleInfo, Context,
+ generate_call("table_memo_mark_as_failed", failure,
+ [TableTipVar], yes(impure), [], ModuleInfo, Context,
ElseGoal),
- % XXX make table_memo_mark_as_failed have detism failure
- % append_fail(ElseGoal0, ElseGoal),
-
InactiveGoalExpr = if_then_else([], RenamedOrigGoal,
ThenGoal, ElseGoal),
goal_info_init_hide(InactiveNonLocals, InactiveInstmapDelta,
@@ -800,13 +797,14 @@
% (if
% semipure table_io_has_occurred(T)
% then
-% impure table_restore_string_answer(T, 0, B)
+% semipure table_memo_get_answer_block(T, Block),
+% impure table_restore_string_answer(Block, 0, B),
% table_io_copy_io_state(S0, S)
% else
% <original code>
% % Save the answers in the table.
-% impure table_io_create_answer_block(T, 1, AnswerBlock),
-% impure table_save_string_answer(AnswerBlock, 0, B)
+% impure table_io_create_answer_block(T, 1, Block),
+% impure table_save_string_answer(Block, 0, B)
% )
% else
% <original code>
@@ -875,18 +873,16 @@
CounterVar),
generate_new_table_var("StartVar", int_type, !VarTypes, !VarSet,
StartVar),
- generate_call("table_io_in_range", [TableVar, CounterVar, StartVar],
- semidet, yes(impure), [TableVar - ground(shared, none),
- CounterVar - ground(shared, none),
- StartVar - ground(shared, none)],
+ generate_call("table_io_in_range", semidet,
+ [TableVar, CounterVar, StartVar], yes(impure),
+ ground_vars([TableVar, CounterVar, StartVar]),
ModuleInfo, Context, InRangeGoal),
generate_new_table_var("TipVar", trie_node_type, !VarTypes, !VarSet,
TipVar),
- generate_call("table_lookup_insert_start_int",
- [TableVar, StartVar, CounterVar, TipVar],
- det, yes(impure), [TipVar - ground(unique, none)],
- ModuleInfo, Context, LookupGoal),
- generate_call("table_io_has_occurred", [TipVar], semidet,
+ generate_call("table_lookup_insert_start_int", det,
+ [TableVar, StartVar, CounterVar, TipVar], yes(impure),
+ ground_vars([TipVar]), ModuleInfo, Context, LookupGoal),
+ generate_call("table_io_has_occurred", semidet, [TipVar],
yes(semipure), [], ModuleInfo, Context, OccurredGoal),
(
TableDecl = table_io_decl,
@@ -920,8 +916,10 @@
MaybeProcTableInfo = no
),
list__length(NumberedSaveVars, BlockSize),
- generate_memo_restore_goal(NumberedRestoreVars, TipVar, ModuleInfo,
- Context, !VarTypes, !VarSet, RestoreAnswerGoal0),
+ goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
+ generate_memo_restore_goal(NumberedRestoreVars, OrigInstMapDelta,
+ TipVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ RestoreAnswerGoal0),
(
TableIoStates = yes,
RestoreAnswerGoal = RestoreAnswerGoal0
@@ -939,8 +937,8 @@
% never get here.
error("create_new_io_goal: one in / one out violation")
),
- generate_call("table_io_copy_io_state",
- [IoStateAssignFromVar, IoStateAssignToVar], det, no,
+ generate_call("table_io_copy_io_state", det,
+ [IoStateAssignFromVar, IoStateAssignToVar], no,
[IoStateAssignFromVar - ground(clobbered, none),
IoStateAssignToVar - ground(unique, none)],
ModuleInfo, Context, IoStateAssignGoal),
@@ -972,12 +970,12 @@
Unitize = table_io_unitize,
generate_new_table_var("SavedTraceEnabled", int_type,
!VarTypes, !VarSet, SavedTraceEnabledVar),
- generate_call("table_io_left_bracket_unitized_goal",
- [SavedTraceEnabledVar], det, yes(impure),
- [SavedTraceEnabledVar - ground(unique, none)],
+ generate_call("table_io_left_bracket_unitized_goal", det,
+ [SavedTraceEnabledVar], yes(impure),
+ ground_vars([SavedTraceEnabledVar]),
ModuleInfo, Context, LeftBracketGoal),
- generate_call("table_io_right_bracket_unitized_goal",
- [SavedTraceEnabledVar], det, yes(impure), [],
+ generate_call("table_io_right_bracket_unitized_goal", det,
+ [SavedTraceEnabledVar], yes(impure), [],
ModuleInfo, Context, RightBracketGoal),
CallSaveAnswerGoalList = [LeftBracketGoal, OrigGoal,
RightBracketGoal, TableIoDeclGoal | SaveAnswerGoals]
@@ -1047,25 +1045,25 @@
%
% % Look up the input arguments, and set up the table.
% impure table_lookup_insert_int(CT0, A, CT1),
-% impure table_mm_setup(CT1, SubGoal, Status),
+% impure table_mm_setup(CT1, Subgoal, Status),
% (
% Status = complete,
% % Return all the answers from the complete table.
-% semipure table_mm_return_all_nondet(SubGoal, Answer),
-% semipure table_restore_int_answer(Answer, 0, B)
+% semipure table_mm_return_all_nondet(Subgoal, Block),
+% semipure table_restore_int_answer(Block, 0, B)
% ;
% Status = active,
% % Suspend the current computational branch.
% % Resume when the generator has computed some answers.
-% impure table_mm_suspend_consumer(SubGoal, Answer),
-% semipure table_restore_int_answer(Answer, 0, B)
+% impure table_mm_suspend_consumer(Subgoal, Block),
+% semipure table_restore_int_answer(Block, 0, B)
% ;
% Status = inactive,
% (
% <original code>,
%
% % Check for duplicate answers.
-% semipure table_mm_get_answer_table(SubGoal, AT0),
+% semipure table_mm_get_answer_table(Subgoal, AT0),
% impure table_lookup_insert_int(AT0, B, AT1),
% % Fail if the answer is already in the table;
% % otherwise, put it into the table.
@@ -1077,7 +1075,7 @@
% ;
% % Mark this subgoal as completely evaluated,
% % modulo any dependencies on other subgoals.
-% impure table_mm_completion(SubGoal),
+% impure table_mm_completion(Subgoal),
% fail
% )
% ).
@@ -1090,7 +1088,7 @@
table_gen__create_new_mm_goal(Detism, OrigGoal, PredId, ProcId,
HeadVars, InputVars, OutputVars, !VarTypes, !VarSet,
- !TableInfo, TableTipVar, Goal, Steps) :-
+ !TableInfo, SubgoalVar, Goal, Steps) :-
% even if the original goal doesn't use all of the headvars,
% the code generated by the tabling transformation does,
% so we need to compute the nonlocals from the headvars rather
@@ -1103,16 +1101,17 @@
ModuleInfo = !.TableInfo ^ table_module_info,
allocate_slot_numbers(OutputVars, 0, NumberedOutputVars),
list__length(NumberedOutputVars, BlockSize),
- generate_non_call_table_lookup_goal(InputVars, PredId, ProcId, Context,
- !VarTypes, !VarSet, !TableInfo, TableTipVar, SubgoalVar,
- StatusVar, LookUpGoal, Steps),
+ generate_mm_call_table_lookup_goal(InputVars, PredId, ProcId, Context,
+ !VarTypes, !VarSet, !TableInfo, SubgoalVar, StatusVar,
+ LookUpGoal, Steps),
generate_mm_save_goals(NumberedOutputVars, SubgoalVar, BlockSize,
Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
- generate_mm_restore_goal(Detism, NumberedOutputVars, SubgoalVar,
- ModuleInfo, Context, !VarTypes, !VarSet, RestoreAllAnswerGoal),
-
- generate_mm_suspend_goal(NumberedOutputVars, SubgoalVar,
- ModuleInfo, Context, !VarTypes, !VarSet, SuspendGoal),
+ generate_mm_restore_goal(Detism, NumberedOutputVars, OrigInstMapDelta,
+ SubgoalVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ RestoreAllAnswerGoal),
+ generate_mm_suspend_goal(NumberedOutputVars, OrigInstMapDelta,
+ SubgoalVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ SuspendGoal),
MainExpr = conj([OrigGoal | SaveAnswerGoals]),
set__insert(OrigNonLocals, SubgoalVar, MainNonLocals),
@@ -1122,7 +1121,7 @@
MainGoalInfo),
MainGoal = MainExpr - MainGoalInfo,
- generate_call("table_mm_completion", [SubgoalVar], det,
+ generate_call("table_mm_completion", det, [SubgoalVar],
yes(impure), [], ModuleInfo, Context, ResumeGoal0),
append_fail(ResumeGoal0, ResumeGoal),
InactiveExpr = disj([MainGoal, ResumeGoal]),
@@ -1187,14 +1186,6 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen__var_is_io_state(vartypes::in, prog_var::in) is semidet.
-
-table_gen__var_is_io_state(VarTypes, Var) :-
- map__lookup(VarTypes, Var, VarType),
- type_util__type_is_io_state(VarType).
-
-%-----------------------------------------------------------------------------%
-
:- pred generate_gen_proc_table_info(table_info::in, list(table_trie_step)::in,
list(prog_var)::in, list(prog_var)::in, proc_table_info::out) is det.
@@ -1212,59 +1203,8 @@
%-----------------------------------------------------------------------------%
-:- pred generate_table_lookup_goals(list(prog_var)::in, string::in, int::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) is det.
-
-generate_table_lookup_goals([], _, _, _, !TableVar, !VarTypes, !VarSet,
- !TableInfo, [], []).
-generate_table_lookup_goals([Var | Vars], Prefix, VarSeqNum, Context,
- !TableVar, !VarTypes, !VarSet, !TableInfo,
- [Goal | RestGoals], [Step | Steps]) :-
- ModuleInfo = !.TableInfo ^ table_module_info,
- map__lookup(!.VarTypes, Var, VarType),
- classify_type(ModuleInfo, VarType) = TypeCat,
- gen_lookup_call_for_type(TypeCat, VarType, Var, Prefix, VarSeqNum,
- Context, !VarTypes, !VarSet, !TableInfo, !TableVar,
- Goal, Step),
- generate_table_lookup_goals(Vars, Prefix, VarSeqNum + 1, Context,
- !TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps).
-
-%-----------------------------------------------------------------------------%
-
-:- type loopcheck_or_memo
- ---> loopcheck
- ; memo.
-
-:- pred generate_get_table_goal(pred_id::in, proc_id::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- prog_var::out, hlds_goal::out) is det.
-
-generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet, PredTableVar,
- Goal) :-
- generate_new_table_var("PredTable", trie_node_type,
- !VarTypes, !VarSet, PredTableVar),
- ConsId = tabling_pointer_const(PredId, ProcId),
- make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
- goal_info_add_feature(GoalInfo0, impure, GoalInfo),
- Goal = GoalExpr - GoalInfo.
-
-:- pred generate_call_table_lookup_goals(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,
- list(hlds_goal)::out, list(table_trie_step)::out) is det.
-
-generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
- !VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps) :-
- generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet,
- PredTableVar, GetTableGoal),
- generate_table_lookup_goals(Vars, "CallTableNode", 1, Context,
- PredTableVar, TableTipVar, !VarTypes, !VarSet,
- !TableInfo, LookupGoals, Steps),
- Goals = [GetTableGoal | LookupGoals].
+ % Generate a goal for doing lookups in call tables for
+ % 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,
@@ -1277,47 +1217,174 @@
TableTipVar, StatusVar, Goal, Steps) :-
generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
!VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
- Steps),
+ Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
+ LookupCodeStr),
generate_new_table_var("Status", StatusType, !VarTypes, !VarSet,
StatusVar),
ModuleInfo = !.TableInfo ^ table_module_info,
- generate_call(SetupPred, [TableTipVar, StatusVar],
- det, yes(impure), ground_vars([StatusVar]),
+ tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+ (
+ TablingViaExtraArgs = yes,
+ PredTableVarName = pred_table_name,
+ TableTipVarName = table_tip_node_name,
+ StatusVarName = status_name,
+ PredTableArg = foreign_arg(PredTableVar,
+ yes(PredTableVarName - in_mode), trie_node_type),
+ TableTipArg = foreign_arg(TableTipVar,
+ yes(TableTipVarName - out_mode), trie_node_type),
+ StatusArg = foreign_arg(StatusVar,
+ yes(StatusVarName - out_mode), StatusType),
+ MainPredCodeStr = "\tMR_" ++ SetupPred ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ StatusVarName ++ ");\n",
+ (
+ Vars = [_ | _],
+ Args = [PredTableArg, TableTipArg, StatusArg],
+ BoundVars = [TableTipVar, StatusVar],
+ CalledPred = SetupPred ++ "_shortcut",
+ TableTipAssignStr = MainPredCodeStr ++
+ "\t" ++ TableTipVarName ++
+ " = " ++ cur_table_node_name ++ ";\n",
+ PredCodeStr = "\tMR_" ++ CalledPred ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ TableTipVarName ++ ", " ++
+ StatusVarName ++ ");\n"
+ ;
+ Vars = [],
+ Args = [PredTableArg, StatusArg],
+ BoundVars = [StatusVar],
+ CalledPred = SetupPred,
+ TableTipAssignStr = "",
+ PredCodeStr = MainPredCodeStr
+ ),
+ LookupDeclCodeStr =
+ "\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
+ "\t" ++ cur_table_node_name ++ " = " ++
+ PredTableVarName ++ ";\n" ++
+ LookupCodeStr ++
+ TableTipAssignStr,
+ generate_foreign_proc(CalledPred, det, tabling_c_attributes,
+ Args, LookupForeignArgs, LookupDeclCodeStr,
+ PredCodeStr, "", yes(impure), ground_vars(BoundVars),
+ ModuleInfo, Context, SetupGoal0),
+ attach_call_table_tip(SetupGoal0, SetupGoal),
+ list__append(LookupPrefixGoals, [SetupGoal], LookupSetupGoals)
+ ;
+ TablingViaExtraArgs = no,
+ generate_call(SetupPred, det, [TableTipVar, StatusVar],
+ yes(impure), ground_vars([StatusVar]),
ModuleInfo, Context, SetupGoal0),
attach_call_table_tip(SetupGoal0, SetupGoal),
- GoalExpr = conj(list__append(LookupGoals, [SetupGoal])),
+ list__append(LookupGoals, [SetupGoal], LookupSetupGoals)
+ ),
+ GoalExpr = conj(LookupSetupGoals),
set__list_to_set([StatusVar, TableTipVar | Vars], NonLocals),
goal_info_init_hide(NonLocals, bind_vars([TableTipVar, StatusVar]),
det, impure, Context, GoalInfo),
Goal = GoalExpr - GoalInfo.
-:- pred generate_non_call_table_lookup_goal(list(prog_var)::in,
+ % 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_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,
- prog_var::out, hlds_goal::out, list(table_trie_step)::out) is det.
+ hlds_goal::out, list(table_trie_step)::out) is det.
-generate_non_call_table_lookup_goal(Vars, PredId, ProcId, Context,
- !VarTypes, !VarSet, !TableInfo,
- TableTipVar, SubgoalVar, StatusVar, Goal, Steps) :-
+generate_mm_call_table_lookup_goal(Vars, PredId, ProcId, Context,
+ !VarTypes, !VarSet, !TableInfo, SubgoalVar, StatusVar,
+ Goal, Steps) :-
generate_call_table_lookup_goals(Vars, PredId, ProcId, Context,
!VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
- Steps),
+ Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
+ LookupCodeStr),
ModuleInfo = !.TableInfo ^ table_module_info,
generate_new_table_var("Subgoal", subgoal_type, !VarTypes, !VarSet,
SubgoalVar),
- generate_new_table_var("Status", mm_status_type,
- !VarTypes, !VarSet, StatusVar),
- generate_call("table_mm_setup", [TableTipVar, SubgoalVar, StatusVar],
- det, yes(impure), ground_vars([SubgoalVar, StatusVar]),
+ generate_new_table_var("Status", mm_status_type, !VarTypes, !VarSet,
+ StatusVar),
+ SetupPred = "table_mm_setup",
+ BoundVars = [SubgoalVar, StatusVar],
+ tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+ (
+ TablingViaExtraArgs = yes,
+ PredTableVarName = pred_table_name,
+ SubgoalVarName = subgoal_name,
+ StatusVarName = status_name,
+ PredTableArg = foreign_arg(PredTableVar,
+ yes(PredTableVarName - in_mode), trie_node_type),
+ SubgoalArg = foreign_arg(SubgoalVar,
+ yes(SubgoalVarName - out_mode), subgoal_type),
+ StatusArg = foreign_arg(StatusVar,
+ yes(StatusVarName - out_mode), mm_status_type),
+ Args = [PredTableArg, SubgoalArg, StatusArg],
+ LookupDeclCodeStr =
+ "\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
+ "\t" ++ cur_table_node_name ++ " = " ++
+ PredTableVarName ++ ";\n" ++
+ LookupCodeStr,
+ PredCodeStr = "\tMR_" ++ SetupPred ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ SubgoalVarName ++ ", " ++
+ StatusVarName ++ ");\n",
+ generate_foreign_proc(SetupPred, det, tabling_c_attributes,
+ Args, LookupForeignArgs, LookupDeclCodeStr,
+ PredCodeStr, "", yes(impure), ground_vars(BoundVars),
ModuleInfo, Context, SetupGoal0),
attach_call_table_tip(SetupGoal0, SetupGoal),
- GoalExpr = conj(list__append(LookupGoals, [SetupGoal])),
- set__list_to_set([StatusVar, TableTipVar, SubgoalVar | Vars],
- NonLocals),
- goal_info_init_hide(NonLocals,
- bind_vars([SubgoalVar, TableTipVar, StatusVar]), det,
- impure, Context, GoalInfo),
+ list__append(LookupPrefixGoals, [SetupGoal], LookupSetupGoals)
+ ;
+ TablingViaExtraArgs = no,
+ generate_call(SetupPred, det,
+ [TableTipVar, SubgoalVar, StatusVar], yes(impure),
+ ground_vars(BoundVars), ModuleInfo, Context,
+ SetupGoal0),
+ attach_call_table_tip(SetupGoal0, SetupGoal),
+ list__append(LookupGoals, [SetupGoal], LookupSetupGoals)
+ ),
+ GoalExpr = conj(LookupSetupGoals),
+ set__list_to_set([StatusVar, SubgoalVar | Vars], NonLocals),
+ goal_info_init_hide(NonLocals, bind_vars([SubgoalVar, StatusVar]),
+ det, impure, Context, GoalInfo),
+ Goal = GoalExpr - GoalInfo.
+
+%-----------------------------------------------------------------------------%
+
+% Utility predicates used when creating call table lookup goals.
+
+:- pred generate_call_table_lookup_goals(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,
+ 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,
+ !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,
+ PredTableVar, TableTipVar, !VarTypes, !VarSet,
+ !TableInfo, LookupGoals, Steps, ForeignArgs,
+ LookupPrefixGoals, CodeStr),
+ Goals = [GetTableGoal | LookupGoals],
+ PrefixGoals = [GetTableGoal | LookupPrefixGoals].
+
+:- pred generate_get_table_goal(pred_id::in, proc_id::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_var::out, hlds_goal::out) is det.
+
+generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet, PredTableVar,
+ Goal) :-
+ generate_new_table_var("PredTable", trie_node_type,
+ !VarTypes, !VarSet, PredTableVar),
+ ConsId = tabling_pointer_const(PredId, ProcId),
+ make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
+ goal_info_add_feature(GoalInfo0, impure, GoalInfo),
Goal = GoalExpr - GoalInfo.
:- pred attach_call_table_tip(hlds_goal::in, hlds_goal::out) is det.
@@ -1327,20 +1394,52 @@
set__insert(Features0, call_table_gen, Features),
goal_info_set_features(GoalInfo0, Features, GoalInfo).
+%-----------------------------------------------------------------------------%
+
+ % Generate a sequence of lookup goals for the given variables.
+ % 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,
+ 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,
+ !TableInfo, [], [], [], [], "").
+generate_table_lookup_goals([Var | Vars], Prefix, VarSeqNum, Context,
+ !TableVar, !VarTypes, !VarSet, !TableInfo, Goals ++ RestGoals,
+ [Step | Steps], ForeignArgs ++ RestForeignArgs,
+ PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
+ ModuleInfo = !.TableInfo ^ table_module_info,
+ map__lookup(!.VarTypes, Var, VarType),
+ classify_type(ModuleInfo, VarType) = TypeCat,
+ 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,
+ !TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps,
+ RestForeignArgs, RestPrefixGoals, RestCodeStr).
+
:- pred gen_lookup_call_for_type(type_category::in, (type)::in,
prog_var::in, string::in, int::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::in, prog_var::out,
- hlds_goal::out, table_trie_step::out) is det.
+ list(hlds_goal)::out, table_trie_step::out,
+ list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
gen_lookup_call_for_type(TypeCat, Type, ArgVar, Prefix, VarSeqNum, Context,
!VarTypes, !VarSet, !TableInfo, TableVar, NextTableVar,
- Goal, Step) :-
+ Goals, Step, ExtraArgs, PrefixGoals, CodeStr) :-
ModuleInfo = !.TableInfo ^ table_module_info,
VarName = Prefix ++ int_to_string(VarSeqNum),
generate_new_table_var(VarName, trie_node_type, !VarTypes, !VarSet,
NextTableVar),
BindNextTableVar = ground_vars([NextTableVar]),
+ ArgName = "input_arg" ++ int_to_string(VarSeqNum),
+ ForeignArg = foreign_arg(ArgVar, yes(ArgName - in_mode), Type),
( TypeCat = enum_type ->
( type_to_ctor_and_args(Type, TypeCtor, _) ->
module_info_types(ModuleInfo, TypeDefnTable),
@@ -1358,16 +1457,20 @@
),
gen_int_construction("RangeVar", EnumRange, !VarTypes,
!VarSet, RangeVar, RangeUnifyGoal),
- generate_call("table_lookup_insert_enum",
+ LookupPredName = "table_lookup_insert_enum",
+ generate_call(LookupPredName, det,
[TableVar, RangeVar, ArgVar, NextTableVar],
- det, yes(impure), BindNextTableVar,
+ yes(impure), BindNextTableVar,
ModuleInfo, Context, LookupGoal),
- set__list_to_set([TableVar, ArgVar], NonLocals),
- goal_info_init_hide(NonLocals,
- bind_vars([NextTableVar]), det, impure,
- Context, GoalInfo),
- Goal = conj([RangeUnifyGoal, LookupGoal]) - GoalInfo,
- Step = table_trie_step_enum(EnumRange)
+ Goals = [RangeUnifyGoal, LookupGoal],
+ Step = table_trie_step_enum(EnumRange),
+ PrefixGoals = [],
+ ExtraArgs = [ForeignArg],
+ CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ int_to_string(EnumRange) ++ ", " ++
+ ArgName ++ ", " ++
+ next_table_node_name ++ ", " ++ ");\n"
;
error("gen_lookup_call_for_type: unexpected enum type")
)
@@ -1384,26 +1487,49 @@
),
make_type_info_var(Type, Context, !VarTypes, !VarSet,
!TableInfo, TypeInfoVar, ExtraGoals),
- generate_call(LookupPredName,
+ generate_call(LookupPredName, det,
[TypeInfoVar, TableVar, ArgVar, NextTableVar],
- det, yes(impure), BindNextTableVar,
+ yes(impure), BindNextTableVar,
ModuleInfo, Context, CallGoal),
- list__append(ExtraGoals, [CallGoal], ConjList),
- CallGoal = _ - GoalInfo,
- conj_list_to_goal(ConjList, GoalInfo, Goal)
+ Goals = ExtraGoals ++ [CallGoal],
+ PrefixGoals = ExtraGoals,
+ TypeInfoArgName = "input_typeinfo" ++
+ int_to_string(VarSeqNum),
+ map__lookup(!.VarTypes, TypeInfoVar, TypeInfoType),
+ ForeignTypeInfoArg = foreign_arg(TypeInfoVar,
+ yes(TypeInfoArgName - in_mode), TypeInfoType),
+ ExtraArgs = [ForeignTypeInfoArg, ForeignArg],
+ CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ TypeInfoArgName ++ ", " ++
+ ArgName ++ ", " ++
+ next_table_node_name ++ ");\n"
;
MaybeCatStringStep = yes(CatString - Step),
string__append("table_lookup_insert_", CatString,
LookupPredName),
- generate_call(LookupPredName,
+ generate_call(LookupPredName, det,
[TableVar, ArgVar, NextTableVar],
- det, yes(impure), BindNextTableVar, ModuleInfo,
- Context, Goal)
+ yes(impure), BindNextTableVar, ModuleInfo,
+ Context, Goal),
+ Goals = [Goal],
+ PrefixGoals = [],
+ ExtraArgs = [ForeignArg],
+ CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ cur_table_node_name ++ ", " ++
+ ArgName ++ ", " ++
+ next_table_node_name ++ ");\n"
)
- ).
+ ),
+ CodeStr = CodeStr0 ++ "\t" ++ cur_table_node_name ++ " = " ++
+ next_table_node_name ++ ";\n".
+
%-----------------------------------------------------------------------------%
+ % Generate a goal for saving the output arguments in an answer block
+ % in memo predicates.
+
:- pred generate_memo_save_goals(assoc_list(prog_var, int)::in,
prog_var::in, int::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
@@ -1413,148 +1539,290 @@
!VarTypes, !VarSet, !TableInfo, Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
( BlockSize > 0 ->
- gen_int_construction("BlockSize", BlockSize, !VarTypes,
- !VarSet, BlockSizeVar, BlockSizeVarUnifyGoal),
- generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
- generate_call("table_memo_create_answer_block",
- [TableVar, BlockSizeVar, AnswerBlockVar], det,
- yes(impure), ground_vars([AnswerBlockVar]),
- ModuleInfo, Context, CreateAnswerBlockGoal),
- generate_save_goals(NumberedSaveVars, AnswerBlockVar, Context,
- !VarTypes, !VarSet, !TableInfo, SaveGoals),
- Goals = [BlockSizeVarUnifyGoal, CreateAnswerBlockGoal |
- SaveGoals]
+ CreatePredName = "table_memo_create_answer_block",
+ ShortcutPredName = "table_memo_fill_answer_block_shortcut",
+ generate_all_save_goals(NumberedSaveVars, TableVar,
+ trie_node_type, BlockSize,
+ CreatePredName, ShortcutPredName, Context,
+ !VarTypes, !VarSet, !TableInfo, Goals)
;
- generate_call("table_memo_mark_as_succeeded", [TableVar],
- det, yes(impure), [], ModuleInfo, Context, Goal),
+ generate_call("table_memo_mark_as_succeeded", det, [TableVar],
+ yes(impure), [], ModuleInfo, Context, Goal),
Goals = [Goal]
).
+ % Generate a goal for saving the output arguments in an answer block
+ % in minimal model predicates.
+
:- pred generate_mm_save_goals(assoc_list(prog_var, int)::in,
prog_var::in, int::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.
-generate_mm_save_goals(NumberedOutputVars, TableVar, BlockSize, Context,
+generate_mm_save_goals(NumberedSaveVars, TableVar, BlockSize, Context,
!VarTypes, !VarSet, !TableInfo, Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
generate_new_table_var("AnswerTableVar", trie_node_type,
!VarTypes, !VarSet, AnswerTableVar),
- generate_call("table_mm_get_answer_table", [TableVar, AnswerTableVar],
- det, yes(semipure), ground_vars([AnswerTableVar]),
+ GetPredName = "table_mm_get_answer_table",
+ generate_call(GetPredName, det, [TableVar, AnswerTableVar],
+ yes(semipure), ground_vars([AnswerTableVar]),
ModuleInfo, Context, GetAnswerTableGoal),
- assoc_list__keys(NumberedOutputVars, OutputVars),
- generate_table_lookup_goals(OutputVars, "AnswerTableNode", 1, Context,
+ assoc_list__keys(NumberedSaveVars, SaveVars),
+ generate_table_lookup_goals(SaveVars, "AnswerTableNode", 1, Context,
AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
- !TableInfo, LookupAnswerGoals, _),
- generate_call("table_mm_answer_is_not_duplicate",
- [AnswerTableTipVar], semidet, yes(impure), [], ModuleInfo,
- Context, DuplicateCheckGoal),
- gen_int_construction("BlockSize", BlockSize, !VarTypes, !VarSet,
- BlockSizeVar, BlockSizeVarUnifyGoal),
+ !TableInfo, LookupAnswerGoals, _, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr),
+ PredName = "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)],
+ LookupDeclCodeStr =
+ "\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
+ "\tMR_" ++ GetPredName ++ "(" ++ SubgoalName ++ ", " ++
+ cur_table_node_name ++ ");\n" ++
+ LookupCodeStr,
+ DuplCheckCodeStr = "\tMR_" ++ PredName ++ "(" ++
+ 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)
+ ;
+ TablingViaExtraArgs = no,
+ generate_call(PredName, 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).
+
+ % 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,
+ 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.
+
+generate_all_save_goals(NumberedSaveVars, BaseVar, BaseVarType, BlockSize,
+ CreatePredName, ShortcutPredName, Context, !VarTypes, !VarSet,
+ !TableInfo, Goals) :-
generate_new_table_var("AnswerBlock", answer_block_type,
!VarTypes, !VarSet, AnswerBlockVar),
- generate_call("table_mm_create_answer_block",
- [TableVar, BlockSizeVar, AnswerBlockVar], det, yes(impure),
- ground_vars([AnswerBlockVar]), ModuleInfo, Context,
- NewAnswerBlockGoal),
- generate_save_goals(NumberedOutputVars, AnswerBlockVar, Context,
- !VarTypes, !VarSet, !TableInfo, SaveGoals),
- list__append([GetAnswerTableGoal | LookupAnswerGoals],
- [DuplicateCheckGoal, BlockSizeVarUnifyGoal, NewAnswerBlockGoal
- | SaveGoals], Goals).
+ generate_save_goals(NumberedSaveVars, AnswerBlockVar, Context,
+ !VarTypes, !VarSet, !TableInfo, SaveGoals,
+ SaveArgs, SavePrefixGoals, SaveCodeStr),
+ ModuleInfo = !.TableInfo ^ table_module_info,
+ 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" ++
+ "\tMR_" ++ CreatePredName ++ "(" ++
+ BaseVarName ++ ", " ++
+ int_to_string(BlockSize) ++ ", " ++
+ answer_block_name ++ ");\n" ++
+ 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)
+ ;
+ TablingViaExtraArgs = no,
+ gen_int_construction("BlockSize", BlockSize, !VarTypes,
+ !VarSet, BlockSizeVar, BlockSizeVarUnifyGoal),
+ generate_call(CreatePredName, det,
+ [BaseVar, BlockSizeVar, AnswerBlockVar],
+ yes(impure), ground_vars([AnswerBlockVar]),
+ ModuleInfo, Context, CreateAnswerBlockGoal),
+ Goals = [BlockSizeVarUnifyGoal, CreateAnswerBlockGoal |
+ SaveGoals]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Generate a sequence of save goals for the given variables.
:- pred generate_save_goals(assoc_list(prog_var, int)::in, prog_var::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, list(foreign_arg)::out, list(hlds_goal)::out,
+ string::out) is det.
-generate_save_goals([], _, _, !VarTypes, !VarSet, !TableInfo, []).
+generate_save_goals([], _, _, !VarTypes, !VarSet, !TableInfo, [],
+ [], [], "").
generate_save_goals([NumberedVar | NumberedRest], TableVar, Context,
- !VarTypes, !VarSet, !TableInfo, Goals) :-
+ !VarTypes, !VarSet, !TableInfo, Goals, Args ++ RestArgs,
+ PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
NumberedVar = Var - Offset,
gen_int_construction("OffsetVar", Offset, !VarTypes,
!VarSet, OffsetVar, OffsetUnifyGoal),
ModuleInfo = !.TableInfo ^ table_module_info,
map__lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
- gen_save_call_for_type(TypeCat, VarType, TableVar, Var, OffsetVar,
- Context, !VarTypes, !VarSet, !TableInfo, CallGoal),
+ gen_save_call_for_type(TypeCat, VarType, TableVar, Var,
+ Offset, OffsetVar, Context, !VarTypes, !VarSet, !TableInfo,
+ SaveGoals, Args, PrefixGoals, CodeStr),
generate_save_goals(NumberedRest, TableVar, Context,
- !VarTypes, !VarSet, !TableInfo, RestGoals),
- Goals = [OffsetUnifyGoal, CallGoal | RestGoals].
+ !VarTypes, !VarSet, !TableInfo, RestGoals,
+ RestArgs, RestPrefixGoals, RestCodeStr),
+ Goals = [OffsetUnifyGoal | SaveGoals ++ RestGoals].
:- pred gen_save_call_for_type(type_category::in, (type)::in,
- prog_var::in, prog_var::in, prog_var::in, term__context::in,
+ prog_var::in, prog_var::in, int::in, prog_var::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, hlds_goal::out) is det.
+ table_info::in, table_info::out, list(hlds_goal)::out,
+ list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-gen_save_call_for_type(TypeCat, Type, TableVar, Var, OffsetVar, Context,
- !VarTypes, !VarSet, !TableInfo, Goal) :-
+gen_save_call_for_type(TypeCat, Type, TableVar, Var, Offset, OffsetVar,
+ Context, !VarTypes, !VarSet, !TableInfo, Goals,
+ Args, PrefixGoals, CodeStr) :-
ModuleInfo = !.TableInfo ^ table_module_info,
+ Name = "save_arg" ++ int_to_string(Offset),
+ ForeignArg = foreign_arg(Var, yes(Name - in_mode), Type),
( type_util__type_is_io_state(Type) ->
- LookupPredName = "table_save_io_state_answer",
- generate_call(LookupPredName, [TableVar, OffsetVar, Var],
- det, yes(impure), [], ModuleInfo, Context, Goal)
+ SavePredName = "table_save_io_state_answer",
+ generate_call(SavePredName, det, [TableVar, OffsetVar, Var],
+ yes(impure), [], ModuleInfo, Context, Goal),
+ Goals = [Goal],
+ Args = [ForeignArg],
+ PrefixGoals = [],
+ CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
+ answer_block_name ++ ", " ++
+ int_to_string(Offset) ++ ", " ++
+ Name ++ ");\n"
; builtin_type(TypeCat) = no ->
+ % If used ForeignArg instead of GenericForeignArg, then
+ % Var would be unboxed when assigned to Name, which we
+ % don't want.
+ GenericForeignArg = foreign_arg(Var, yes(Name - in_mode),
+ dummy_type_var),
make_type_info_var(Type, Context, !VarTypes, !VarSet,
!TableInfo, TypeInfoVar, ExtraGoals),
-
- generate_call("table_save_any_answer",
+ TypeInfoName = "save_arg_typeinfo" ++ int_to_string(Offset),
+ map__lookup(!.VarTypes, TypeInfoVar, TypeInfoType),
+ TypeInfoForeignArg = foreign_arg(TypeInfoVar,
+ yes(TypeInfoName - in_mode), TypeInfoType),
+ SavePredName = "table_save_any_answer",
+ generate_call(SavePredName, det,
[TypeInfoVar, TableVar, OffsetVar, Var],
- det, yes(impure), [], ModuleInfo, Context, CallGoal),
-
- list__append(ExtraGoals, [CallGoal], ConjList),
- CallGoal = _ - GoalInfo,
- conj_list_to_goal(ConjList, GoalInfo, Goal)
+ yes(impure), [], ModuleInfo, Context, CallGoal),
+ Goals = ExtraGoals ++ [CallGoal],
+ Args = [GenericForeignArg, TypeInfoForeignArg],
+ PrefixGoals = ExtraGoals,
+ CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
+ answer_block_name ++ ", " ++
+ int_to_string(Offset) ++ ", " ++
+ TypeInfoName ++ ", " ++
+ Name ++ ");\n"
;
type_save_category(TypeCat, CatString),
string__append_list(["table_save_", CatString, "_answer"],
- LookupPredName),
- generate_call(LookupPredName, [TableVar, OffsetVar, Var],
- det, yes(impure), [], ModuleInfo, Context, Goal)
+ SavePredName),
+ generate_call(SavePredName, det, [TableVar, OffsetVar, Var],
+ yes(impure), [], ModuleInfo, Context, Goal),
+ Goals = [Goal],
+ Args = [ForeignArg],
+ PrefixGoals = [],
+ CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
+ answer_block_name ++ ", " ++
+ int_to_string(Offset) ++ ", " ++
+ Name ++ ");\n"
).
%-----------------------------------------------------------------------------%
+ % Generate a goal for restoring the output arguments from
+ % an answer block in memo predicates.
+
:- pred generate_memo_restore_goal(assoc_list(prog_var, int)::in,
- prog_var::in, module_info::in, term__context::in,
+ instmap_delta::in, prog_var::in, module_info::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
hlds_goal::out) is det.
-generate_memo_restore_goal(NumberedOutputVars, TipVar, ModuleInfo, Context,
- !VarTypes, !VarSet, Goal) :-
+generate_memo_restore_goal(NumberedOutputVars, OrigInstMapDelta, TipVar,
+ ModuleInfo, Context, !VarTypes, !VarSet, Goal) :-
(
NumberedOutputVars = [_ | _],
+ assoc_list__keys(NumberedOutputVars, OutputVars),
+ GetPredName = "table_memo_get_answer_block",
generate_new_table_var("RestoreBlockVar", answer_block_type,
!VarTypes, !VarSet, RestoreBlockVar),
- generate_call("table_memo_get_answer_block",
- [TipVar, RestoreBlockVar], det, yes(semipure),
- ground_vars([RestoreBlockVar]),
+ generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
+ RestoreBlockVar, ModuleInfo, Context,
+ !VarTypes, !VarSet, RestoreGoals,
+ RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
+ tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+ (
+ TablingViaExtraArgs = yes,
+ BaseVarName = base_name,
+ Arg = foreign_arg(TipVar, yes(BaseVarName - in_mode),
+ trie_node_type),
+ Args = [Arg],
+ DeclCodeStr = "\tMR_AnswerBlock " ++
+ answer_block_name ++ ";\n",
+ ShortcutPredName = GetPredName ++ "_shortcut",
+ ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
+ BaseVarName ++ ");\n",
+ GetRestoreCodeStr = "\tMR_" ++ GetPredName ++ "(" ++
+ BaseVarName ++ ", " ++
+ answer_block_name ++ ");\n" ++
+ RestoreCodeStr,
+ generate_foreign_proc(ShortcutPredName, det,
+ tabling_c_attributes, Args, RestoreArgs,
+ DeclCodeStr, ShortcutStr, GetRestoreCodeStr,
+ yes(impure), RestoreInstMapDeltaSrc,
+ ModuleInfo, Context, ShortcutGoal),
+ Goal = ShortcutGoal
+ ;
+ TablingViaExtraArgs = no,
+ generate_call(GetPredName, det,
+ [TipVar, RestoreBlockVar],
+ yes(semipure), ground_vars([RestoreBlockVar]),
ModuleInfo, Context, GetBlockGoal),
- generate_restore_goals(NumberedOutputVars, RestoreBlockVar,
- ModuleInfo, Context, !VarTypes, !VarSet, RestoreGoals),
GoalExpr = conj([GetBlockGoal | RestoreGoals]),
- assoc_list__keys(NumberedOutputVars, OutputVars),
set__list_to_set([TipVar | OutputVars], NonLocals),
- goal_info_init_hide(NonLocals, bind_vars(OutputVars),
+ goal_info_init_hide(NonLocals, OrigInstMapDelta,
det, semipure, Context, GoalInfo),
Goal = GoalExpr - GoalInfo
+ )
;
NumberedOutputVars = [],
true_goal(Goal)
).
+ % Generate a goal for restoring the output arguments from
+ % an answer block in minimal model predicates without a suspension.
+
:- pred generate_mm_restore_goal(determinism::in,
- assoc_list(prog_var, int)::in, prog_var::in,
+ assoc_list(prog_var, int)::in, instmap_delta::in, prog_var::in,
module_info::in, term__context::in, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, hlds_goal::out) is det.
-generate_mm_restore_goal(Detism, NumberedOutputVars, SubgoalVar,
- ModuleInfo, Context, !VarTypes, !VarSet, Goal) :-
- generate_new_table_var("AnswerTable", answer_block_type,
- !VarTypes, !VarSet, AnswerTableVar),
+generate_mm_restore_goal(Detism, NumberedOutputVars, OrigInstMapDelta,
+ SubgoalVar, ModuleInfo, Context, !VarTypes, !VarSet, Goal) :-
( Detism = multidet ->
ReturnAllAns = "table_mm_return_all_multi"
; Detism = nondet ->
@@ -1562,83 +1830,131 @@
;
error("generate_mm_restore_goal: invalid determinism")
),
- generate_call(ReturnAllAns, [SubgoalVar, AnswerTableVar],
- Detism, yes(semipure), [AnswerTableVar - ground(unique, none)],
- ModuleInfo, Context, ReturnAnswerBlocksGoal),
- generate_restore_goals(NumberedOutputVars, AnswerTableVar, ModuleInfo,
- Context, !VarTypes, !VarSet, RestoreGoals),
- GoalExpr = conj([ReturnAnswerBlocksGoal | RestoreGoals]),
+ generate_mm_restore_or_suspend_goal(ReturnAllAns, Detism, semipure,
+ NumberedOutputVars, OrigInstMapDelta, SubgoalVar, ModuleInfo,
+ Context, !VarTypes, !VarSet, Goal).
+
+ % Generate a goal for restoring the output arguments from
+ % an answer block in minimal model predicates after a suspension.
+
+:- pred generate_mm_suspend_goal(assoc_list(prog_var, int)::in,
+ instmap_delta::in, prog_var::in, module_info::in, term__context::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out) is det.
+
+generate_mm_suspend_goal(NumberedOutputVars, OrigInstMapDelta, SubgoalVar,
+ ModuleInfo, Context, !VarTypes, !VarSet, Goal) :-
+ generate_mm_restore_or_suspend_goal("table_mm_suspend_consumer",
+ nondet, impure, NumberedOutputVars, OrigInstMapDelta,
+ SubgoalVar, ModuleInfo, Context, !VarTypes, !VarSet, Goal).
+
+ % Generate a goal for restoring the output arguments from
+ % an answer block in minimal model predicates. Whether the restore
+ % is after a suspension depends on the arguments.
+
+:- pred generate_mm_restore_or_suspend_goal(string::in, determinism::in,
+ purity::in, assoc_list(prog_var, int)::in, instmap_delta::in,
+ prog_var::in, module_info::in, term__context::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ hlds_goal::out) is det.
+
+generate_mm_restore_or_suspend_goal(PredName, Detism, Purity,
+ NumberedOutputVars, OrigInstMapDelta, SubgoalVar, ModuleInfo,
+ Context, !VarTypes, !VarSet, Goal) :-
+ generate_new_table_var("AnswerBlock", answer_block_type,
+ !VarTypes, !VarSet, AnswerBlockVar),
+ generate_call(PredName, Detism, [SubgoalVar, AnswerBlockVar],
+ yes(semipure), ground_vars([AnswerBlockVar]), ModuleInfo,
+ Context, ReturnAnswerBlocksGoal),
+ generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
+ AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ RestoreGoals, RestoreInstMapDeltaSrc, RestoreArgs,
+ RestoreCodeStr),
assoc_list__keys(NumberedOutputVars, OutputVars),
+ tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs),
+ (
+ TablingViaExtraArgs = yes,
+ Arg = foreign_arg(AnswerBlockVar,
+ yes(answer_block_name - in_mode), answer_block_type),
+ Args = [Arg],
+ ShortcutPredName = "table_mm_return_all_shortcut",
+ ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
+ answer_block_name ++ ");\n",
+ generate_foreign_proc(ShortcutPredName, det,
+ tabling_c_attributes, Args, RestoreArgs,
+ "", ShortcutStr, RestoreCodeStr,
+ yes(impure), RestoreInstMapDeltaSrc, ModuleInfo,
+ Context, ShortcutGoal),
+ GoalExpr = conj([ReturnAnswerBlocksGoal, ShortcutGoal])
+ ;
+ TablingViaExtraArgs = no,
+ GoalExpr = conj([ReturnAnswerBlocksGoal | RestoreGoals])
+ ),
set__list_to_set([SubgoalVar | OutputVars], NonLocals),
- create_instmap_delta([ReturnAnswerBlocksGoal | RestoreGoals],
- InstMapDelta0),
- instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
- goal_info_init_hide(NonLocals, InstMapDelta, nondet, semipure, Context,
- GoalInfo),
+ goal_info_init_hide(NonLocals, OrigInstMapDelta, Detism, Purity,
+ Context, GoalInfo),
Goal = GoalExpr - GoalInfo.
-:- pred generate_restore_goals(assoc_list(prog_var, int)::in, prog_var::in,
- module_info::in, term__context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, list(hlds_goal)::out) is det.
+%-----------------------------------------------------------------------------%
+
+ % Generate a sequence of restore goals for the given variables.
+
+:- pred generate_restore_goals(assoc_list(prog_var, int)::in,
+ instmap_delta::in, prog_var::in, module_info::in, term__context::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ list(hlds_goal)::out, assoc_list(prog_var, inst)::out,
+ list(foreign_arg)::out, string::out) is det.
-generate_restore_goals([], _, _, _, !VarTypes, !VarSet, []).
-generate_restore_goals([NumberedVar | NumberedRest], AnswerBlockVar,
- ModuleInfo, Context, !VarTypes, !VarSet,
- [OffsetUnifyGoal, CallGoal | RestGoals]) :-
+generate_restore_goals([], _, _, _, _, !VarTypes, !VarSet, [], [], [], "").
+generate_restore_goals([NumberedVar | NumberedRest], OrigInstmapDelta,
+ AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
+ [OffsetUnifyGoal, CallGoal | RestGoals], [VarInst | VarInsts],
+ [Arg | Args], CodeStr ++ RestCodeStr) :-
NumberedVar = Var - Offset,
gen_int_construction("OffsetVar", Offset, !VarTypes, !VarSet,
OffsetVar, OffsetUnifyGoal),
map__lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
- gen_restore_call_for_type(TypeCat, VarType, AnswerBlockVar, Var,
- OffsetVar, ModuleInfo, Context, CallGoal),
- generate_restore_goals(NumberedRest, AnswerBlockVar, ModuleInfo,
- Context, !VarTypes, !VarSet, RestGoals).
+ gen_restore_call_for_type(TypeCat, VarType, OrigInstmapDelta,
+ AnswerBlockVar, Var, Offset, OffsetVar, ModuleInfo, Context,
+ CallGoal, VarInst, Arg, CodeStr),
+ generate_restore_goals(NumberedRest, OrigInstmapDelta, AnswerBlockVar,
+ ModuleInfo, Context, !VarTypes, !VarSet, RestGoals, VarInsts,
+ Args, RestCodeStr).
:- pred gen_restore_call_for_type(type_category::in, (type)::in,
- prog_var::in, prog_var::in, prog_var::in, module_info::in,
- term__context::in, hlds_goal::out) is det.
-
-gen_restore_call_for_type(TypeCat, Type, TableVar, Var, OffsetVar,
- ModuleInfo, Context, Goal) :-
+ instmap_delta::in, prog_var::in, prog_var::in, int::in, prog_var::in,
+ module_info::in, term__context::in, hlds_goal::out,
+ pair(prog_var, inst)::out, foreign_arg::out, string::out) is det.
+
+gen_restore_call_for_type(TypeCat, Type, OrigInstmapDelta, TableVar, Var,
+ Offset, OffsetVar, ModuleInfo, Context, Goal, Var - Inst, Arg,
+ CodeStr) :-
+ Name = "restore_arg" ++ int_to_string(Offset),
( type_util__type_is_io_state(Type) ->
- LookupPredName = "table_restore_io_state_answer"
+ RestorePredName = "table_restore_io_state_answer",
+ ArgType = Type
; builtin_type(TypeCat) = no ->
- LookupPredName = "table_restore_any_answer"
+ RestorePredName = "table_restore_any_answer",
+ ArgType = dummy_type_var
;
type_save_category(TypeCat, CatString),
string__append_list(["table_restore_", CatString, "_answer"],
- LookupPredName)
+ RestorePredName),
+ ArgType = Type
),
- generate_call(LookupPredName, [TableVar, OffsetVar, Var], det,
- yes(semipure), [Var - ground(shared, none)],
- ModuleInfo, Context, Goal).
-
-%-----------------------------------------------------------------------------%
-
-:- pred generate_mm_suspend_goal(assoc_list(prog_var, int)::in, prog_var::in,
- module_info::in, term__context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- hlds_goal::out) is det.
-
-generate_mm_suspend_goal(NumberedOutputVars, TableVar, ModuleInfo, Context,
- !VarTypes, !VarSet, Goal) :-
- generate_new_table_var("AnswerTable", answer_block_type,
- !VarTypes, !VarSet, AnswerTableVar),
- generate_call("table_mm_suspend_consumer", [TableVar, AnswerTableVar],
- nondet, yes(semipure), ground_vars([AnswerTableVar]),
- ModuleInfo, Context, ReturnAnswerBlocksGoal),
- generate_restore_goals(NumberedOutputVars, AnswerTableVar,
- ModuleInfo, Context, !VarTypes, !VarSet, RestoreGoals),
- GoalExpr = conj([ReturnAnswerBlocksGoal | RestoreGoals]),
- assoc_list__keys(NumberedOutputVars, OutputVars),
- set__list_to_set([TableVar | OutputVars], NonLocals),
- create_instmap_delta([ReturnAnswerBlocksGoal | RestoreGoals],
- InstMapDelta0),
- instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
- goal_info_init_hide(NonLocals, InstMapDelta, nondet, impure, Context,
- GoalInfo),
- Goal = GoalExpr - GoalInfo.
+ ( instmap_delta_search_var(OrigInstmapDelta, Var, InstPrime) ->
+ Inst = InstPrime
+ ;
+ error("gen_restore_call_for_type: no inst")
+ ),
+ Arg = foreign_arg(Var, yes(Name - (free -> Inst)), ArgType),
+ CodeStr = "\tMR_" ++ RestorePredName ++ "(" ++
+ answer_block_name ++ ", " ++
+ int_to_string(Offset) ++ ", " ++
+ Name ++ ");\n",
+ generate_call(RestorePredName, det, [TableVar, OffsetVar, Var],
+ yes(semipure), [Var - Inst], ModuleInfo, Context, Goal).
%-----------------------------------------------------------------------------%
@@ -1670,8 +1986,8 @@
gen_string_construction("Message", Message, !VarTypes, !VarSet,
MessageVar, MessageStrGoal),
- generate_call("table_error", [MessageVar], erroneous,
- no, [], ModuleInfo, Context, CallGoal),
+ generate_call("table_error", erroneous, [MessageVar], no, [],
+ ModuleInfo, Context, CallGoal),
GoalExpr = conj([MessageStrGoal, CallGoal]),
goal_info_init_hide(set__init, bind_vars([]), erroneous, impure,
@@ -1688,16 +2004,31 @@
varset__new_named_var(!.VarSet, Name, Var, !:VarSet),
map__set(!.VarTypes, Var, Type, !:VarTypes).
-:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
+:- pred generate_call(string::in, determinism::in, list(prog_var)::in,
maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
module_info::in, term__context::in, hlds_goal::out) is det.
-generate_call(PredName, Args, Detism, MaybeFeature, InstMapSrc,
- ModuleInfo, Context, CallGoal) :-
+generate_call(PredName, Detism, Args, MaybeFeature, InstMapSrc,
+ ModuleInfo, Context, Goal) :-
mercury_table_builtin_module(BuiltinModule),
goal_util__generate_simple_call(BuiltinModule, PredName, predicate,
- Args, only_mode, Detism, MaybeFeature, InstMapSrc, ModuleInfo,
- Context, CallGoal).
+ only_mode, Detism, Args, MaybeFeature, InstMapSrc, ModuleInfo,
+ Context, Goal).
+
+:- pred generate_foreign_proc(string::in, determinism::in,
+ pragma_foreign_proc_attributes::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
+ string::in, maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
+ module_info::in, term__context::in, hlds_goal::out) is det.
+
+generate_foreign_proc(PredName, Detism, Attributes, Args, ExtraArgs,
+ PrefixCode, Code, SuffixCode, MaybeFeature, InstMapSrc,
+ ModuleInfo, Context, Goal) :-
+ mercury_table_builtin_module(BuiltinModule),
+ goal_util__generate_foreign_proc(BuiltinModule, PredName, predicate,
+ only_mode, Detism, Attributes, Args, ExtraArgs,
+ PrefixCode, Code, SuffixCode, MaybeFeature, InstMapSrc,
+ ModuleInfo, Context, Goal).
:- pred append_fail(hlds_goal::in, hlds_goal::out) is det.
@@ -1845,8 +2176,6 @@
%-----------------------------------------------------------------------------%
-:- func builtin_type(type_category) = bool.
-
% For backward compatibility, we treat type_info_type as user_type. However,
% this makes the tabling of type_infos more expensive than necessary, since
% we essentially table the information in the type_info twice, once by tabling
@@ -1854,6 +2183,8 @@
% argument of the type constructor private_builtin.type_info/1, and then
% tabling the type_info itself.
+:- func builtin_type(type_category) = bool.
+
builtin_type(int_type) = yes.
builtin_type(char_type) = yes.
builtin_type(str_type) = yes.
@@ -1881,10 +2212,14 @@
lookup_tabling_category(float_type, yes("float" - table_trie_step_float)).
lookup_tabling_category(void_type, _) :-
error("lookup_tabling_category: void").
-lookup_tabling_category(type_info_type, no).
-lookup_tabling_category(type_ctor_info_type, no).
-lookup_tabling_category(typeclass_info_type, no).
-lookup_tabling_category(base_typeclass_info_type, no).
+lookup_tabling_category(type_info_type,
+ yes("typeinfo" - table_trie_step_typeinfo)).
+lookup_tabling_category(type_ctor_info_type,
+ yes("typeinfo" - table_trie_step_typeinfo)).
+lookup_tabling_category(typeclass_info_type, _) :-
+ error("lookup_tabling_category: typeclass_info_type").
+lookup_tabling_category(base_typeclass_info_type, _) :-
+ error("lookup_tabling_category: base_typeclass_info_type").
lookup_tabling_category(enum_type, no).
lookup_tabling_category(higher_order_type, no).
lookup_tabling_category(tuple_type, no).
@@ -1975,6 +2310,58 @@
%
table_info_init(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo,
!:TableInfo).
+
+%-----------------------------------------------------------------------------%
+
+:- pred table_gen__var_is_io_state(vartypes::in, prog_var::in) is semidet.
+
+table_gen__var_is_io_state(VarTypes, Var) :-
+ map__lookup(VarTypes, Var, VarType),
+ type_util__type_is_io_state(VarType).
+
+%-----------------------------------------------------------------------------%
+
+:- pred tabling_via_extra_args(module_info::in, bool::out) is det.
+
+tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs) :-
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, tabling_via_extra_args,
+ TablingViaExtraArgs).
+
+:- func tabling_c_attributes = pragma_foreign_proc_attributes.
+
+tabling_c_attributes = Attrs :-
+ Attrs0 = default_attributes(c),
+ set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs).
+
+:- func dummy_type_var = (type).
+
+dummy_type_var = Type :-
+ varset__init(DummyTVarSet0),
+ varset__new_var(DummyTVarSet0, DummyTVar, _),
+ Type = term__variable(DummyTVar).
+
+%-----------------------------------------------------------------------------%
+
+:- func pred_table_name = string.
+:- func cur_table_node_name = string.
+:- func next_table_node_name = string.
+:- func table_tip_node_name = string.
+:- func base_name = string.
+:- func subgoal_name = string.
+:- func status_name = string.
+:- func answer_block_name = string.
+:- func success_indicator_name = string.
+
+pred_table_name = "pred_table".
+cur_table_node_name = "cur_node".
+next_table_node_name = "next_node".
+table_tip_node_name = "table_tip".
+base_name = "base".
+subgoal_name = "subgoal".
+status_name = "status".
+answer_block_name = "answerblock".
+success_indicator_name = "SUCCESS_INDICATOR".
%-----------------------------------------------------------------------------%
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.16
diff -u -b -r1.16 term_pass1.m
--- compiler/term_pass1.m 19 Mar 2004 10:19:25 -0000 1.16
+++ compiler/term_pass1.m 7 Jun 2004 08:49:55 -0000
@@ -349,7 +349,7 @@
if_then_else(_, Cond, Then, Else), _, !Errors) :-
list__foldl(check_goal_non_term_calls(Module, PPId, VarTypes),
[Cond, Then, Else], !Errors).
-check_goal_expr_non_term_calls(_, _, _, foreign_proc(_, _, _, _, _, _, _),
+check_goal_expr_non_term_calls(_, _, _, foreign_proc(_, _, _, _, _, _),
_, !Errors).
check_goal_expr_non_term_calls(Module, PPId, VarTypes, par_conj(Goals), _,
!Errors) :-
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_traversal.m,v
retrieving revision 1.29
diff -u -b -r1.29 term_traversal.m
--- compiler/term_traversal.m 19 Mar 2004 10:19:26 -0000 1.29
+++ compiler/term_traversal.m 7 Jun 2004 08:49:55 -0000
@@ -195,13 +195,14 @@
traverse_goal(Else, Params, !.Info, ElseInfo),
combine_paths(CondThenInfo, ElseInfo, Params, !:Info).
-traverse_goal_2(foreign_proc(Attributes, CallPredId, CallProcId, Args, _,_,_),
+traverse_goal_2(foreign_proc(Attributes, CallPredId, CallProcId, Args, _, _),
GoalInfo, Params, !Info) :-
params_get_module_info(Params, Module),
module_info_pred_proc_info(Module, CallPredId, CallProcId, _,
CallProcInfo),
proc_info_argmodes(CallProcInfo, CallArgModes),
- partition_call_args(Module, CallArgModes, Args, _InVars, OutVars),
+ ArgVars = list__map(foreign_arg_var, Args),
+ partition_call_args(Module, CallArgModes, ArgVars, _InVars, OutVars),
goal_info_get_context(GoalInfo, Context),
( is_termination_known(Module, proc(CallPredId, CallProcId)) ->
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.41
diff -u -b -r1.41 termination.m
--- compiler/termination.m 14 May 2004 08:40:28 -0000 1.41
+++ compiler/termination.m 7 Jun 2004 08:49:55 -0000
@@ -164,7 +164,7 @@
module_info_pred_proc_info(!.Module, PPId, PredInfo, ProcInfo0),
(
proc_info_goal(ProcInfo0, Goal),
- fst(Goal) = foreign_proc(Attributes, _, _, _, _, _, _)
+ fst(Goal) = foreign_proc(Attributes, _, _, _, _, _)
->
proc_info_get_maybe_termination_info(ProcInfo0,
MaybeTermination),
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.65
diff -u -b -r1.65 trace.m
--- compiler/trace.m 23 May 2004 23:14:34 -0000 1.65
+++ compiler/trace.m 7 Jun 2004 08:49:55 -0000
@@ -582,7 +582,7 @@
TraceCode1 = node([
pragma_c([], [pragma_c_raw_code(TraceStmt1,
live_lvals_info(set__init))], will_not_call_mercury,
- no, no, MaybeLayoutLabel, no, yes)
+ no, no, MaybeLayoutLabel, no, yes, no)
- ""
]),
(
@@ -603,7 +603,7 @@
TraceCode3 = node([
pragma_c([], [pragma_c_raw_code(TraceStmt3,
live_lvals_info(set__init))],
- will_not_call_mercury, no, no, no, no, yes)
+ will_not_call_mercury, no, no, no, no, yes, no)
- ""
])
;
@@ -861,7 +861,8 @@
% eliminate this other label.
pragma_c([], [pragma_c_raw_code(TraceStmt,
live_lvals_info(LiveLvalSet))],
- may_call_mercury, no, no, yes(Label), no, yes)
+ may_call_mercury, no, no, yes(Label), no, yes,
+ no)
- ""
]),
Code = tree(ProduceCode, TraceCode).
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.22
diff -u -b -r1.22 trans_opt.m
--- compiler/trans_opt.m 23 Mar 2004 10:52:13 -0000 1.22
+++ compiler/trans_opt.m 7 Jun 2004 08:49:55 -0000
@@ -57,16 +57,14 @@
:- import_module io, bool, list.
-:- pred trans_opt__write_optfile(module_info, io__state, io__state).
-:- mode trans_opt__write_optfile(in, di, uo) is det.
+:- pred trans_opt__write_optfile(module_info::in, io::di, io::uo) is det.
- % trans_opt__grab_optfiles(ModuleImports0, ModuleList, ModuleImports,
- % Error, IO0, IO).
+ % trans_opt__grab_optfiles(ModuleList, !ModuleImports, Error, !IO):
% Add the items from each of the modules in ModuleList.trans_opt to
% the items in ModuleImports.
-:- pred trans_opt__grab_optfiles(module_imports, list(module_name),
- module_imports, bool, io__state, io__state).
-:- mode trans_opt__grab_optfiles(in, in, out, out, di, uo) is det.
+:- pred trans_opt__grab_optfiles(list(module_name)::in,
+ module_imports::in, module_imports::out, bool::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -90,92 +88,90 @@
% Open the file "<module-name>.trans_opt.tmp", and write out the
% declarations.
-trans_opt__write_optfile(Module) -->
- { module_info_name(Module, ModuleName) },
- module_name_to_file_name(ModuleName, ".trans_opt.tmp", yes,
- TmpOptName),
- io__open_output(TmpOptName, Result),
+trans_opt__write_optfile(Module, !IO) :-
+ module_info_name(Module, ModuleName),
+ module_name_to_file_name(ModuleName, ".trans_opt.tmp", yes, TmpOptName,
+ !IO),
+ io__open_output(TmpOptName, Result, !IO),
(
- { Result = error(Error) },
- { io__error_message(Error, Msg) },
- io__progname_base("trans_opt.m", ProgName),
- io__write_string(ProgName),
+ Result = error(Error),
+ io__error_message(Error, Msg),
+ io__progname_base("trans_opt.m", ProgName, !IO),
+ io__write_string(ProgName, !IO),
io__write_string(
- ": cannot open transitive optimisation file `"),
- io__write_string(TmpOptName),
- io__write_string("' \n"),
- io__write_string(ProgName),
- io__write_string(": for output: "),
- io__write_string(Msg),
- io__nl,
- io__set_exit_status(1)
+ ": cannot open transitive optimisation file `", !IO),
+ io__write_string(TmpOptName, !IO),
+ io__write_string("' \n", !IO),
+ io__write_string(ProgName, !IO),
+ io__write_string(": for output: ", !IO),
+ io__write_string(Msg, !IO),
+ io__nl(!IO),
+ io__set_exit_status(1, !IO)
;
- { Result = ok(Stream) },
- io__set_output_stream(Stream, OldStream),
- { module_info_name(Module, ModName) },
- io__write_string(":- module "),
- mercury_output_bracketed_sym_name(ModName),
- io__write_string(".\n"),
+ Result = ok(Stream),
+ io__set_output_stream(Stream, OldStream, !IO),
+ module_info_name(Module, ModName),
+ io__write_string(":- module ", !IO),
+ mercury_output_bracketed_sym_name(ModName, !IO),
+ io__write_string(".\n", !IO),
% All predicates to write global items into the .trans_opt
% file should go here.
- { module_info_predids(Module, PredIds) },
+ module_info_predids(Module, PredIds),
list__foldl(termination__write_pred_termination_info(Module),
- PredIds),
+ PredIds, !IO),
- io__set_output_stream(OldStream, _),
- io__close_output(Stream),
+ io__set_output_stream(OldStream, _, !IO),
+ io__close_output(Stream, !IO),
module_name_to_file_name(ModuleName, ".trans_opt", no,
- OptName),
- update_interface(OptName),
- touch_interface_datestamp(ModuleName, ".trans_opt_date")
+ OptName, !IO),
+ update_interface(OptName, !IO),
+ touch_interface_datestamp(ModuleName, ".trans_opt_date", !IO)
).
%-----------------------------------------------------------------------------%
+
% Read in and process the transitive optimization interfaces.
-trans_opt__grab_optfiles(Module0, TransOptDeps, Module, FoundError) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- maybe_write_string(Verbose, "% Reading .trans_opt files..\n"),
- maybe_flush_output(Verbose),
-
- read_trans_opt_files(TransOptDeps, [], OptItems, no, FoundError),
-
- { append_pseudo_decl(opt_imported, Module0, Module1) },
- { module_imports_get_items(Module1, Items0) },
- { list__append(Items0, OptItems, Items) },
- { module_imports_set_items(Module1, Items, Module2) },
- { module_imports_set_error(Module2, no_module_errors, Module) },
-
- maybe_write_string(Verbose, "% Done.\n").
-
-:- pred read_trans_opt_files(list(module_name), item_list,
- item_list, bool, bool, io__state, io__state).
-:- mode read_trans_opt_files(in, in, out, in, out, di, uo) is det.
-
-read_trans_opt_files([], Items, Items, Error, Error) --> [].
-read_trans_opt_files([Import | Imports],
- Items0, Items, Error0, Error) -->
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
+trans_opt__grab_optfiles(TransOptDeps, !Module, FoundError, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Reading .trans_opt files..\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+
+ read_trans_opt_files(TransOptDeps, [], OptItems, no, FoundError, !IO),
+
+ append_pseudo_decl(opt_imported, !Module),
+ module_imports_get_items(!.Module, Items0),
+ list__append(Items0, OptItems, Items),
+ module_imports_set_items(Items, !Module),
+ module_imports_set_error(no_module_errors, !Module),
+
+ maybe_write_string(Verbose, "% Done.\n", !IO).
+
+:- pred read_trans_opt_files(list(module_name)::in, item_list::in,
+ item_list::out, bool::in, bool::out, io::di, io::uo) is det.
+
+read_trans_opt_files([], !Items, !Error, !IO).
+read_trans_opt_files([Import | Imports], !Items, !Error, !IO) :-
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
maybe_write_string(VeryVerbose,
- "% Reading transitive optimization interface for module"),
- maybe_write_string(VeryVerbose, " `"),
- { prog_out__sym_name_to_string(Import, ImportString) },
- maybe_write_string(VeryVerbose, ImportString),
- maybe_write_string(VeryVerbose, "'... "),
- maybe_flush_output(VeryVerbose),
+ "% Reading transitive optimization interface for module", !IO),
+ maybe_write_string(VeryVerbose, " `", !IO),
+ prog_out__sym_name_to_string(Import, ImportString),
+ maybe_write_string(VeryVerbose, ImportString, !IO),
+ maybe_write_string(VeryVerbose, "'... ", !IO),
+ maybe_flush_output(VeryVerbose, !IO),
- module_name_to_search_file_name(Import, ".trans_opt", FileName),
+ module_name_to_search_file_name(Import, ".trans_opt", FileName, !IO),
prog_io__read_opt_file(FileName, Import,
- ModuleError, Messages, Items1),
+ ModuleError, Messages, NewItems, !IO),
- maybe_write_string(VeryVerbose, " done.\n"),
+ maybe_write_string(VeryVerbose, " done.\n", !IO),
intermod__update_error_status(trans_opt, FileName, ModuleError,
- Messages, Error0, Error1),
-
- { list__append(Items0, Items1, Items2) },
- read_trans_opt_files(Imports, Items2, Items, Error1, Error).
+ Messages, !Error, !IO),
+ list__append(!.Items, NewItems, !:Items),
+ read_trans_opt_files(Imports, !Items, !Error, !IO).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.353
diff -u -b -r1.353 typecheck.m
--- compiler/typecheck.m 20 May 2004 03:28:15 -0000 1.353
+++ compiler/typecheck.m 7 Jun 2004 08:49:56 -0000
@@ -653,7 +653,7 @@
),
pred_info_context(!.PredInfo, Context),
generate_simple_call(mercury_private_builtin_module, CalleeName,
- predicate, [PredNameVar], only_mode, det, no, [], ModuleInfo,
+ predicate, only_mode, det, [PredNameVar], no, [], ModuleInfo,
Context, CallGoal),
%
% Combine the unification and call into a conjunction
@@ -1382,15 +1382,16 @@
typecheck_goal_2(switch(_, _, _), _, !Info, !IO) :-
error("unexpected switch").
-typecheck_goal_2(Goal @ foreign_proc(_, PredId, _, Args, _, _, _), Goal,
+typecheck_goal_2(Goal @ foreign_proc(_, PredId, _, Args, _, _), Goal,
!Info, !IO) :-
% foreign_procs are automatically generated, so they will
% always be type-correct, but we need to do the type analysis in order
% to correctly compute the HeadTypeParams that result from
% existentially typed foreign_procs. (We could probably do that
- % more efficiently that the way it is done below, though.)
+ % more efficiently than the way it is done below, though.)
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
- typecheck_call_pred_id(PredId, Args, !Info, !IO),
+ ArgVars = list__map(foreign_arg_var, Args),
+ typecheck_call_pred_id(PredId, ArgVars, !Info, !IO),
perform_context_reduction(OrigTypeAssignSet, !Info, !IO).
typecheck_goal_2(shorthand(ShorthandGoal0), shorthand(ShorthandGoal), !Info,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.135
diff -u -b -r1.135 unify_proc.m
--- compiler/unify_proc.m 31 Mar 2004 12:32:29 -0000 1.135
+++ compiler/unify_proc.m 7 Jun 2004 08:49:56 -0000
@@ -1833,7 +1833,7 @@
MercuryBuiltin = mercury_private_builtin_module
),
goal_util__generate_simple_call(MercuryBuiltin, Name, predicate,
- ArgVars, mode_no(0), erroneous, no, [], ModuleInfo,
+ mode_no(0), erroneous, ArgVars, no, [], ModuleInfo,
Context, Goal).
:- pred unify_proc__build_specific_call((type)::in, special_pred_id::in,
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.80
diff -u -b -r1.80 unique_modes.m
--- compiler/unique_modes.m 31 Mar 2004 08:52:24 -0000 1.80
+++ compiler/unique_modes.m 7 Jun 2004 08:49:56 -0000
@@ -513,14 +513,15 @@
% to modecheck a pragma_c_code, we just modecheck the proc for
% which it is the goal.
unique_modes__check_goal_2(foreign_proc(Attributes, PredId, ProcId0,
- Args, ArgNameMap, OrigArgTypes, PragmaCode), _GoalInfo, Goal,
- !ModeInfo, !IO) :-
+ Args, ExtraArgs, PragmaCode),
+ _GoalInfo, Goal, !ModeInfo, !IO) :-
mode_checkpoint(enter, "foreign_proc", !ModeInfo, !IO),
mode_info_get_call_id(!.ModeInfo, PredId, CallId),
mode_info_set_call_context(call(call(CallId)), !ModeInfo),
- unique_modes__check_call(PredId, ProcId0, Args, ProcId, !ModeInfo),
- Goal = foreign_proc(Attributes, PredId, ProcId, Args, ArgNameMap,
- OrigArgTypes, PragmaCode),
+ ArgVars = list__map(foreign_arg_var, Args),
+ unique_modes__check_call(PredId, ProcId0, ArgVars, ProcId, !ModeInfo),
+ Goal = foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
+ PragmaCode),
mode_info_unset_call_context(!ModeInfo),
mode_checkpoint(exit, "foreign_proc", !ModeInfo, !IO).
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.18
diff -u -b -r1.18 unneeded_code.m
--- compiler/unneeded_code.m 5 Apr 2004 05:07:44 -0000 1.18
+++ compiler/unneeded_code.m 7 Jun 2004 08:49:56 -0000
@@ -605,7 +605,7 @@
demand_inputs(Goal, ModuleInfo, InitInstMap,
everywhere, !WhereNeededMap)
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
Goal = Goal0,
demand_inputs(Goal, ModuleInfo, InitInstMap,
everywhere, !WhereNeededMap)
@@ -921,7 +921,7 @@
GoalExpr0 = generic_call(_, _, _, _),
Goal = Goal0
;
- GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _),
Goal = Goal0
;
GoalExpr0 = par_conj(_),
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.92
diff -u -b -r1.92 unused_args.m
--- compiler/unused_args.m 20 May 2004 22:18:39 -0000 1.92
+++ compiler/unused_args.m 7 Jun 2004 08:49:56 -0000
@@ -541,14 +541,13 @@
% handle pragma foreign_proc(...) -
% only those arguments which have names can be used in the foreign code.
-traverse_goal(_, foreign_proc(_, _, _, Args, Names, _, _),
+traverse_goal(_, foreign_proc(_, _, _, Args, _, _),
UseInf0, UseInf) :-
- assoc_list__from_corresponding_lists(Args, Names, ArgsAndNames),
- ArgIsUsed = (pred(ArgAndName::in, Arg::out) is semidet :-
- ArgAndName = Arg - MaybeName,
- MaybeName = yes(_)
+ ArgIsUsed = (pred(Arg::in, Var::out) is semidet :-
+ Arg = foreign_arg(Var, MaybeNameAndMode, _),
+ MaybeNameAndMode = yes(_)
),
- list__filter_map(ArgIsUsed, ArgsAndNames, UsedArgs),
+ list__filter_map(ArgIsUsed, Args, UsedArgs),
set_list_vars_used(UseInf0, UsedArgs, UseInf).
% cases to handle all the different types of unification
@@ -1338,7 +1337,7 @@
fixup_goal_expr(_ModuleInfo, _UnusedVars, _ProcCallInfo, no,
GoalExpr - GoalInfo, GoalExpr - GoalInfo) :-
- GoalExpr = foreign_proc(_, _, _, _, _, _, _).
+ GoalExpr = foreign_proc(_, _, _, _, _, _).
fixup_goal_expr(_, _, _, _, shorthand(_) - _, _) :-
% these should have been expanded out by now
Index: compiler/use_local_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/use_local_vars.m,v
retrieving revision 1.8
diff -u -b -r1.8 use_local_vars.m
--- compiler/use_local_vars.m 23 May 2004 23:14:35 -0000 1.8
+++ compiler/use_local_vars.m 7 Jun 2004 08:49:56 -0000
@@ -484,5 +484,5 @@
;
Uinstr0 = c_code(_, _)
;
- Uinstr0 = pragma_c(_, _, _, _, _, _, _, _)
+ Uinstr0 = pragma_c(_, _, _, _, _, _, _, _, _)
).
cvs server: Diffing compiler/notes
cvs server: Diffing debian
cvs server: Diffing deep_profiler
cvs server: Diffing deep_profiler/notes
cvs server: Diffing doc
Index: doc/mdb_categories
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/mdb_categories,v
retrieving revision 1.21
diff -u -b -r1.21 mdb_categories
--- doc/mdb_categories 13 May 2004 08:50:29 -0000 1.21
+++ doc/mdb_categories 7 Jun 2004 08:49:56 -0000
@@ -44,7 +44,8 @@
document_category 700 parameter
parameter - Commands that let users access debugger parameters.
The parameter commands are `set', `printlevel', `echo', `context',
- `scroll', `mmc_options', `scope', `alias' and `unalias'.
+ `goal_paths' `scroll', `mmc_options', `scope', `alias' and
+ `unalias'.
end
document_category 800 help
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.387
diff -u -b -r1.387 user_guide.texi
--- doc/user_guide.texi 31 May 2004 04:12:57 -0000 1.387
+++ doc/user_guide.texi 7 Jun 2004 08:49:56 -0000
@@ -3114,6 +3114,16 @@
@item context
Reports where contexts are being printed.
@sp 1
+ at item goal_paths on
+ at kindex goal_path (mdb command)
+Turns on printing of goal paths at events.
+ at sp 1
+ at item goal_paths off
+Turns off printing of goal paths at events.
+ at sp 1
+ at item goal_paths
+Reports whether goal paths are printed at events.
+ at sp 1
@item scope all
Sets the default scope of new breakpoints to ``all'',
i.e.@: by default, new breakpoints on procedures
@@ -4797,6 +4807,14 @@
Enable stack traces through predicates and functions with
higher-order arguments, even if stack tracing is not
supported in general.
+
+ at c @item --no-tabling-via-extra-args
+ at c @findex --no-tabling-via-extra-args
+ at c Make the tabling transformation emit each primitive operation
+ at c as a separate call to a predicate,
+ at c instead of consolidating sequences of primitives
+ at c into a single piece of foreign language code
+ at c and passing the required data as extra arguments.
@item --generate-bytecode
@findex --generate-bytecode
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/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
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.36
diff -u -b -r1.36 table_builtin.m
--- library/table_builtin.m 31 May 2004 04:13:01 -0000 1.36
+++ library/table_builtin.m 7 Jun 2004 08:49:57 -0000
@@ -5,20 +5,23 @@
%---------------------------------------------------------------------------%
% File: table_builtin.m.
-% Main authors: fjh, ohutch, zs.
+% Main authors: zs, fjh, ohutch.
% Stability: low.
% This file is automatically imported, as if via `use_module', into every
-% module that contains a tabling pragma (`pragma memo', `pragma loopcheck',
+% module that contains a tabling pragma (`pragma loopcheck', `pragma memo',
% or `pragma minimal_model'). It is intended for the builtin procedures
% that the compiler generates implicit calls to when implementing tabling.
% This is separated from private_builtin.m, partly for modularity, but
% mostly to improve compilation speed for programs that don't use tabling.
-
-% This module is a private part of the Mercury implementation;
-% user modules should never explicitly import this module.
-% The interface for this module does not get included in the
-% Mercury library reference manual.
+%
+% The *_shortcut predicates are dummies. They do not ever get called directly;
+% their purpose is to serve as hooks on which to hang foreign_procs generated
+% directly by the compiler.
+%
+% This module is a private part of the Mercury implementation; user modules
+% should never explicitly import this module. The interface for this module
+% does not get included in the Mercury library reference manual.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -143,6 +146,9 @@
:- impure pred table_loop_setup(ml_trie_node::in, loop_status::out) is det.
+:- impure pred table_loop_setup_shortcut(ml_trie_node::in, ml_trie_node::out,
+ loop_status::out) is det.
+
% Mark the call represented by the given table as currently
% not being evaluated (working on an answer).
:- impure pred table_loop_mark_as_inactive(ml_trie_node::in) is det.
@@ -161,6 +167,13 @@
").
:- pragma foreign_proc("C",
+ table_loop_setup_shortcut(T0::in, T::out, Status::out),
+ [will_not_call_mercury],
+"
+ MR_table_loop_setup_shortcut(T0, T, Status);
+").
+
+:- pragma foreign_proc("C",
table_loop_mark_as_inactive(T::in),
[will_not_call_mercury],
"
@@ -173,6 +186,12 @@
impure private_builtin__imp,
private_builtin__sorry("table_loop_setup").
+table_loop_setup_shortcut(_, _, _) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_loop_setup_shortcut").
+
table_loop_mark_as_inactive(_) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
@@ -207,9 +226,15 @@
:- impure pred table_memo_det_setup(ml_trie_node::in, memo_det_status::out)
is det.
+:- impure pred table_memo_det_setup_shortcut(ml_trie_node::in,
+ ml_trie_node::out, memo_det_status::out) is det.
+
:- impure pred table_memo_semi_setup(ml_trie_node::in, memo_semi_status::out)
is det.
+:- impure pred table_memo_semi_setup_shortcut(ml_trie_node::in,
+ ml_trie_node::out, memo_semi_status::out) is det.
+
% Save the fact that the call has failed in the given table.
:- impure pred table_memo_mark_as_failed(ml_trie_node::in) is failure.
@@ -220,10 +245,12 @@
% to the given table.
:- impure pred table_memo_create_answer_block(ml_trie_node::in, int::in,
ml_answer_block::out) is det.
+:- impure pred table_memo_fill_answer_block_shortcut(ml_trie_node::in) is det.
% Return the answer block for the given call.
:- semipure pred table_memo_get_answer_block(ml_trie_node::in,
ml_answer_block::out) is det.
+:- semipure pred table_memo_get_answer_block_shortcut(ml_trie_node::in) is det.
% N.B. interface continued below
@@ -239,6 +266,13 @@
").
:- pragma foreign_proc("C",
+ table_memo_det_setup_shortcut(T0::in, T::out, Status::out),
+ [will_not_call_mercury],
+"
+ MR_table_memo_det_setup_shortcut(T0, T, Status);
+").
+
+:- pragma foreign_proc("C",
table_memo_semi_setup(T::in, Status::out),
[will_not_call_mercury],
"
@@ -246,6 +280,13 @@
").
:- pragma foreign_proc("C",
+ table_memo_semi_setup_shortcut(T0::in, T::out, Status::out),
+ [will_not_call_mercury],
+"
+ MR_table_memo_semi_setup_shortcut(T0, T, Status);
+").
+
+:- pragma foreign_proc("C",
table_memo_mark_as_failed(T::in),
[will_not_call_mercury],
"
@@ -267,24 +308,50 @@
").
:- pragma foreign_proc("C",
+ table_memo_fill_answer_block_shortcut(T::in),
+ [will_not_call_mercury],
+"
+ MR_table_memo_fill_answer_block_shortcut(T);
+").
+
+:- pragma foreign_proc("C",
table_memo_get_answer_block(T::in, AnswerBlock::out),
[will_not_call_mercury, promise_semipure],
"
MR_table_memo_get_answer_block(T, AnswerBlock);
").
+:- pragma foreign_proc("C",
+ table_memo_get_answer_block_shortcut(T::in),
+ [will_not_call_mercury, promise_semipure],
+"
+ MR_table_memo_get_answer_block_shortcut(T);
+").
+
table_memo_det_setup(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_memo_det_setup").
+table_memo_det_setup_shortcut(_, _, _) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_memo_det_setup_shortcut").
+
table_memo_semi_setup(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
impure private_builtin__imp,
private_builtin__sorry("table_memo_semi_setup").
+table_memo_semi_setup_shortcut(_, _, _) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_memo_semi_setup_shortcut").
+
table_memo_mark_as_failed(_) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
@@ -304,12 +371,24 @@
impure private_builtin__imp,
private_builtin__sorry("table_memo_create_answer_block").
+table_memo_fill_answer_block_shortcut(_) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_memo_fill_answer_block_shortcut").
+
table_memo_get_answer_block(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
impure private_builtin__semip,
private_builtin__sorry("table_memo_get_answer_block").
+table_memo_get_answer_block_shortcut(_) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__semip,
+ private_builtin__sorry("table_memo_get_answer_block_shortcut").
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -528,11 +607,14 @@
:- impure pred table_mm_create_answer_block(ml_subgoal::in, int::in,
ml_answer_block::out) is det.
+:- impure pred table_mm_fill_answer_block_shortcut(ml_subgoal::in) is det.
+
% Return all of the answer blocks stored in the given table.
:- semipure pred table_mm_return_all_nondet(ml_subgoal::in,
ml_answer_block::out) is nondet.
:- semipure pred table_mm_return_all_multi(ml_subgoal::in,
ml_answer_block::out) is multi.
+:- semipure pred table_mm_return_all_shortcut(ml_answer_block::in) is det.
% N.B. interface continued below
@@ -567,6 +649,13 @@
:- external(table_mm_return_all_multi/2).
:- pragma foreign_proc("C",
+ table_mm_return_all_shortcut(AnswerBlock::in),
+ [will_not_call_mercury, promise_semipure],
+"
+ MR_table_mm_return_all_shortcut(AnswerBlock);
+").
+
+:- pragma foreign_proc("C",
table_mm_get_answer_table(Subgoal::in, AnswerTable::out),
[will_not_call_mercury, promise_semipure],
"
@@ -580,6 +669,19 @@
MR_table_mm_create_answer_block(Subgoal, Size, AnswerBlock);
").
+:- pragma foreign_proc("C",
+ table_mm_fill_answer_block_shortcut(Subgoal::in),
+ [will_not_call_mercury],
+"
+ MR_table_mm_fill_answer_block_shortcut(Subgoal);
+").
+
+table_mm_return_all_shortcut(_) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ semipure private_builtin__semip,
+ private_builtin__sorry("table_mm_return_all_shortcut").
+
table_mm_get_answer_table(_, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
@@ -592,6 +694,12 @@
impure private_builtin__imp,
private_builtin__sorry("table_mm_create_answer_block").
+table_mm_fill_answer_block_shortcut(_) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin__imp,
+ private_builtin__sorry("table_mm_fill_answer_block_shortcut").
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -639,6 +747,14 @@
:- impure pred table_lookup_insert_poly(ml_trie_node::in, T::in,
ml_trie_node::out) is det.
+ % Lookup or insert a type_info in the given trie.
+:- impure pred table_lookup_insert_typeinfo(ml_trie_node::in,
+ private_builtin.type_info(T)::in, ml_trie_node::out) is det.
+
+ % Lookup or insert a typeclass_info in the given trie.
+:- impure pred table_lookup_insert_typeclassinfo(ml_trie_node::in,
+ private_builtin.typeclass_info(T)::in, ml_trie_node::out) is det.
+
% Save an integer answer in the given answer block at the given
% offset.
:- impure pred table_save_int_answer(ml_answer_block::in, int::in, int::in)
@@ -718,165 +834,170 @@
").
+%-----------------------------------------------------------------------------%
+
:- pragma foreign_proc("C",
- table_lookup_insert_int(T0::in, I::in, T::out),
+ table_lookup_insert_int(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_INT(T, T0, (MR_Integer) I);
+ MR_table_lookup_insert_int(T0, V, T);
").
:- pragma foreign_proc("C",
- table_lookup_insert_start_int(T0::in, S::in, I::in, T::out),
+ table_lookup_insert_start_int(T0::in, S::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_START_INT(T, T0, (MR_Integer) S, (MR_Integer) I);
+ MR_table_lookup_insert_start_int(T0, S, V, T);
").
:- pragma foreign_proc("C",
- table_lookup_insert_char(T0::in, C::in, T::out),
+ table_lookup_insert_char(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_CHAR(T, T0, (MR_Integer) C);
+ MR_table_lookup_insert_char(T0, V, T);
").
:- pragma foreign_proc("C",
- table_lookup_insert_string(T0::in, S::in, T::out),
+ table_lookup_insert_string(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_STRING(T, T0, (MR_String) S);
+ MR_table_lookup_insert_string(T0, V, T);
").
:- pragma foreign_proc("C",
- table_lookup_insert_float(T0::in, F::in, T::out),
+ table_lookup_insert_float(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_FLOAT(T, T0, F);
+ MR_table_lookup_insert_float(T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V);
+ MR_table_lookup_insert_enum(T0, R, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_user(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TypeInfo_for_T, V);
+ MR_table_lookup_insert_user(T0, TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_poly(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TypeInfo_for_T, V);
+ MR_table_lookup_insert_user(T0, TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
- table_save_int_answer(AB::in, Offset::in, I::in),
+ table_lookup_insert_typeinfo(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_TABLE_SAVE_ANSWER(AB, Offset, I,
- &MR_TYPE_CTOR_INFO_NAME(builtin, int, 0));
+ MR_table_lookup_insert_typeinfo(T0, V, T);
").
:- pragma foreign_proc("C",
- table_save_char_answer(AB::in, Offset::in, C::in),
+ table_lookup_insert_typeclassinfo(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_TABLE_SAVE_ANSWER(AB, Offset, C,
- &MR_TYPE_CTOR_INFO_NAME(builtin, character, 0));
+ MR_table_lookup_insert_typeclassinfo(T0, V, T);
").
+%-----------------------------------------------------------------------------%
+
:- pragma foreign_proc("C",
- table_save_string_answer(AB::in, Offset::in, S::in),
+ table_save_int_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) S,
- &MR_TYPE_CTOR_INFO_NAME(builtin, string, 0));
+ MR_table_save_int_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
- table_save_float_answer(AB::in, Offset::in, F::in),
+ table_save_char_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
-#ifdef MR_HIGHLEVEL_CODE
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) MR_box_float(F),
- &MR_TYPE_CTOR_INFO_NAME(builtin, float, 0));
-#else
- MR_TABLE_SAVE_ANSWER(AB, Offset, MR_float_to_word(F),
- &MR_TYPE_CTOR_INFO_NAME(builtin, float, 0));
-#endif
+ MR_table_save_char_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
- table_save_io_state_answer(AB::in, Offset::in, S::ui),
+ table_save_string_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) S,
- &MR_TYPE_CTOR_INFO_NAME(io, state, 0));
+ MR_table_save_string_answer(AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_float_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury],
+"
+ MR_table_save_float_answer(AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_io_state_answer(AB::in, Offset::in, V::ui),
+ [will_not_call_mercury],
+"
+ MR_table_save_io_state_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
table_save_any_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_TABLE_SAVE_ANSWER(AB, Offset, V, TypeInfo_for_T);
+ MR_table_save_any_answer(AB, Offset, TypeInfo_for_T, V);
").
:- pragma foreign_proc("C",
- table_restore_int_answer(AB::in, Offset::in, I::out),
+ table_restore_int_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- I = (MR_Integer) MR_TABLE_GET_ANSWER(AB, Offset);
+ MR_table_restore_int_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
- table_restore_char_answer(AB::in, Offset::in, C::out),
+ table_restore_char_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- C = (MR_Char) MR_TABLE_GET_ANSWER(AB, Offset);
+ MR_table_restore_char_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
- table_restore_string_answer(AB::in, Offset::in, S::out),
+ table_restore_string_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- S = (MR_String) MR_TABLE_GET_ANSWER(AB, Offset);
+ MR_table_restore_string_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
- table_restore_float_answer(AB::in, Offset::in, F::out),
+ table_restore_float_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
-#ifdef MR_HIGHLEVEL_CODE
- F = MR_unbox_float(MR_TABLE_GET_ANSWER(AB, Offset));
-#else
- F = MR_word_to_float(MR_TABLE_GET_ANSWER(AB, Offset));
-#endif
+ MR_table_restore_float_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_io_state_answer(AB::in, Offset::in, V::uo),
[will_not_call_mercury, promise_semipure],
"
- V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset);
+ MR_table_restore_io_state_answer(AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_any_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset);
+ MR_table_restore_any_answer(AB, Offset, V);
").
table_error(Message) :-
error(Message).
:- pragma foreign_proc("C",
- table_report_statistics, [will_not_call_mercury],
+ table_report_statistics,
+ [will_not_call_mercury],
"
MR_table_report_statistics(stderr);
").
cvs server: Diffing profiler
cvs server: Diffing robdd
cvs server: Diffing runtime
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_deep_copy.h
Index: runtime/mercury_minimal_model.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_minimal_model.c,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_minimal_model.c
--- runtime/mercury_minimal_model.c 31 May 2004 04:13:05 -0000 1.13
+++ runtime/mercury_minimal_model.c 7 Jun 2004 08:49:57 -0000
@@ -2526,28 +2526,9 @@
MR_define_entry(MR_IS_NOT_DUPL_ENTRY);
{
MR_TrieNode T;
- MR_bool is_new_answer;
T = (MR_TrieNode) MR_r1;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf("checking if %p is a duplicate answer: %ld\n",
- T, (long) T->MR_integer);
- }
-#endif
-
- is_new_answer = (T->MR_integer == 0);
-
-#ifdef MR_TABLE_STATISTICS
- MR_minmodel_stats_cnt_dupl_check++;
- if (is_new_answer) {
- MR_minmodel_stats_cnt_dupl_check_not_dupl++;
- }
-#endif
-
- T->MR_integer = 1; /* any nonzero value will do */
- MR_r1 = is_new_answer;
+ MR_table_mm_answer_is_not_duplicate(T, MR_r1);
}
MR_proceed();
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.81
diff -u -b -r1.81 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 23 May 2004 22:16:51 -0000 1.81
+++ runtime/mercury_stack_layout.h 7 Jun 2004 08:49:57 -0000
@@ -613,6 +613,8 @@
MR_TABLE_STEP_ENUM,
MR_TABLE_STEP_USER,
MR_TABLE_STEP_POLY,
+ MR_TABLE_STEP_TYPEINFO,
+ MR_TABLE_STEP_TYPECLASSINFO
} MR_Table_Trie_Step;
typedef struct MR_Table_Gen_Struct {
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.9
diff -u -b -r1.9 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h 2 May 2003 21:44:16 -0000 1.9
+++ runtime/mercury_tabling_macros.h 7 Jun 2004 08:49:57 -0000
@@ -47,7 +47,7 @@
MR_type_info_lookup_or_add((table), (type_info))
#define MR_RAW_TABLE_TYPECLASSINFO(table, typeclass_info) \
- MR_type_info_lookup_or_add((table), (typeclass_info))
+ MR_type_class_info_lookup_or_add((table), (typeclass_info))
#ifdef MR_TABLE_DEBUG
Index: runtime/mercury_tabling_preds.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling_preds.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_tabling_preds.h
--- runtime/mercury_tabling_preds.h 31 May 2004 04:28:05 -0000 1.1
+++ runtime/mercury_tabling_preds.h 7 Jun 2004 08:49:57 -0000
@@ -11,6 +11,135 @@
** in library/table_builtin.m.
*/
+#ifdef MR_HIGHLEVEL_CODE
+ #define MR_table_box_float(F) (MR_Word) MR_box_float(F)
+ #define MR_table_unbox_float(W) MR_unbox_float(W)
+#else
+ #define MR_table_box_float(F) MR_float_to_word(F)
+ #define MR_table_unbox_float(W) MR_word_to_float(W)
+#endif
+
+/***********************************************************************/
+
+#define MR_table_lookup_insert_int(T0, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_INT(T, T0, (MR_Integer) V); \
+ } while(0)
+
+#define MR_table_lookup_insert_start_int(T0, S, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_START_INT(T, T0, (MR_Integer) S, (MR_Integer) V); \
+ } while(0)
+
+#define MR_table_lookup_insert_char(T0, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_CHAR(T, T0, (MR_Integer) V); \
+ } while(0)
+
+#define MR_table_lookup_insert_string(T0, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_STRING(T, T0, (MR_String) V); \
+ } while(0)
+
+#define MR_table_lookup_insert_float(T0, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_FLOAT(T, T0, V); \
+ } while(0)
+
+#define MR_table_lookup_insert_enum(T0, R, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V); \
+ } while(0)
+
+#define MR_table_lookup_insert_user(T0, TI, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V); \
+ } while(0)
+
+#define MR_table_lookup_insert_poly(T0, TI, V, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V); \
+ } while(0)
+
+#define MR_table_lookup_insert_typeinfo(T0, TI, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_TYPEINFO(T, T0, (MR_TypeInfo) TI); \
+ } while(0)
+
+#define MR_table_lookup_insert_typeclassinfo(T0, TCI, T) \
+ do { \
+ MR_DEBUG_NEW_TABLE_TYPECLASSINFO(T, T0, (MR_Word *) TCI); \
+ } while(0)
+
+/***********************************************************************/
+
+#define MR_table_save_int_answer(AB, Offset, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, V, \
+ &MR_TYPE_CTOR_INFO_NAME(builtin, int, 0)); \
+ } while(0)
+
+#define MR_table_save_char_answer(AB, Offset, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, V, \
+ &MR_TYPE_CTOR_INFO_NAME(builtin, character, 0)); \
+ } while(0)
+
+#define MR_table_save_string_answer(AB, Offset, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, \
+ &MR_TYPE_CTOR_INFO_NAME(builtin, string, 0)); \
+ } while(0)
+
+#define MR_table_save_float_answer(AB, Offset, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, MR_table_box_float(V), \
+ &MR_TYPE_CTOR_INFO_NAME(builtin, float, 0)); \
+ } while(0)
+
+#define MR_table_save_io_state_answer(AB, Offset, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, \
+ &MR_TYPE_CTOR_INFO_NAME(io, state, 0)); \
+ } while(0)
+
+#define MR_table_save_any_answer(AB, Offset, TI, V) \
+ do { \
+ MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, (MR_TypeInfo) TI);\
+ } while(0)
+
+/***********************************************************************/
+
+#define MR_table_restore_int_answer(AB, Offset, V) \
+ do { \
+ V = (MR_Integer) MR_TABLE_GET_ANSWER(AB, Offset); \
+ } while(0)
+
+#define MR_table_restore_char_answer(AB, Offset, V) \
+ do { \
+ V = (MR_Char) MR_TABLE_GET_ANSWER(AB, Offset); \
+ } while(0)
+
+#define MR_table_restore_string_answer(AB, Offset, V) \
+ do { \
+ V = (MR_String) MR_TABLE_GET_ANSWER(AB, Offset); \
+ } while(0)
+
+#define MR_table_restore_float_answer(AB, Offset, V) \
+ do { \
+ V = MR_table_unbox_float(MR_TABLE_GET_ANSWER(AB, Offset)); \
+ } while(0)
+
+#define MR_table_restore_io_state_answer(AB, Offset, V) \
+ do { \
+ V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset); \
+ } while(0)
+
+#define MR_table_restore_any_answer(AB, Offset, V) \
+ do { \
+ V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset); \
+ } while(0)
+
/***********************************************************************/
#ifdef MR_TABLE_DEBUG
@@ -36,6 +165,8 @@
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while (0)
+#define MR_table_loop_setup_shortcut(T0, T, Status) ((void) 0)
+
/***********************************************************************/
#ifdef MR_TABLE_DEBUG
@@ -90,6 +221,10 @@
#define MR_table_memo_semi_setup(T, Status) \
MR_table_memo_setup(T, Status)
+#define MR_table_memo_det_setup_shortcut(T0, T, Status) ((void) 0)
+
+#define MR_table_memo_semi_setup_shortcut(T0, T, Status) ((void) 0)
+
/***********************************************************************/
#ifdef MR_TABLE_DEBUG
@@ -138,6 +273,10 @@
/***********************************************************************/
+#define MR_table_memo_fill_answer_block_shortcut(T) ((void) 0)
+
+/***********************************************************************/
+
#ifdef MR_TABLE_DEBUG
#define MR_table_memo_get_answer_block_msg(T) \
do { \
@@ -163,6 +302,10 @@
/***********************************************************************/
+#define MR_table_memo_get_answer_block_shortcut(T) ((void) 0)
+
+/***********************************************************************/
+
#ifdef MR_DEBUG_RETRY
#define MR_table_io_in_range_check_msg \
if (MR_io_tabling_debug) { \
@@ -199,7 +342,7 @@
T = &MR_io_tabling_pointer; \
Counter = (MR_Word) old_counter; \
Start = MR_io_tabling_start; \
- if (MR_io_tabling_counter > MR_io_tabling_counter_hwm)\
+ if (MR_io_tabling_counter > MR_io_tabling_counter_hwm) \
{ \
MR_io_tabling_counter_hwm = \
MR_io_tabling_counter; \
@@ -272,6 +415,15 @@
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while(0)
+#define MR_table_mm_setup_shortcut(Subgoal, Status) \
+ do { \
+ MR_fatal_error("MR_table_mm_setup_shortcut"); \
+ } while(0)
+
+/***********************************************************************/
+
+#define MR_table_mm_return_all_shortcut(AnswerBlock) ((void) 0)
+
/***********************************************************************/
#ifdef MR_TABLE_DEBUG
@@ -295,6 +447,43 @@
/***********************************************************************/
+#ifdef MR_TABLE_DEBUG
+ #define MR_table_mm_answer_is_not_duplicate_msg(T) \
+ do { \
+ if (MR_tabledebug) { \
+ printf("checking if %p is a duplicate answer: %ld\n", \
+ T, (long) T->MR_integer); \
+ } \
+ } while(0)
+#else
+ #define MR_table_mm_answer_is_not_duplicate_msg(T) ((void) 0)
+#endif
+
+#ifdef MR_TABLE_STATISTICS
+ #define MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer) \
+ do { \
+ MR_minmodel_stats_cnt_dupl_check++; \
+ if (is_new_answer) { \
+ MR_minmodel_stats_cnt_dupl_check_not_dupl++; \
+ } \
+ } while(0)
+#else
+ #define MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer) \
+ ((void) 0)
+#endif
+
+#define MR_table_mm_answer_is_not_duplicate(T, SUCCESS_INDICATOR) \
+ do { \
+ MR_bool is_new_answer; \
+ MR_table_mm_answer_is_not_duplicate_msg(T); \
+ is_new_answer = (T->MR_integer == 0); \
+ MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer); \
+ T->MR_integer = 1; /* any nonzero value will do */ \
+ SUCCESS_INDICATOR = is_new_answer; \
+ } while(0)
+
+/***********************************************************************/
+
#ifdef MR_MINIMAL_MODEL_DEBUG
#define MR_table_mm_create_answer_block_set(Subgoal, answer_node) \
do { \
@@ -352,19 +541,35 @@
/***********************************************************************/
+#define MR_table_mm_fill_answer_block_shortcut(Subgoal) ((void) 0)
+
+/***********************************************************************/
+
#else /* MR_USE_MINIMAL_MODEL */
#define MR_table_mm_setup(T, Subgoal, Status) \
do { \
- MR_fatal_error("minimal model code entered when not enabled");\
+ MR_fatal_error("minimal model code entered when not enabled"); \
+ } while(0)
+#define MR_table_mm_setup_shortcut(Subgoal, Status) \
+ do { \
+ MR_fatal_error("minimal model code entered when not enabled"); \
+ } while(0)
+#define MR_table_mm_return_all_shortcut(AnswerBlock) \
+ do { \
+ MR_fatal_error("minimal model code entered when not enabled"); \
} while(0)
#define MR_table_mm_get_answer_table(Subgoal, AnswerTable) \
do { \
- MR_fatal_error("minimal model code entered when not enabled");\
+ MR_fatal_error("minimal model code entered when not enabled"); \
} while(0)
#define MR_table_mm_create_answer_block(Subgoal, Size, AnswerBlock) \
do { \
- MR_fatal_error("minimal model code entered when not enabled");\
+ MR_fatal_error("minimal model code entered when not enabled"); \
+ } while(0)
+#define MR_table_mm_fill_answer_block_shortcut(Subgoal) \
+ do { \
+ MR_fatal_error("minimal model code entered when not enabled"); \
} while(0)
#endif /* MR_USE_MINIMAL_MODEL */
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
Index: tests/debugger/completion.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/completion.exp,v
retrieving revision 1.16
diff -u -b -r1.16 completion.exp
--- tests/debugger/completion.exp 13 May 2004 08:50:32 -0000 1.16
+++ tests/debugger/completion.exp 7 Jun 2004 08:49:58 -0000
@@ -3,29 +3,29 @@
Command echo enabled.
mdb> register --quiet
mdb>
-? disable level save_to_file
-P document maxdepth scope
-alias document_category mindepth scroll
-all_class_decls down mm_stacks set
-all_regs e mmc_options source
-all_type_ctors echo modules stack
-b enable next stack_regs
-break exception nondet_stack step
-browse excp p subgoal
-c f pneg_stack table
-cc_query finish print table_io
-class_decl flag print_optionals term_size
-clear_histogram forward printlevel type_ctor
-consumer g proc_stats unalias
-context gen_stack procedures unhide_events
-continue goto query up
-current h quit v
-cut_stack help r var_name_stats
-d histogram_all register vars
-dd histogram_exp retry view
-dd_dd ignore return
-debug_vars io_query s
-delete label_stats save
+? disable label_stats save
+P document level save_to_file
+alias document_category maxdepth scope
+all_class_decls down mindepth scroll
+all_regs e mm_stacks set
+all_type_ctors echo mmc_options source
+b enable modules stack
+break exception next stack_regs
+browse excp nondet_stack step
+c f p subgoal
+cc_query finish pneg_stack table
+class_decl flag print table_io
+clear_histogram forward print_optionals term_size
+consumer g printlevel type_ctor
+context gen_stack proc_stats unalias
+continue goal_paths procedures unhide_events
+current goto query up
+cut_stack h quit v
+d help r var_name_stats
+dd histogram_all register vars
+dd_dd histogram_exp retry view
+debug_vars ignore return
+delete io_query s
h help histogram_all histogram_exp
var_name_stats vars view
var_name_stats vars
Index: tests/debugger/mdb_command_test.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/mdb_command_test.inp,v
retrieving revision 1.28
diff -u -b -r1.28 mdb_command_test.inp
--- tests/debugger/mdb_command_test.inp 13 May 2004 08:50:32 -0000 1.28
+++ tests/debugger/mdb_command_test.inp 7 Jun 2004 08:49:58 -0000
@@ -37,6 +37,7 @@
echo xyzzy xyzzy xyzzy xyzzy xyzzy
scroll xyzzy xyzzy xyzzy xyzzy xyzzy
context xyzzy xyzzy xyzzy xyzzy xyzzy
+goal_paths xyzzy xyzzy xyzzy xyzzy xyzzy
scope xyzzy xyzzy xyzzy xyzzy xyzzy
unalias xyzzy xyzzy xyzzy xyzzy xyzzy
source xyzzy xyzzy xyzzy xyzzy xyzzy
Index: tests/debugger/print_table.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/print_table.exp,v
retrieving revision 1.5
diff -u -b -r1.5 print_table.exp
--- tests/debugger/print_table.exp 31 May 2004 04:13:15 -0000 1.5
+++ tests/debugger/print_table.exp 7 Jun 2004 08:49:58 -0000
@@ -3,6 +3,8 @@
Command echo enabled.
mdb> context none
Contexts will not be printed.
+mdb> goal_paths off
+Goal path printing is now off.
mdb> register --quiet
mdb> b p
0: + stop interface pred print_table.p/3-0 (det)
@@ -212,7 +214,7 @@
memo table for pred print_table.r/2-0 (det):
end of table (0 entries)
mdb> s
- E15: C8 2 COND pred print_table.r/2-0 (det) c4;s2;c1;?;
+ E15: C8 2 COND pred print_table.r/2-0 (det)
mdb> table r
memo table for pred print_table.r/2-0 (det):
<3>: working
Index: tests/debugger/print_table.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/print_table.inp,v
retrieving revision 1.1
diff -u -b -r1.1 print_table.inp
--- tests/debugger/print_table.inp 15 Nov 2002 04:50:44 -0000 1.1
+++ tests/debugger/print_table.inp 7 Jun 2004 08:49:58 -0000
@@ -1,5 +1,6 @@
echo on
context none
+goal_paths off
register --quiet
b p
c
Index: tests/debugger/retry.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/retry.exp,v
retrieving revision 1.7
diff -u -b -r1.7 retry.exp
--- tests/debugger/retry.exp 31 May 2004 04:13:16 -0000 1.7
+++ tests/debugger/retry.exp 7 Jun 2004 08:49:58 -0000
@@ -6,6 +6,8 @@
Scroll control disabled.
mdb> context none
Contexts will not be printed.
+mdb> goal_paths off
+Goal path printing is now off.
mdb> break det_without_cut_1
0: + stop interface pred retry.det_without_cut_1/2-0 (det)
mdb> continue -a
@@ -45,7 +47,7 @@
0: + stop interface pred retry.det_with_cut_1/2-0 (nondet)
mdb> continue -a
E7: C5 2 CALL pred retry.det_with_cut/2-0 (det)
- E8: C5 2 COND pred retry.det_with_cut/2-0 (det) ?;
+ E8: C5 2 COND pred retry.det_with_cut/2-0 (det)
E9: C6 3 CALL pred retry.det_with_cut_1/2-0 (nondet)
mdb> delete *
0: E stop interface pred retry.det_with_cut_1/2-0 (nondet)
@@ -70,9 +72,9 @@
E4: C3 3 EXIT pred retry.det_without_cut_1/2-0 (det)
E6: C2 2 EXIT pred retry.det_without_cut/2-0 (det)
E7: C5 2 CALL pred retry.det_with_cut/2-0 (det)
- E8: C5 2 COND pred retry.det_with_cut/2-0 (det) ?;
+ E8: C5 2 COND pred retry.det_with_cut/2-0 (det)
E9: C6 3 CALL pred retry.det_with_cut_1/2-0 (nondet)
- E13: C6 3 DISJ pred retry.det_with_cut_1/2-0 (nondet) c2;d1;
+ E13: C6 3 DISJ pred retry.det_with_cut_1/2-0 (nondet)
E14: C7 4 CALL pred retry.det_with_cut_2/2-0 (det)
mdb> delete *
0: E stop interface pred retry.det_with_cut_2/2-0 (det)
@@ -113,13 +115,13 @@
mdb> continue
E20: C13 5 CALL pred retry.fib/2-0 (det)
mdb> step
- E21: C13 5 COND pred retry.fib/2-0 (det) c4;s2;c1;?;
+ E21: C13 5 COND pred retry.fib/2-0 (det)
mdb> retry 2
E18: C11 3 CALL pred retry.fib/2-0 (det)
mdb> print *
N (arg 1) 14
mdb> next
- E22: C11 3 COND pred retry.fib/2-0 (det) c4;s2;c1;?;
+ E22: C11 3 COND pred retry.fib/2-0 (det)
mdb> retry 1
E17: C10 2 CALL pred retry.fib/2-0 (det)
mdb> finish -n
Index: tests/debugger/retry.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/retry.exp2,v
retrieving revision 1.8
diff -u -b -r1.8 retry.exp2
--- tests/debugger/retry.exp2 31 May 2004 04:13:16 -0000 1.8
+++ tests/debugger/retry.exp2 7 Jun 2004 08:49:58 -0000
@@ -6,6 +6,8 @@
Scroll control disabled.
mdb> context none
Contexts will not be printed.
+mdb> goal_paths off
+Goal path printing is now off.
mdb> break det_without_cut_1
0: + stop interface pred retry.det_without_cut_1/2-0 (det)
mdb> continue -a
@@ -49,7 +51,7 @@
0: + stop interface pred retry.det_with_cut_1/2-0 (nondet)
mdb> continue -a
E9: C6 2 CALL pred retry.det_with_cut/2-0 (det)
- E10: C6 2 COND pred retry.det_with_cut/2-0 (det) ?;
+ E10: C6 2 COND pred retry.det_with_cut/2-0 (det)
E11: C7 3 CALL pred retry.det_with_cut_1/2-0 (nondet)
mdb> delete *
0: E stop interface pred retry.det_with_cut_1/2-0 (nondet)
@@ -78,9 +80,9 @@
E6: C4 3 EXIT pred retry.det_without_cut_1/2-0 (det)
E8: C2 2 EXIT pred retry.det_without_cut/2-0 (det)
E9: C6 2 CALL pred retry.det_with_cut/2-0 (det)
- E10: C6 2 COND pred retry.det_with_cut/2-0 (det) ?;
+ E10: C6 2 COND pred retry.det_with_cut/2-0 (det)
E11: C7 3 CALL pred retry.det_with_cut_1/2-0 (nondet)
- E17: C7 3 DISJ pred retry.det_with_cut_1/2-0 (nondet) c2;d1;
+ E17: C7 3 DISJ pred retry.det_with_cut_1/2-0 (nondet)
E18: C9 4 CALL pred retry.det_with_cut_2/2-0 (det)
mdb> delete *
0: E stop interface pred retry.det_with_cut_2/2-0 (det)
@@ -121,13 +123,13 @@
mdb> continue
E24: C15 5 CALL pred retry.fib/2-0 (det)
mdb> step
- E25: C15 5 COND pred retry.fib/2-0 (det) c4;s2;c1;?;
+ E25: C15 5 COND pred retry.fib/2-0 (det)
mdb> retry 2
E22: C13 3 CALL pred retry.fib/2-0 (det)
mdb> print *
N (arg 1) 14
mdb> next
- E26: C13 3 COND pred retry.fib/2-0 (det) c4;s2;c1;?;
+ E26: C13 3 COND pred retry.fib/2-0 (det)
mdb> retry 1
E21: C12 2 CALL pred retry.fib/2-0 (det)
mdb> finish -n
Index: tests/debugger/retry.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/retry.inp,v
retrieving revision 1.2
diff -u -b -r1.2 retry.inp
--- tests/debugger/retry.inp 13 Sep 2002 03:37:42 -0000 1.2
+++ tests/debugger/retry.inp 7 Jun 2004 08:49:58 -0000
@@ -2,6 +2,7 @@
register --quiet
scroll off
context none
+goal_paths off
break det_without_cut_1
continue -a
disable 0
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.30
diff -u -b -r1.30 Mmakefile
--- tests/tabling/Mmakefile 31 May 2004 04:13:23 -0000 1.30
+++ tests/tabling/Mmakefile 7 Jun 2004 08:50:01 -0000
@@ -16,6 +16,7 @@
fib_string \
loopcheck_no_loop \
oota \
+ table_foreign_output \
unused_args
SIMPLE_LOOP_PROGS = \
Index: tests/tabling/table_foreign_output.exp
===================================================================
RCS file: tests/tabling/table_foreign_output.exp
diff -N tests/tabling/table_foreign_output.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/table_foreign_output.exp 7 Jun 2004 08:50:01 -0000
@@ -0,0 +1,8 @@
+make_foreign(1, one)
+make_foreign(2, two)
+make_foreign(2, two)
+make_foreign(1, one)
+make_foreign_memo(1, one)
+make_foreign_memo(2, two)
+4
+2
Index: tests/tabling/table_foreign_output.m
===================================================================
RCS file: tests/tabling/table_foreign_output.m
diff -N tests/tabling/table_foreign_output.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/table_foreign_output.m 7 Jun 2004 08:50:01 -0000
@@ -0,0 +1,100 @@
+% This test checks whether we process correctly the memoization of predicates
+% that return foreign types that do not fit into a word.
+
+:- module table_foreign_output.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list, assoc_list, std_util.
+
+main(!IO) :-
+ solutions(test([1 - "one", 2 - "two", 2 - "two", 1 - "one"]),
+ Solns),
+ solutions(test_memo([1 - "one", 2 - "two", 2 - "two", 1 - "one"]),
+ MemoSolns),
+ % solutions sorts foreign types as C pointers, so the order of the
+ % solutions depends on memory layout. This means the order is not
+ % predictable enough to let us print the solutions themselves.
+ list__map(extract_str, Solns, Strs),
+ list__map(extract_str, MemoSolns, MemoStrs),
+ io__write_int(list__length(Strs), !IO),
+ io__nl(!IO),
+ io__write_int(list__length(MemoStrs), !IO),
+ io__nl(!IO).
+
+:- type foreign ---> foreign.
+:- pragma foreign_type("C", foreign, "Foreign").
+
+:- pragma foreign_decl("C",
+"
+typedef struct {
+ MR_Integer i;
+ MR_String s;
+} Foreign;
+").
+
+:- pred test(assoc_list(int, string)::in, foreign::out) is nondet.
+
+test(Pairs, F) :-
+ list__member(N - S, Pairs),
+ make_foreign(N, S, F).
+
+:- pred test_memo(assoc_list(int, string)::in, foreign::out) is nondet.
+
+test_memo(Pairs, F) :-
+ list__member(N - S, Pairs),
+ make_foreign_memo(N, S, F).
+
+:- pred make_foreign(int::in, string::in, foreign::out) is det.
+
+:- pragma foreign_proc("C",
+ make_foreign(N::in, S::in, F::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Foreign *p;
+
+ printf(""make_foreign(%d, %s)\\n"", N, S);
+ p = (Foreign *) malloc(sizeof(Foreign));
+ if (p == NULL) {
+ exit(1);
+ }
+
+ p->i = N;
+ p->s = S;
+ F = *p;
+").
+
+:- pred make_foreign_memo(int::in, string::in, foreign::out) is det.
+:- pragma memo(make_foreign_memo/3).
+
+:- pragma foreign_proc("C",
+ make_foreign_memo(N::in, S::in, F::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Foreign *p;
+
+ printf(""make_foreign_memo(%d, %s)\\n"", N, S);
+ p = (Foreign *) malloc(sizeof(Foreign));
+ if (p == NULL) {
+ exit(1);
+ }
+
+ p->i = N;
+ p->s = S;
+ F = *p;
+").
+
+:- pred extract_str(foreign::in, string::out) is det.
+
+:- pragma foreign_proc("C",
+ extract_str(F::in, S::out),
+ [will_not_call_mercury, promise_pure],
+"
+ S = F.s;
+").
Index: tests/tabling/test_tabling
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/test_tabling,v
retrieving revision 1.2
diff -u -b -r1.2 test_tabling
--- tests/tabling/test_tabling 31 May 2004 04:13:29 -0000 1.2
+++ tests/tabling/test_tabling 7 Jun 2004 08:50:02 -0000
@@ -5,23 +5,52 @@
# is specified via the mmc command to execute to create the test case
# executables; it is intended that this command be a wrapper around tools/lmc.
+usage="usage: test_tabling [-s] [-g grade] mmc_cmd"
+
+simple_only=false
+grade="asm_fast.gc.mm"
+while test $# -gt 0
+do
+ case "$1" in
+ -s) simple_only=true
+ grade="asm_fast.gc"
+ ;;
+ -g) grade="$2"
+ shift
+ ;;
+ -*) echo "$usage"
+ exit 1
+ ;;
+ *) break
+ ;;
+ esac
+ shift
+done
+
case $# in
1) mmc_cmd=$1
;;
- *) echo "usage: test_tabling mmc_cmd"
+ *) echo "$usage"
exit 1
;;
esac
+if $simple_only
+then
+ testcases=`mmake echo_simple_nonloop_progs`
+else
+ testcases=`mmake echo_nondet_nonloop_progs echo_simple_nonloop_progs`
+fi
+
status=0
failed=""
-testcases=`mmake echo_nondet_nonloop_progs echo_simple_nonloop_progs`
+
for testcase in $testcases
do
echo "testing $testcase"
/bin/rm $testcase $testcase.mmake $testcase.res > /dev/null 2>&1
- if $mmc_cmd --grade asm_fast.gc.mm $testcase.m
+ if $mmc_cmd --grade "$grade" $testcase.m
then
mmake $testcase.res > $testcase.mmake 2>&1
if test -f $testcase.res
cvs server: Diffing tests/term
cvs server: Diffing tests/valid
cvs server: Diffing tests/warnings
cvs server: Diffing tools
cvs server: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.173
diff -u -b -r1.173 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 31 May 2004 04:13:39 -0000 1.173
+++ trace/mercury_trace_internal.c 7 Jun 2004 08:50:02 -0000
@@ -177,6 +177,12 @@
static MR_Context_Position MR_context_position = MR_CONTEXT_AFTER;
+/*
+** MR_print_goal_paths specifies whether we print goal paths at events.
+*/
+
+static MR_bool MR_print_goal_paths = MR_TRUE;
+
typedef struct MR_Line_Struct {
char *MR_line_contents;
struct MR_Line_Struct *MR_line_next;
@@ -424,6 +430,7 @@
static MR_TraceCmdFunc MR_trace_cmd_mmc_options;
static MR_TraceCmdFunc MR_trace_cmd_scroll;
static MR_TraceCmdFunc MR_trace_cmd_context;
+static MR_TraceCmdFunc MR_trace_cmd_goal_paths;
static MR_TraceCmdFunc MR_trace_cmd_scope;
static MR_TraceCmdFunc MR_trace_cmd_echo;
static MR_TraceCmdFunc MR_trace_cmd_alias;
@@ -2975,6 +2982,37 @@
}
static MR_Next
+MR_trace_cmd_goal_paths(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
+ MR_Event_Info *event_info, MR_Event_Details *event_details,
+ MR_Code **jumpaddr)
+{
+ if (word_count == 2) {
+ if (MR_streq(words[1], "off")) {
+ MR_print_goal_paths = MR_FALSE;
+ fprintf(MR_mdb_out,
+ "Goal path printing is now off.\n");
+ } else if (MR_streq(words[1], "on")) {
+ MR_print_goal_paths = MR_TRUE;
+ fprintf(MR_mdb_out,
+ "Goal path printing is now on.\n");
+ } else {
+ MR_trace_usage("parameter", "goal_paths");
+ return KEEP_INTERACTING;
+ }
+ } else if (word_count == 1) {
+ if (MR_print_goal_paths) {
+ fprintf(MR_mdb_out, "Goal path printing is on.\n");
+ } else {
+ fprintf(MR_mdb_out, "Goal path printing is off.\n");
+ }
+ } else {
+ MR_trace_usage("parameter", "goal_paths");
+ }
+
+ return KEEP_INTERACTING;
+}
+
+static MR_Next
MR_trace_cmd_scope(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Event_Details *event_details,
MR_Code **jumpaddr)
@@ -6864,7 +6902,8 @@
MR_print_proc_id_trace_and_context(MR_mdb_out, MR_FALSE,
MR_context_position, event_info->MR_event_sll->MR_sll_entry,
- base_sp, base_curfr, event_info->MR_event_path,
+ base_sp, base_curfr,
+ ( MR_print_goal_paths ? event_info->MR_event_path : "" ),
filename, lineno,
MR_port_is_interface(event_info->MR_trace_port),
parent_filename, parent_lineno, indent);
@@ -7038,6 +7077,8 @@
MR_trace_on_off_args, MR_trace_null_completer },
{ "parameter", "context", MR_trace_cmd_context,
MR_trace_context_cmd_args, MR_trace_null_completer },
+ { "parameter", "goal_paths", MR_trace_cmd_goal_paths,
+ MR_trace_on_off_args, MR_trace_null_completer },
{ "parameter", "scope", MR_trace_cmd_scope,
MR_trace_scope_cmd_args, MR_trace_null_completer },
{ "parameter", "echo", MR_trace_cmd_echo,
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