Tabling [3/3]
Oliver Hutchison
ohutch at students.cs.mu.OZ.AU
Mon Mar 9 17:57:07 AEDT 1998
New File: compiler/table_gen.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-1998 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% This module transforms HLDS code to a form that allows tabled evaluation,
% minimal model evaluation and loop detection.
%
% Main author: ohutch
%
% The tabling transformation adds calls to several tabling predicates as
% well as restructuring the HLDS to implement answer clause resolution,
% suspension and loop detection.
%
% Example of transformation for memo :
%
% Given the following code for left recursive transitive closure :
%
% :- pred p(int, int).
% :- mode p(in, out) is nondet
%
% p(A, B) :- e(A, B).
% p(A, B) :- p(A, C), e(C, B).
%
% The transformed code would be :
%
%
% p(A, B) :-
% % Code to get a handle on the table
% c_code("
% static Word Table = 0;
% T0 = &Table;
% "),
% % Code to lookup input arguments and setup table
% impure table_lookup_insert_int(T0, A, T1),
% impure table_setup(T1, T2),
% (if
% semipure table_have_all_ans(T2)
% then
% % Code to return all ans if we have found
% % them
% impure table_return_all_ans(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else if
% semipure table_have_some_ans(T2)
% then
% % Code to suspend the current computational
% % branch
% impure table_suspend(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else
% ( % Mark that this subgoal is being
% % evaluated
% impure table_mark_have_some_ans(T2),
%
% % Use normal program clause resolution
% % to generate answers
% (
% e(A, B)
% ;
% p(A, C),
% e(C, B)
% ),
%
% % Code to check for duplicate
% % answers
% impure table_get_ans_table(T2, AT0),
% impure table_lookup_insert_int(AT0, B, AT1),
%
% % The following pred is semidet
% % it will fail if the answer is
% % already in the table.
% semipure table_new_ans(AT1),
%
% % Code to save a new ans in the
% % table.
% impure table_mark_as_returned(AT1),
% impure table_new_ans_slot(T2, AS),
% impure table_create_ans_block(AS, 1, AB),
% impure table_save_int_ans(AB, 0, B)
% ;
% % Code to resume suspended nodes.
% impure table_resume(T2)
% ;
%
% % Code to mark the current subgoal
% % as totally evaluated.
% impure table_mark_have_all_ans(T2)
% )
% ).
%
%
%
%-----------------------------------------------------------------------------%
:- module table_gen.
:- interface.
:- import_module hlds_module.
:- pred table_gen__process_module(module_info, module_info).
:- mode table_gen__process_module(in, out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_out.
:- import_module hlds_pred, instmap.
:- import_module code_aux, det_analysis, follow_code, goal_util, const_prop.
:- import_module hlds_module, hlds_goal, hlds_data, (inst), inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes, purity.
:- import_module bool, list, set, map, require, std_util, term, varset, int.
:- import_module assoc_list, string, llds.
%-----------------------------------------------------------------------------%
table_gen__process_module(Module0, Module) :-
module_info_preds(Module0, Preds0),
map__keys(Preds0, PredIds),
table_gen__process_preds(PredIds, Module0, Module).
:- pred table_gen__process_preds(list(pred_id), module_info, module_info).
:- mode table_gen__process_preds(in, in, out) is det.
table_gen__process_preds([], Module, Module).
table_gen__process_preds([PredId | PredIds], Module0, Module) :-
table_gen__process_pred(PredId, Module0, Module1),
table_gen__process_preds(PredIds, Module1, Module).
:- pred table_gen__process_pred(pred_id, module_info, module_info).
:- mode table_gen__process_pred(in, in, out) is det.
table_gen__process_pred(PredId, Module0, Module) :-
module_info_pred_info(Module0, PredId, PredInfo),
pred_info_procids(PredInfo, ProcIds),
table_gen__process_procs(PredId, ProcIds, Module0, Module).
:- pred table_gen__process_procs(pred_id, list(proc_id),
module_info, module_info).
:- mode table_gen__process_procs(in, in, in, out) is det.
table_gen__process_procs(_PredId, [], Module, Module).
table_gen__process_procs(PredId, [ProcId | ProcIds], Module0,
Module) :-
module_info_preds(Module0, PredTable),
map__lookup(PredTable, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
map__lookup(ProcTable, ProcId, ProcInfo),
proc_info_eval_method(ProcInfo, EvalMethod),
(
EvalMethod \= eval_normal
->
table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo,
PredInfo, Module0, Module1)
;
Module1 = Module0
),
table_gen__process_procs(PredId, ProcIds, Module1, Module).
%---------------------------------------------------------------------------%
:- pred table_gen__process_proc(eval_method, pred_id, proc_id, proc_info,
pred_info, module_info, module_info).
:- mode table_gen__process_proc(in, in, in, in, in, in, out) is det.
table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0, PredInfo0,
Module0, Module) :-
% grab the appropriate fields from the pred_info and proc_info
pred_info_name(PredInfo, _PredName),
proc_info_interface_code_model(ProcInfo0, CodeModel),
proc_info_headvars(ProcInfo0, HeadVars),
proc_info_varset(ProcInfo0, VarSet0),
proc_info_vartypes(ProcInfo0, VarTypes0),
proc_info_goal(ProcInfo0, OrigGoal),
proc_info_argmodes(ProcInfo0, ArgModes),
(
CodeModel = model_det
->
table_gen__create_new_det_goal(EvalMethod, OrigGoal,
Module0, HeadVars, ArgModes, VarTypes0, VarTypes,
VarSet0, VarSet, Goal)
;
CodeModel = model_semi
->
table_gen__create_new_semi_goal(EvalMethod, OrigGoal,
Module0, HeadVars, ArgModes, VarTypes0, VarTypes,
VarSet0, VarSet, Goal)
;
CodeModel = model_non
->
table_gen__create_new_non_goal(EvalMethod, OrigGoal,
Module0, HeadVars, ArgModes, VarTypes0, VarTypes,
VarSet0, VarSet, Goal)
;
error(
"table_gen__process_proc: unsupported code model for tabled pred/func")
),
% set the new values of the fields in proc_info and pred_info
% and save in the module info
proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
proc_info_set_varset(ProcInfo1, VarSet, ProcInfo2),
proc_info_set_vartypes(ProcInfo2, VarTypes, ProcInfo),
pred_info_procedures(PredInfo0, ProcTable1),
map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
module_info_preds(Module0, PredTable0),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
module_info_set_preds(Module0, PredTable, Module).
%------------------------------------------------------------------------------%
%
% Transform deteministic procedures.
%
:- pred table_gen__create_new_det_goal(eval_method, hlds_goal, module_info,
list(var), list(mode), map(var, type), map(var, type),
varset, varset, hlds_goal).
:- mode table_gen__create_new_det_goal(in, in, in, in, in, in, out, in,
out, out) is det.
table_gen__create_new_det_goal(EvalMethod, OrigGoal, Module, HeadVars,
HeadVarModes, VarTypes0, VarTypes, VarSet0, VarSet, Goal) :-
get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars,
OutputVars),
generate_det_lookup_goal(InputVars, Module, VarTypes0, VarTypes1,
VarSet0, VarSet1, TableVar, LookUpGoal),
generate_call("table_have_ans", [TableVar], semidet, semipure,
[], Module, HaveAnsCheckGoal),
generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal),
generate_restore_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes, VarSet2, VarSet, RestoreAnsGoal),
OrigGoal = _ - OrigGoalInfo,
goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),
map__init(StoreMap),
(
EvalMethod = eval_memo
->
GenAnsGoalEx = conj([OrigGoal, SaveAnsGoal]),
create_instmap_delta([OrigGoal, SaveAnsGoal],
GenAnsInstMapDelta0),
instmap_delta_restrict(GenAnsInstMapDelta0, GenAnsNonLocals,
GenAnsInstMapDelta),
goal_info_init(GenAnsNonLocals, GenAnsInstMapDelta, det,
GenAnsGoalInfo),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo
;
EvalMethod = eval_loop_check
->
generate_call("table_working_on_ans", [TableVar], semidet,
semipure, [], Module, WorkingCheckGoal),
generate_call("table_loopcheck_error", [], erroneous, impure,
[], Module, LoopErrorGoal),
generate_call("table_mark_as_working", [TableVar], det,
impure, [], Module, MarkAsWorkingGoal),
NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal]),
create_instmap_delta([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal], NoLoopGenInstMapDelta0),
instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
NoLoopGenInstMapDelta),
goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta, det,
NoLoopGenGoalInfo),
NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,
GenAnsGoalEx = if_then_else([], WorkingCheckGoal,
LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
NoLoopGenAnsGoal], GenAnsInstMapDelta0),
instmap_delta_restrict(GenAnsInstMapDelta0, GenAnsNonLocals,
GenAnsInstMapDelta),
goal_info_init(GenAnsNonLocals, GenAnsInstMapDelta, det,
GenAnsGoalInfo),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo
;
error(
"table_gen__create_new_det_goal: unsupported evaluation model")
),
ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal,
GenAnsGoal, StoreMap),
create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
ITEInstMapDelta0),
instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
ITEInstMapDelta),
goal_info_init(GenAnsNonLocals, ITEInstMapDelta, det,
ITEGoalInfo),
ITEGoal = ITEGoalEx - ITEGoalInfo,
GoalEx = conj([LookUpGoal, ITEGoal]),
goal_info_init(OrigNonLocals, OrigInstMapDelta, det, GoalInfo),
Goal = GoalEx - GoalInfo.
%------------------------------------------------------------------------------%
%
% Transform semi deterministic procedures
%
:- pred table_gen__create_new_semi_goal(eval_method, hlds_goal,
module_info, list(var), list(mode), map(var, type),
map(var, type), varset, varset, hlds_goal).
:- mode table_gen__create_new_semi_goal(in, in, in, in, in, in, out, in,
out, out) is det.
table_gen__create_new_semi_goal(EvalMethod, OrigGoal, Module, HeadVars,
HeadVarModes, VarTypes0, VarTypes, VarSet0, VarSet, Goal) :-
get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars,
OutputVars),
generate_det_lookup_goal(InputVars, Module, VarTypes0, VarTypes1,
VarSet0, VarSet1, TableVar, LookUpGoal),
generate_call("table_have_ans", [TableVar], semidet, semipure,
[], Module, HaveAnsCheckGoal),
generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal),
generate_restore_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes, VarSet2, VarSet, RestoreTrueAnsGoal),
generate_call("table_save_failure", [TableVar], det, impure,
[], Module, MarkAsFailedGoal),
generate_call("table_has_failed", [TableVar], semidet, semipure,
[], Module, HasFailedCheckGoal),
fail_goal(FailGoal),
OrigGoal = _ - OrigGoalInfo,
goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),
map__init(StoreMap),
(
EvalMethod = eval_memo
->
GenTrueAnsGoalEx = conj([OrigGoal, SaveAnsGoal]),
create_instmap_delta([OrigGoal, SaveAnsGoal],
GenTrueAnsInstMapDelta0),
instmap_delta_restrict(GenTrueAnsInstMapDelta0,
GenAnsNonLocals, GenTrueAnsInstMapDelta),
goal_info_init(GenAnsNonLocals, GenTrueAnsInstMapDelta,
semidet, GenTrueAnsGoalInfo),
GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
;
EvalMethod = eval_loop_check
->
generate_call("table_working_on_ans", [TableVar], semidet,
semipure, [], Module, WorkingCheckGoal),
generate_call("table_loopcheck_error", [], erroneous, impure,
[], Module, LoopErrorGoal),
generate_call("table_mark_as_working", [TableVar], det,
impure, [], Module, MarkAsWorkingGoal),
NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal]),
create_instmap_delta([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal], NoLoopGenInstMapDelta0),
instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
NoLoopGenInstMapDelta),
goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta, det,
NoLoopGenGoalInfo),
NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,
GenTrueAnsGoalEx = if_then_else([], WorkingCheckGoal,
LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
NoLoopGenAnsGoal], GenTrueAnsInstMapDelta0),
instmap_delta_restrict(GenTrueAnsInstMapDelta0, GenAnsNonLocals,
GenTrueAnsInstMapDelta),
goal_info_init(GenAnsNonLocals, GenTrueAnsInstMapDelta,
semidet, GenTrueAnsGoalInfo),
GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
;
EvalMethod = eval_minimal
->
generate_call("table_working_on_ans", [TableVar], semidet,
semipure, [], Module, WorkingCheckGoal),
generate_call("table_mark_as_working", [TableVar], det,
impure, [], Module, MarkAsWorkingGoal),
NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal]),
create_instmap_delta([MarkAsWorkingGoal, OrigGoal,
SaveAnsGoal], NoLoopGenInstMapDelta0),
instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
NoLoopGenInstMapDelta),
goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta,
semidet, NoLoopGenGoalInfo),
NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,
GenTrueAnsGoalEx = if_then_else([], WorkingCheckGoal,
FailGoal, NoLoopGenAnsGoal, StoreMap),
create_instmap_delta([WorkingCheckGoal, FailGoal,
NoLoopGenAnsGoal], GenTrueAnsInstMapDelta0),
instmap_delta_restrict(GenTrueAnsInstMapDelta0,
GenAnsNonLocals, GenTrueAnsInstMapDelta),
goal_info_init(GenAnsNonLocals, GenTrueAnsInstMapDelta, det,
GenTrueAnsGoalInfo),
GenTrueAnsGoal = GenTrueAnsGoalEx - GenTrueAnsGoalInfo
;
error(
"table_gen__create_new_semi_goal: unsupported evaluation model")
),
SaveFailureGoalEx = conj([MarkAsFailedGoal, FailGoal]),
set__singleton_set(SaveFailureNonLocals, TableVar),
create_instmap_delta([MarkAsFailedGoal, FailGoal],
SaveFailureInstMapDelta0),
instmap_delta_restrict(SaveFailureInstMapDelta0, SaveFailureNonLocals,
SaveFailureInstMapDelta),
goal_info_init(SaveFailureNonLocals, SaveFailureInstMapDelta, failure,
SaveFailureGoalInfo),
SaveFailureGoal = SaveFailureGoalEx - SaveFailureGoalInfo,
RestAnsGoalEx = if_then_else([], HasFailedCheckGoal, FailGoal,
RestoreTrueAnsGoal, StoreMap),
set__singleton_set(RestNonLocals0, TableVar),
set__insert_list(RestNonLocals0, OutputVars, RestNonLocals),
create_instmap_delta([HasFailedCheckGoal, FailGoal,
RestoreTrueAnsGoal], RestInstMapDelta0),
instmap_delta_restrict(RestInstMapDelta0, RestNonLocals,
RestInstMapDelta),
goal_info_init(RestNonLocals, RestInstMapDelta, semidet,
RestAnsGoalInfo),
RestoreAnsGoal = RestAnsGoalEx - RestAnsGoalInfo,
GenAnsGoalEx = disj([GenTrueAnsGoal, SaveFailureGoal], StoreMap),
create_instmap_delta([GenTrueAnsGoal, SaveFailureGoal],
GenAnsGoalInstMapDelta0),
instmap_delta_restrict(GenAnsGoalInstMapDelta0, GenAnsNonLocals,
GenAnsGoalInstMapDelta),
goal_info_init(GenAnsNonLocals, GenAnsGoalInstMapDelta, semidet,
GenAnsGoalInfo),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo,
ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal,
GenAnsGoal, StoreMap),
create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
ITEInstMapDelta0),
instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
ITEInstMapDelta),
goal_info_init(GenAnsNonLocals, ITEInstMapDelta, semidet,
ITEGoalInfo),
ITEGoal = ITEGoalEx - ITEGoalInfo,
GoalEx = conj([LookUpGoal, ITEGoal]),
goal_info_init(OrigNonLocals, OrigInstMapDelta, semidet, GoalInfo),
Goal = GoalEx - GoalInfo.
%------------------------------------------------------------------------------%
%
% Transform non deterministic procedures
%
:- pred table_gen__create_new_non_goal(eval_method, hlds_goal, module_info,
list(var), list(mode), map(var, type), map(var, type),
varset, varset, hlds_goal).
:- mode table_gen__create_new_non_goal(in, in, in, in, in, in, out, in,
out, out) is det.
table_gen__create_new_non_goal(EvalMethod, OrigGoal, Module, HeadVars,
HeadVarModes, VarTypes0, VarTypes, VarSet0, VarSet, Goal) :-
get_input_output_vars(HeadVars, HeadVarModes, Module, InputVars,
OutputVars),
generate_non_lookup_goal(InputVars, Module, VarTypes0, VarTypes1,
VarSet0, VarSet1, TableVar, LookUpGoal),
generate_call("table_have_all_ans", [TableVar], semidet, semipure,
[], Module, HaveAllAnsCheckGoal),
generate_non_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal),
generate_restore_all_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes3, VarSet2, VarSet3, RestoreAllAnsGoal),
generate_call("table_have_some_ans", [TableVar], semidet, semipure,
[], Module, HaveSomeAnsCheckGoal),
generate_suspend_goal(OutputVars, TableVar, Module, VarTypes3,
VarTypes, VarSet3, VarSet, SuspendGoal),
generate_call("table_mark_have_some_ans", [TableVar], det, impure,
[], Module, MarkHaveSomeAnsGoal),
generate_call("table_resume", [TableVar], failure, impure,
[], Module, ResumeGoal),
generate_call("table_mark_have_all_ans", [TableVar], failure, impure,
[], Module, MarkHaveAllAnsGoal),
OrigGoal = _ - OrigGoalInfo,
goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
fail_goal(FailGoal),
map__init(StoreMap),
(
EvalMethod = eval_memo
->
WorkingOnAnsGoal = SuspendGoal
;
EvalMethod = eval_minimal
->
WorkingOnAnsGoal = FailGoal
;
error(
"table_gen__create_new_non_goal: unsupported evaluation model")
),
GenAnsGoalPart1Ex = conj([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal]),
set__insert(OrigNonLocals, TableVar, GenAnsGoalPart1NonLocals),
create_instmap_delta([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal],
GenAnsGoalPart1IMD0),
instmap_delta_restrict(GenAnsGoalPart1IMD0, GenAnsGoalPart1NonLocals,
GenAnsGoalPart1IMD),
goal_info_init(GenAnsGoalPart1NonLocals, GenAnsGoalPart1IMD, nondet,
GenAnsGoalPart1GoalInfo),
GenAnsGoalPart1 = GenAnsGoalPart1Ex - GenAnsGoalPart1GoalInfo,
GenAnsGoalEx = disj([GenAnsGoalPart1, ResumeGoal, MarkHaveAllAnsGoal],
StoreMap),
create_instmap_delta([GenAnsGoalPart1, ResumeGoal, MarkHaveAllAnsGoal],
GenAnsIMD0),
instmap_delta_restrict(GenAnsIMD0, GenAnsGoalPart1NonLocals,
GenAnsIMD),
goal_info_init(GenAnsGoalPart1NonLocals, GenAnsIMD, nondet,
GenAnsGoalInfo),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo,
ITE1GoalEx = if_then_else([], HaveSomeAnsCheckGoal, WorkingOnAnsGoal,
GenAnsGoal, StoreMap),
ITE1Goal = ITE1GoalEx - GenAnsGoalPart1GoalInfo,
ITE2GoalEx = if_then_else([], HaveAllAnsCheckGoal, RestoreAllAnsGoal,
ITE1Goal, StoreMap),
ITE2Goal = ITE2GoalEx - GenAnsGoalPart1GoalInfo,
GoalEx = conj([LookUpGoal, ITE2Goal]),
goal_info_init(OrigNonLocals, OrigInstMapDelta, nondet, GoalInfo),
Goal = GoalEx - GoalInfo.
%------------------------------------------------------------------------------%
:- pred generate_get_table_goals(map(var, type), map(var, type), varset,
varset, module_info, var, hlds_goal).
:- mode generate_get_table_goals(in, out, in, out, in, out, out) is det.
generate_get_table_goals(VarTypes0, VarTypes, VarSet0, VarSet, Module,
TableVar, Goal) :-
generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet,
TableVar),
module_info_get_predicate_table(Module, PredTable),
(
predicate_table_search_pred_m_n_a(PredTable,
"mercury_builtin", "get_table", 1, [PredId0])
->
PredId = PredId0
;
error("can't locate mercury_builtin:get_table/1")
),
module_info_pred_info(Module, PredId, PredInfo),
(
pred_info_procids(PredInfo, [ProcId0])
->
ProcId = ProcId0
;
error(
"to many modes for predicate mercury_builtin:get_table/1")
),
TableVarInst = ground(unique, no),
TableVarMode = (free -> TableVarInst),
get_table_var_type(TableVarType),
GoalEx = pragma_c_code(will_not_call_mercury, PredId, ProcId,
[TableVar], [yes("TableVar" - TableVarMode)],
[TableVarType], ordinary(
" {
static Word Table = 0;
TableVar = (Word)&Table;
}
",
no)),
set__singleton_set(NonLocals, TableVar),
instmap_delta_from_assoc_list([TableVar - TableVarInst],
InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det,
GoalInfo0),
goal_info_add_feature(GoalInfo0, impure, GoalInfo),
Goal = GoalEx - GoalInfo.
%------------------------------------------------------------------------------%
:- pred generate_det_lookup_goal(list(var), module_info, map(var, type),
map(var, type), varset, varset, var, hlds_goal).
:- mode generate_det_lookup_goal(in, in, in, out, in, out, out, out) is det.
generate_det_lookup_goal(Vars, Module, VarTypes0, VarTypes, VarSet0, VarSet,
TableVar, Goal) :-
generate_get_table_goals(VarTypes0, VarTypes1, VarSet0, VarSet1, Module,
TableVar0, GetTableGoal),
generate_lookup_goals(Vars, TableVar0, TableVar, Module,
VarTypes1, VarTypes, VarSet1, VarSet, LookupGoals),
GoalEx = conj([GetTableGoal | LookupGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, Vars, NonLocals),
instmap_delta_from_assoc_list([], InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_non_lookup_goal(list(var), module_info, map(var, type),
map(var, type), varset, varset, var, hlds_goal).
:- mode generate_non_lookup_goal(in, in, in, out, in, out, out, out) is det.
generate_non_lookup_goal(Vars, Module, VarTypes0, VarTypes, VarSet0, VarSet,
TableVar, Goal) :-
generate_get_table_goals(VarTypes0, VarTypes1, VarSet0, VarSet1, Module,
TableVar0, GetTableGoal),
generate_lookup_goals(Vars, TableVar0, TableVar1, Module,
VarTypes1, VarTypes2, VarSet1, VarSet2, LookupGoals),
generate_new_table_var(VarTypes2, VarTypes, VarSet2, VarSet,
TableVar),
generate_call("table_setup", [TableVar1, TableVar], det, impure,
[TableVar - ground(unique, no)], Module, SetupGoal),
list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals),
GoalEx = conj(Goals),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, Vars, NonLocals),
create_instmap_delta(Goals, InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_lookup_goals(list(var), var, var, module_info,
map(var, type), map(var, type), varset, varset,
list(hlds_goal)).
:- mode generate_lookup_goals(in, in, out, in, in, out, in, out, out) is det.
generate_lookup_goals([], TableVar, TableVar, _, VarTypes, VarTypes, VarSet,
VarSet, []).
generate_lookup_goals([Var|Rest], TableVar0, TableVar, Module, VarTypes0,
VarTypes, VarSet0, VarSet, [Goal|RestGoals]) :-
map__lookup(VarTypes0, Var, VarType),
classify_type(VarType, Module, TypeCat),
gen_lookup_call_for_type(TypeCat, VarType, TableVar0, Var,
Module, VarTypes0, VarTypes1, VarSet0, VarSet1, TableVar1,
Goal),
generate_lookup_goals(Rest, TableVar1, TableVar, Module,
VarTypes1, VarTypes, VarSet1, VarSet, RestGoals).
:- pred gen_lookup_call_for_type(builtin_type, type, var, var, module_info,
map(var, type), map(var, type), varset, varset, var,
hlds_goal).
:- mode gen_lookup_call_for_type(in, in, in, in, in, in, out, in,
out, out, out) is det.
gen_lookup_call_for_type(TypeCat, Type, TableVar, ArgVar, Module, VarTypes0,
VarTypes, VarSet0, VarSet, NextTableVar, Goal) :-
(
TypeCat = pred_type
->
error("gen_lookup_call_for_type: pred types not supported")
;
TypeCat = enum_type
->
(
type_to_type_id(Type, TypeId, _)
->
module_info_types(Module, TypeDefnTable),
map__lookup(TypeDefnTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
(
TypeBody = du_type(Ctors, _, yes, no)
->
list__length(Ctors, EnumRange)
;
error(
"gen_lookup_call_for_type: unsuported type in tabled predicte/function")
),
gen_int_construction("RangeVar", EnumRange, VarTypes0,
VarTypes1, VarSet0, VarSet1, RangeVar,
RangeUnifyGoal),
generate_new_table_var(VarTypes1, VarTypes, VarSet1,
VarSet, NextTableVar),
generate_call("table_lookup_insert_enum", [TableVar,
RangeVar, ArgVar, NextTableVar], det, impure,
[NextTableVar - ground(unique, no)], Module,
LookupGoal),
set__init(NonLocals0),
set__insert_list(NonLocals0, [TableVar, ArgVar],
NonLocals),
instmap_delta_from_assoc_list([], InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Goal = conj([RangeUnifyGoal, LookupGoal]) - GoalInfo
;
error("gen_lookup: unexpected type")
)
;
(
(
TypeCat = polymorphic_type
;
TypeCat = user_type
)
->
(
term__vars(Type, [])
->
LookupPredName = "table_lookup_insert_user"
;
LookupPredName = "table_lookup_insert_poly"
)
;
builtin_type_to_string(TypeCat, CatString),
string__append("table_lookup_insert_", CatString,
LookupPredName)
),
generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet,
NextTableVar),
generate_call(LookupPredName, [TableVar, ArgVar, NextTableVar],
det, impure, [NextTableVar - ground(unique, no)],
Module, Goal)
).
%------------------------------------------------------------------------------%
:- pred generate_save_goal(list(var), var, map(var, type), map(var, type),
varset, varset, module_info, hlds_goal).
:- mode generate_save_goal(in, in, in, out, in, out, in, out) is det.
generate_save_goal(AnsList, TableVar, VarTypes0, VarTypes, VarSet0,
VarSet, Module, Goal) :-
list__length(AnsList, NumAnsVars),
gen_int_construction("NumAnsVars", NumAnsVars, VarTypes0, VarTypes1,
VarSet0, VarSet1, NumAnsVarsVar, NumAnsVarsUnifyGoal),
generate_new_table_var(VarTypes1, VarTypes2, VarSet1, VarSet2,
AnsTableVar),
generate_call("table_create_ans_block", [TableVar, NumAnsVarsVar,
AnsTableVar], det, impure, [AnsTableVar - ground(unique, no)],
Module, GenAnsBlockGoal),
generate_save_goals(AnsList, AnsTableVar, 0, Module, VarTypes2,
VarTypes, VarSet2, VarSet, SaveGoals),
GoalEx = conj([NumAnsVarsUnifyGoal, GenAnsBlockGoal | SaveGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, AnsList, NonLocals),
create_instmap_delta([NumAnsVarsUnifyGoal, GenAnsBlockGoal |
SaveGoals], InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det,
GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_non_save_goal(list(var), var, map(var, type), map(var, type),
varset, varset, module_info, hlds_goal).
:- mode generate_non_save_goal(in, in, in, out, in, out, in, out) is det.
generate_non_save_goal(AnsList, TableVar, VarTypes0, VarTypes, VarSet0,
VarSet, Module, Goal) :-
generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
AnsTableVar0),
generate_call("table_get_ans_table", [TableVar, AnsTableVar0], det,
impure, [AnsTableVar0 - ground(unique, no)], Module,
GetAnsTableGoal),
generate_lookup_goals(AnsList, AnsTableVar0, AnsTableVar1, Module,
VarTypes1, VarTypes2, VarSet1, VarSet2, LookupAnsGoals),
generate_call("table_new_ans", [AnsTableVar1], semidet, semipure,
[], Module, NewAnsCheckGoal),
generate_call("table_mark_as_returned", [AnsTableVar1], det, impure,
[], Module, MarkAsReturnedGoal),
generate_new_table_var(VarTypes2, VarTypes3, VarSet2, VarSet3,
AnsBlockVar0),
generate_call("table_new_ans_slot", [TableVar, AnsBlockVar0], det,
impure, [AnsBlockVar0 - ground(unique, no)], Module,
GenAnsSlotGoal),
list__length(AnsList, NumAnsVars),
gen_int_construction("NumAnsVars", NumAnsVars, VarTypes3, VarTypes4,
VarSet3, VarSet4, NumAnsVarsVar, NumAnsVarsUnifyGoal),
generate_new_table_var(VarTypes4, VarTypes5, VarSet4, VarSet5,
AnsBlockVar),
generate_call("table_create_ans_block", [AnsBlockVar0, NumAnsVarsVar,
AnsBlockVar], det, impure, [AnsBlockVar - ground(unique, no)],
Module, GenAnsBlockGoal),
generate_save_goals(AnsList, AnsBlockVar, 0, Module, VarTypes5,
VarTypes, VarSet5, VarSet, SaveGoals),
list__append([GetAnsTableGoal | LookupAnsGoals],
[NewAnsCheckGoal, MarkAsReturnedGoal, GenAnsSlotGoal,
NumAnsVarsUnifyGoal, GenAnsBlockGoal | SaveGoals], Goals),
GoalEx = conj(Goals),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, AnsList, NonLocals),
create_instmap_delta(Goals, InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, semidet, GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_save_goals(list(var), var, int, module_info, map(var, type),
map(var, type), varset, varset, list(hlds_goal)).
:- mode generate_save_goals(in, in, in, in, in, out, in, out, out) is det.
generate_save_goals([], _TableVar, _Offset, _Module, VarTypes, VarTypes,
VarSet, VarSet, []).
generate_save_goals([Var|Rest], TableVar, Offset0, Module, VarTypes0,
VarTypes, VarSet0, VarSet, [OffsetUnifyGoal,
CallGoal|RestGoals]) :-
gen_int_construction("OffsetVar", Offset0, VarTypes0, VarTypes1,
VarSet0, VarSet1, OffsetVar, OffsetUnifyGoal),
map__lookup(VarTypes1, Var, VarType),
classify_type(VarType, Module, TypeCat),
gen_save_call_for_type(TypeCat, VarType, TableVar, Var, OffsetVar,
Module, CallGoal),
Offset is Offset0 + 1,
generate_save_goals(Rest, TableVar, Offset, Module, VarTypes1,
VarTypes, VarSet1, VarSet, RestGoals).
:- pred gen_save_call_for_type(builtin_type, type, var, var, var, module_info,
hlds_goal).
:- mode gen_save_call_for_type(in, in, in, in, in, in, out) is det.
gen_save_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module,
Goal) :-
(
TypeCat = pred_type
->
error("gen_lookup_call_for_type: pred types not supported")
;
(
TypeCat = enum_type
;
TypeCat = polymorphic_type
;
TypeCat = user_type
)
->
LookupPredName = "table_save_any_ans"
;
builtin_type_to_string(TypeCat, CatString),
string__append_list(["table_save_", CatString, "_ans"],
LookupPredName)
),
generate_call(LookupPredName, [TableVar, OffsetVar, Var],
det, impure, [], Module, Goal).
%------------------------------------------------------------------------------%
:- pred generate_restore_goal(list(var), var, module_info, map(var, type),
map(var, type), varset, varset, hlds_goal).
:- mode generate_restore_goal(in, in, in, in, out, in, out, out) is det.
generate_restore_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes,
VarSet0, VarSet, Goal) :-
generate_restore_goals(OutputVars, TableVar, 0, Module, VarTypes0,
VarTypes, VarSet0, VarSet, RestoreGoals),
GoalEx = conj(RestoreGoals),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, OutputVars, NonLocals),
create_instmap_delta(RestoreGoals, InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det,
GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_restore_all_goal(list(var), var, module_info, map(var, type),
map(var, type), varset, varset, hlds_goal).
:- mode generate_restore_all_goal(in, in, in, in, out, in, out, out) is det.
generate_restore_all_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes,
VarSet0, VarSet, Goal) :-
generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
AnsTableVar),
generate_call("table_return_all_ans", [TableVar, AnsTableVar],
nondet, semipure, [AnsTableVar - ground(unique, no)],
Module, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, VarTypes1,
VarTypes, VarSet1, VarSet, RestoreGoals),
GoalEx = conj([ReturnAnsBlocksGoal | RestoreGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, OutputVars, NonLocals),
create_instmap_delta([ReturnAnsBlocksGoal | RestoreGoals],
InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, nondet,
GoalInfo),
Goal = GoalEx - GoalInfo.
:- pred generate_restore_goals(list(var), var, int, module_info, map(var, type),
map(var, type), varset, varset, list(hlds_goal)).
:- mode generate_restore_goals(in, in, in, in, in, out, in, out, out) is det.
generate_restore_goals([], _TableVar, _Offset, _Module, VarTypes, VarTypes,
VarSet, VarSet, []).
generate_restore_goals([Var|Rest], TableVar, Offset0, Module, VarTypes0,
VarTypes, VarSet0, VarSet, [OffsetUnifyGoal,
CallGoal|RestGoals]) :-
gen_int_construction("OffsetVar", Offset0, VarTypes0, VarTypes1,
VarSet0, VarSet1, OffsetVar, OffsetUnifyGoal),
map__lookup(VarTypes1, Var, VarType),
classify_type(VarType, Module, TypeCat),
gen_restore_call_for_type(TypeCat, VarType, TableVar, Var, OffsetVar,
Module, CallGoal),
Offset is Offset0 + 1,
generate_restore_goals(Rest, TableVar, Offset, Module, VarTypes1,
VarTypes, VarSet1, VarSet, RestGoals).
:- pred gen_restore_call_for_type(builtin_type, type, var, var, var,
module_info, hlds_goal).
:- mode gen_restore_call_for_type(in, in, in, in, in, in, out) is det.
gen_restore_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module,
Goal) :-
(
TypeCat = pred_type
->
error("gen_lookup_call_for_type: pred types not supported")
;
(
TypeCat = enum_type
;
TypeCat = polymorphic_type
;
TypeCat = user_type
)
->
LookupPredName = "table_restore_any_ans"
;
builtin_type_to_string(TypeCat, CatString),
string__append_list(["table_restore_", CatString, "_ans"],
LookupPredName)
),
generate_call(LookupPredName, [TableVar, OffsetVar, Var],
det, impure, [Var - ground(shared, no)], Module, Goal).
%------------------------------------------------------------------------------%
:- pred generate_suspend_goal(list(var), var, module_info, map(var, type),
map(var, type), varset, varset, hlds_goal).
:- mode generate_suspend_goal(in, in, in, in, out, in, out, out) is det.
generate_suspend_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes,
VarSet0, VarSet, Goal) :-
generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
AnsTableVar),
generate_call("table_suspend", [TableVar, AnsTableVar],
nondet, semipure, [AnsTableVar - ground(unique, no)],
Module, ReturnAnsBlocksGoal),
generate_restore_goals(OutputVars, AnsTableVar, 0, Module, VarTypes1,
VarTypes, VarSet1, VarSet, RestoreGoals),
GoalEx = conj([ReturnAnsBlocksGoal | RestoreGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, OutputVars, NonLocals),
create_instmap_delta([ReturnAnsBlocksGoal | RestoreGoals],
InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, nondet,
GoalInfo),
Goal = GoalEx - GoalInfo.
%------------------------------------------------------------------------------%
:- pred generate_new_table_var(map(var, type), map(var, type), varset, varset,
var).
:- mode generate_new_table_var(in, out, in, out, out) is det.
generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, Var) :-
varset__new_named_var(VarSet0, "TableVar", Var, VarSet),
get_table_var_type(Type),
map__set(VarTypes0, Var, Type, VarTypes).
:- pred generate_call(string, list(var), determinism, goal_feature,
assoc_list(var, inst), module_info, hlds_goal).
:- mode generate_call(in, in, in, in, in, in, out) is det.
generate_call(PredName, Args, Detism, Feature, InstMap, Module, Goal) :-
list__length(Args, Arity),
module_info_get_predicate_table(Module, PredTable),
(
predicate_table_search_pred_m_n_a(PredTable,
"mercury_builtin", PredName, Arity, [PredId0])
->
PredId = PredId0
;
string__int_to_string(Arity, ArityS),
string__append_list(["can't locate mercury_builtin:", PredName,
"/", ArityS], ErrorMessage),
error(ErrorMessage)
),
module_info_pred_info(Module, PredId, PredInfo),
(
pred_info_procids(PredInfo, [ProcId0])
->
ProcId = ProcId0
;
string__int_to_string(Arity, ArityS),
string__append_list(["too many modes for pred mercury_builtin:",
PredName, "/", ArityS], ErrorMessage),
error(ErrorMessage)
),
Call = call(PredId, ProcId, Args, not_builtin, no, qualified(
"mercury_builtin", PredName)),
set__init(NonLocals0),
set__insert_list(NonLocals0, Args, NonLocals),
(
(
Detism = failure
;
Detism = erroneous
)
->
instmap_delta_init_unreachable(InstMapDelta)
;
instmap_delta_from_assoc_list(InstMap, InstMapDelta)
),
goal_info_init(NonLocals, InstMapDelta, Detism, GoalInfo0),
goal_info_add_feature(GoalInfo0, Feature, GoalInfo),
Goal = Call - GoalInfo.
:- pred gen_int_construction(string, int, map(var, type), map(var, type),
varset, varset, var, hlds_goal).
:- mode gen_int_construction(in, in, in, out, in, out, out, out) is det.
gen_int_construction(VarName, VarValue, VarTypes0, VarTypes, VarSet0, VarSet,
Var, Goal) :-
varset__new_named_var(VarSet0, VarName, Var, VarSet),
term__context_init(Context),
VarType = term__functor(term__atom("int"), [], Context),
map__set(VarTypes0, Var, VarType, VarTypes),
Inst = bound(unique, [functor(int_const(VarValue), [])]),
VarUnify = unify(Var, functor(int_const(VarValue), []),
(free -> Inst) - (Inst -> Inst),
construct(Var, int_const(VarValue), [], []),
unify_context(explicit, [])),
set__singleton_set(VarNonLocals, Var),
instmap_delta_from_assoc_list([Var - Inst],
VarInstMapDelta),
goal_info_init(VarNonLocals, VarInstMapDelta, det,
VarGoalInfo),
Goal = VarUnify - VarGoalInfo.
:- pred get_table_var_type(type).
:- mode get_table_var_type(out) is det.
get_table_var_type(Type) :-
construct_type(qualified("mercury_builtin", "c_pointer") - 0,
[], Type).
:- pred get_input_output_vars(list(var), list(mode), module_info, list(var),
list(var)).
:- mode get_input_output_vars(in, in, in, out, out) is det.
get_input_output_vars([], [], _, [], []).
get_input_output_vars([_|_], [], _, _, _) :-
error("get_input_output_vars: lists not same length").
get_input_output_vars([], [_|_], _, _, _) :-
error("get_input_output_vars: lists not same length").
get_input_output_vars([Var|RestV], [Mode|RestM], Module, InVars, OutVars) :-
(
mode_is_fully_input(Module, Mode)
->
get_input_output_vars(RestV, RestM, Module, InVars0, OutVars),
InVars = [Var|InVars0]
;
mode_is_fully_output(Module, Mode)
->
get_input_output_vars(RestV, RestM, Module, InVars, OutVars0),
OutVars = [Var|OutVars0]
;
error(
"Only fully input/output arguments are allowed in tabled code!")
).
:- pred create_instmap_delta(hlds_goals, instmap_delta).
:- mode create_instmap_delta(in, out) is det.
create_instmap_delta([], IMD) :-
instmap_delta_from_assoc_list([], IMD).
create_instmap_delta([Goal|Rest], IMD) :-
Goal = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, IMD0),
create_instmap_delta(Rest, IMD1),
instmap_delta_apply_instmap_delta(IMD0, IMD1, IMD).
:- pred builtin_type_to_string(builtin_type, string).
:- mode builtin_type_to_string(in, out) is det.
builtin_type_to_string(int_type, "int").
builtin_type_to_string(char_type, "char").
builtin_type_to_string(str_type, "string").
builtin_type_to_string(float_type, "float").
builtin_type_to_string(pred_type, "pred").
builtin_type_to_string(enum_type, "enum").
builtin_type_to_string(polymorphic_type, "any").
builtin_type_to_string(user_type, "any").
New File: runtime/mercury_table_any.c
===================================================================
/*
** Copyright (C) 1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** This module defines the mercury_table_type() function.
*/
#include "mercury_imp.h"
#include "mercury_tabling.h"
#include "mercury_table_any.h"
#include "mercury_type_info.h"
#include <stdio.h>
/*
** Prototypes.
*/
static Word get_base_type_layout_entry(Word data, Word *type_info);
static Word * make_type_info(Word *term_type_info, Word *arg_pseudo_type_info,
bool *allocated);
MR_DECLARE_STRUCT(mercury_data___base_type_info_pred_0);
MR_DECLARE_STRUCT(mercury_data___base_type_info_func_0);
/*
** Due to the depth of the control here, we'll use 4 space indentation.
*/
Word **
mercury_table_type(Word *type_info, Word data, Word** Table)
{
Word layout_entry, *entry_value, *data_value;
int data_tag, entry_tag;
int arity, i;
bool allocated;
Word *argument_vector, *type_info_vector, *new_type_info;
Word new_data;
data_tag = tag(data);
data_value = (Word *) body(data, data_tag);
layout_entry = get_base_type_layout_entry(data_tag, type_info);
entry_tag = tag(layout_entry);
entry_value = (Word *) body(layout_entry, entry_tag);
switch(entry_tag) {
case TYPELAYOUT_CONST_TAG: /* and COMP_CONST_TAG */
/* Some builtins need special treatment */
if ((Word) entry_value <= TYPELAYOUT_MAX_VARINT) {
int builtin_type = unmkbody(entry_value);
switch(builtin_type) {
case TYPELAYOUT_UNASSIGNED_VALUE:
fatal_error("Attempt to use an UNASSIGNED tag "
"in table_any");
break;
case TYPELAYOUT_UNUSED_VALUE:
fatal_error("Attempt to use an UNUSED tag "
"in table_any");
break;
case TYPELAYOUT_STRING_VALUE:
Table = (Word**) MR_TABLE_STRING(Table, data);
break;
case TYPELAYOUT_FLOAT_VALUE:
Table = (Word**) MR_TABLE_FLOAT(Table, data);
break;
case TYPELAYOUT_INT_VALUE:
Table = (Word**) MR_TABLE_INT(Table, data);
break;
case TYPELAYOUT_CHARACTER_VALUE:
Table = (Word**) MR_TABLE_CHAR(Table, data);
break;
case TYPELAYOUT_UNIV_VALUE:
{
Table = (Word**) MR_TABLE_TYPE_INFO(Table,
data_value[UNIV_OFFSET_FOR_TYPEINFO]);
Table = (Word**) MR_TABLE_ANY(Table,
data_value[UNIV_OFFSET_FOR_TYPEINFO],
data_value[UNIV_OFFSET_FOR_DATA]);
break;
}
case TYPELAYOUT_PREDICATE_VALUE:
{
Word args = data_value[0];
Table = (Word **) MR_TABLE_WORD(Table, args);
Table = (Word **) MR_TABLE_WORD(Table, data_value[1]);
for (i = 0; i < args; i++) {
Table = (Word **) MR_TABLE_ANY(Table,
(Word *) type_info[i +
TYPEINFO_OFFSET_FOR_PRED_ARGS],
data_value[i+2]);
}
}
case TYPELAYOUT_VOID_VALUE:
fatal_error("Attempt to use a VOID tag in table_any");
break;
case TYPELAYOUT_ARRAY_VALUE:
Table = (Word**) MR_TABLE_ARRAY(Table, data);
break;
case TYPELAYOUT_TYPEINFO_VALUE:
Table = (Word**) MR_TABLE_TYPE_INFO(Table, data_value);
break;
case TYPELAYOUT_C_POINTER_VALUE:
fatal_error("Attempt to use a C_POINTER tag "
"in table");
break;
default:
fatal_error("Invalid tag value in table_any");
break;
}
} else {
if (MR_TYPELAYOUT_ENUM_VECTOR_IS_ENUM(entry_value)) {
Word functors =
MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
Table = (Word**) MR_TABLE_ENUM(Table, functors, data);
} else {
Word functors =
MR_TYPELAYOUT_ENUM_VECTOR_NUM_FUNCTORS(entry_value);
Table = (Word**) MR_TABLE_TAG(Table, data_tag);
Table = (Word**) MR_TABLE_ENUM(Table, functors,
(Word)data_value);
}
}
break;
case TYPELAYOUT_SIMPLE_TAG:
argument_vector = data_value;
arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
type_info_vector = entry_value + TYPELAYOUT_SIMPLE_ARGS_OFFSET;
Table = (Word**) MR_TABLE_TAG(Table, data_tag);
/* copy arguments */
for (i = 0; i < arity; i++) {
new_type_info = make_type_info(type_info,
(Word *) type_info_vector[i], &allocated);
Table = (Word**) MR_TABLE_ANY(Table, new_type_info,
argument_vector[i]);
if (allocated) {
table_free(new_type_info);
}
}
break;
case TYPELAYOUT_COMPLICATED_TAG:
{
Word secondary_tag;
Word num_sharers;
Word *new_entry;
secondary_tag = *data_value;
argument_vector = data_value + 1;
new_entry = (Word *) entry_value[secondary_tag +1];
arity = new_entry[TYPELAYOUT_SIMPLE_ARITY_OFFSET];
type_info_vector = new_entry +
TYPELAYOUT_SIMPLE_ARGS_OFFSET;
Table = (Word**) MR_TABLE_TAG(Table, data_tag);
num_sharers = MR_TYPELAYOUT_COMPLICATED_VECTOR_NUM_SHARERS(
entry_value);
Table = (Word**) MR_TABLE_ENUM(Table, num_sharers, secondary_tag);
for (i = 0; i < arity; i++) {
new_type_info = make_type_info(type_info,
(Word *) type_info_vector[i], &allocated);
Table = (Word**) MR_TABLE_ANY(Table, new_type_info,
argument_vector[i]);
if (allocated) {
table_free(new_type_info);
}
}
break;
}
case TYPELAYOUT_EQUIV_TAG:
/* note: we treat no_tag types just like equivalences */
if ((Word) entry_value < TYPELAYOUT_MAX_VARINT) {
Table = (Word**) MR_TABLE_ANY(Table,
(Word *) type_info[(Word) entry_value], data);
} else {
/*
** offset 0 is no-tag indicator
** offset 1 is the pseudo-typeinfo
** (as per comments in base_type_layout.m)
** XXX should avoid use of hard-coded offset `1' here
*/
new_type_info = make_type_info(type_info,
(Word *) entry_value[1], &allocated);
Table = (Word**) MR_TABLE_ANY(Table, new_type_info, data);
if (allocated) {
table_free(new_type_info);
}
}
break;
default:
fatal_error("Unknown layout tag in table_any");
break;
}
return Table;
} /* end table_any() */
Word
get_base_type_layout_entry(Word data_tag, Word *type_info)
{
Word *base_type_info, *base_type_layout;
base_type_info = (Word *) type_info[0];
if (base_type_info == 0) {
base_type_info = type_info;
}
base_type_layout = (Word *) base_type_info[OFFSET_FOR_BASE_TYPE_LAYOUT];
return base_type_layout[data_tag];
}
/*
** Given a type_info (term_type_info) which contains a
** base_type_info pointer and possibly other type_infos
** giving the values of the type parameters of this type,
** and a pseudo-type_info (arg_pseudo_type_info), which contains a
** base_type_info pointer and possibly other type_infos
** giving EITHER
** - the values of the type parameters of this type,
** or - an indication of the type parameter of the
** term_type_info that should be substituted here
**
** This returns a fully instantiated type_info, a version of the
** arg_pseudo_type_info with all the type variables filled in.
** If there are no type variables to fill in, we return the
** arg_pseudo_type_info, unchanged. Otherwise, we allocate
** memory using malloc(). If memory is allocated, the boolean
** argument (passed by reference) is set to TRUE, otherwise it is
** set to FALSE. It is the caller's responsibility to check whether
** the call to make_type_info allocated memory, and if so, free
** it.
**
** This code could be tighter. In general, we want to
** handle our own allocations rather than using malloc().
** Also, we might be able to do only one traversal.
**
** NOTE: If you are changing this code, you might also need
** to change the code in create_type_info in library/std_util.m,
** which does much the same thing, only allocating on the
** heap instead of using malloc.
*/
Word *
make_type_info(Word *term_type_info, Word *arg_pseudo_type_info,
bool *allocated)
{
int arity, i, extra_args;
Word *base_type_info;
Word *type_info;
*allocated = FALSE;
/*
** The arg_pseudo_type_info might be a polymorphic variable,
** is so - substitute.
*/
if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
return (Word *) term_type_info[(Word) arg_pseudo_type_info];
}
base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(arg_pseudo_type_info);
/* no arguments - optimise common case */
if (base_type_info == arg_pseudo_type_info) {
return arg_pseudo_type_info;
}
if (MR_BASE_TYPEINFO_IS_HO(base_type_info)) {
arity = MR_TYPEINFO_GET_HIGHER_ARITY(arg_pseudo_type_info);
extra_args = 2;
} else {
arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info);
extra_args = 1;
}
/*
** Check for type variables -- if there are none,
** we don't need to create a new type_info.
*/
for (i = arity + extra_args - 1; i >= extra_args; i--) {
if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info[i])) {
break;
}
}
/*
** Do we need to create a new type_info?
*/
if (i >= extra_args) {
type_info = table_allocate((arity + extra_args) * sizeof(Word));
*allocated = TRUE;
/*
** Copy any preliminary arguments to the type_info
** (this means the base_type_info and possibly
** arity for higher order terms).
*/
for (i = 0; i < extra_args; i++) {
type_info[i] = arg_pseudo_type_info[i];
}
/*
** Copy type arguments, substituting for any
** type variables.
*/
for (i = extra_args; i < arity + extra_args; i++) {
if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info[i])) {
type_info[i] = term_type_info[
arg_pseudo_type_info[i]];
if (type_info[i] < TYPELAYOUT_MAX_VARINT) {
fatal_error("make_type_info: "
"unbound type variable.");
}
} else {
type_info[i] = arg_pseudo_type_info[i];
}
}
return type_info;
} else {
return arg_pseudo_type_info;
}
} /* end make_type_info() */
New File: runtime/mercury_table_any.h
===================================================================
#ifndef _MERCURY_TABLE_ANY_H
#define _MERCURY_TABLE_ANY_H
Word ** mercury_table_type(Word *type_info, Word data_value,
Word ** Table);
#endif /* not _MERCURY_TABLE_ANY_H */
New File: runtime/mercury_table_enum.c
===================================================================
/*
** Copyright (C) 1998 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** This module defines the int_index_lookup_or_add() function.
*/
#include "mercury_imp.h"
#define ELEMENT(Table, Key) ((Word**)&(Table[Key]))
/*
** int_index_lookup_or_add() : This function maintains a simple indexed
** table of size Range.
*/
Word **
int_index_lookup_or_add(Word ** T, Integer Key,
Integer Range)
{
Word *Table = *T; /* Deref table */
if (Table == NULL) {
*T = Table = table_allocate(sizeof(Word*)*Range);
memset(Table, 0, sizeof(Word*)*Range);
}
return ELEMENT(Table, Key);
}
New File: runtime/mercury_table_enum.h
===================================================================
#ifndef _MERCURY_TABLE_ENUM_H
#define _MERCURY_TABLE_ENUM_H
Word ** int_index_lookup_or_add(Word **, Integer, Integer);
#endif /* not _MERCURY_TABLE_ENUM_H */
New File: runtime/mercury_table_int_float_string.c
===================================================================
/*
** Copyright (C) 1998 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** This module defines the int_hash_lookup_or_add(), float_hash_lookup_or_add()
** and string_hash_lookup_or_add() function.
*/
#include "mercury_imp.h"
/* Initial size of a new table */
#define TABLE_START_SIZE primes[0]
/* Amount the table is allowed to fill. Must be less than 0.9 if you want
even poor lookup times */
#define MAX_EL_SIZE_RATIO 0.95
/* Extract info from a table */
#define SIZE(Table) (((TableRoot *) Table)->Size)
#define ELEMENTS(Table) (((TableRoot *) Table)->UsedElements)
#define BUCKET(Table, Bucket) ((TableNode **) &(((TableRoot *) Table)-> \
Elements))[(Bucket)]
typedef struct {
Word Key;
Word * Data;
} TableNode;
typedef struct {
Word Size;
Word UsedElements;
Word Elements;
} TableRoot;
static Word next_prime(Word);
static Word * create_hash_table(Word);
static void re_hash(Word *, Word, TableNode * Node);
/*
* Prime numbers which are close to powers of 2. Used for choosing
* the next size for a hash table.
*/
#define NUM_OF_PRIMES 16
static Word primes[NUM_OF_PRIMES] =
{127, 257, 509, 1021, 2053, 4099, 8191, 16381, 32771, 65537, 131071,
262147, 524287, 1048573, 2097143, 4194301};
/*
* Return the next prime number greater than the number received.
* If no such prime number can be found, compute an approximate one.
*/
static Word
next_prime(Word old_size)
{
int i;
i = 0;
while ( (old_size >= primes[i]) && (i < NUM_OF_PRIMES) ) {
i++;
}
if (i < NUM_OF_PRIMES) {
return (primes[i]);
} else {
return (2 * old_size - 1);
}
}
/* Create a new empty hash table */
static Word *
create_hash_table(Word TableSize)
{
Word i;
TableRoot * Table =
table_allocate(sizeof(Word)*2+TableSize*sizeof(TableNode *));
Table->Size = TableSize;
Table->UsedElements = 0;
for (i=0; i<TableSize; i++) {
BUCKET(Table, i) = NULL;
}
return (Word *) Table;
}
/* Insert Key and Data into a new hash table using the given hash.
* This function does not have to do compares as the given key
* is definitely not in the table.
*/
static void
re_hash(Word * Table, Word hash, TableNode * Node)
{
Word bucket = hash % SIZE(Table);
while (BUCKET(Table, bucket)) {
++bucket;
if (bucket == SIZE(Table))
bucket = 0;
}
BUCKET(Table, bucket) = Node;
++ELEMENTS(Table);
}
/* Look to see if the given integer key is in the given table. If it
* is return the address of the data pointer associated with the key.
* If it is not; create a new element for the key in the table and
* return the address of its data pointer
*/
Word **
int_hash_lookup_or_add(Word ** T, Integer Key)
{
TableNode * p, * q;
Word * Table = *T; /* Deref the table pointer */
Word bucket;
/* Has the the table been built? */
if (Table == NULL) {
Table = create_hash_table(TABLE_START_SIZE);
*T = Table;
}
bucket = Key % SIZE(Table);
p = BUCKET(Table, bucket);
/* Find if the element is present. If not add it */
while (p) {
if (Key == p->Key) {
return &p->Data;
}
if (bucket == SIZE(Table))
bucket = 0;
p = BUCKET(Table, bucket);
}
p = table_allocate(sizeof(TableNode));
p->Key = Key;
p->Data = NULL;
/* Rehash the table if it has grown to full */
if ((float)ELEMENTS(Table) / (float)SIZE(Table) > MAX_EL_SIZE_RATIO) {
int old_size = SIZE(Table);
int new_size = next_prime(old_size);
Word * new_table = create_hash_table(new_size);
int i;
for (i = 0; i < old_size; i++) {
q = BUCKET(Table, i);
if (q) {
re_hash(new_table, q->Key, q);
}
}
/* Free the old table */
table_free(Table);
/* Point to the new table */
*T = new_table;
/* Add a new element */
re_hash(new_table, Key, p);
} else {
BUCKET(Table, bucket) = p;
++ELEMENTS(Table);
}
return &p->Data;
}
/* Look to see if the given float key is in the given table. If it
* is return the address of the data pointer associated with the key.
* If it is not create a new element for the key in the table and
* return the address of its data pointer
*/
Word **
float_hash_lookup_or_add(Word ** T, Float Key)
{
TableNode * p, * q;
Word * Table = *T; /* Deref the table pointer */
Word bucket;
Word hash;
/* Has the the table been built? */
if (Table == NULL) {
Table = create_hash_table(TABLE_START_SIZE);
*T = Table;
}
hash = hash_float(Key);
bucket = hash % SIZE(Table);
p = BUCKET(Table, bucket);
/* Find if the element is present. If not add it */
while (p) {
if (Key == word_to_float(p->Key)) {
return &p->Data;
}
++bucket;
if (bucket == SIZE(Table))
bucket = 0;
p = BUCKET(Table, bucket);
}
p = table_allocate(sizeof(TableNode));
p->Key = float_to_word(Key);
p->Data = NULL;
/* Rehash the table if it has grown to full */
if ((float)ELEMENTS(Table) / (float)SIZE(Table) > MAX_EL_SIZE_RATIO) {
int old_size = SIZE(Table);
int new_size = next_prime(old_size);
Word * new_table = create_hash_table(new_size);
int i;
for (i = 0; i < old_size; i++) {
q = BUCKET(Table, i);
if (q) {
re_hash(new_table, hash_float(q->Key), q);
}
}
/* Free the old table */
table_free(Table);
/* Point to the new table */
*T = new_table;
/* Add a new element */
re_hash(new_table, hash, p);
} else {
++ELEMENTS(Table);
BUCKET(Table, bucket) = p;
}
return &p->Data;
}
/* Look to see if the given string key is in the given table. If it
* is return the address of the data pointer associated with the key.
* If it is not create a new element for the key in the table and
* return the address of its data pointer
*/
Word **
string_hash_lookup_or_add(Word ** T, String Key)
{
TableNode * p, * q;
Word * Table = *T; /* Deref the table pointer */
Word bucket;
Word hash;
/* Has the the table been built? */
if (Table == NULL) {
Table = create_hash_table(TABLE_START_SIZE);
*T = Table;
}
hash = hash_string(Key);
bucket = hash % SIZE(Table);
p = BUCKET(Table, bucket);
/* Find if the element is present. */
while (p) {
int res = strtest((String)p->Key, Key);
if (res == 0) {
return &p->Data;
}
++bucket;
if (bucket == SIZE(Table))
bucket = 0;
p = BUCKET(Table, bucket);
}
p = table_allocate(sizeof(TableNode));
p->Key = (Word) Key;
p->Data = NULL;
/* Rehash the table if it has grown to full */
if ((float)ELEMENTS(Table) / (float)SIZE(Table) > MAX_EL_SIZE_RATIO) {
int old_size = SIZE(Table);
int new_size = next_prime(old_size);
Word * new_table = create_hash_table(new_size);
int i;
for (i = 0; i < old_size; i++) {
q = BUCKET(Table, i);
if (q) {
re_hash(new_table, hash_string(q->Key), q);
}
}
/* Free the old table */
table_free(T);
/* Point to the new table */
*T = new_table;
/* Add a new element to rehashed table */
re_hash(new_table, hash, p);
} else {
BUCKET(Table, bucket) = p;
++ELEMENTS(Table);
}
return &p->Data;
}
New File: runtime/mercury_table_int_float_string.h
===================================================================
#ifndef _MERCURY_INT_FLOAT_STRING_H
#define _MERCURY_INT_FLOAT_STRING_H
Word ** int_hash_lookup_or_add(Word ** Table, Integer Key);
Word ** float_hash_lookup_or_add(Word ** Table, Float Key);
Word ** string_hash_lookup_or_add(Word ** Table, String Key);
#endif /* not _MERCURY_INT_FLOAT_STRING_H */
New File: runtime/mercury_table_profile.c
===================================================================
#include <stdio.h>
#include "mercury_imp.h"
#include "mercury_table_profile.h"
Word MR_Table_Prof_WorkingOnAns_Call = 0;
Word MR_Table_Prof_MarkWorkingOnAns_Call = 0;
Word MR_Table_Prof_LookupInsertInt_Call = 0;
Word MR_Table_Prof_LookupInsertChar_Call = 0;
Word MR_Table_Prof_LookupInsertString_Call = 0;
Word MR_Table_Prof_LookupInsertFloat_Call = 0;
Word MR_Table_Prof_LookupInsertEnum_Call = 0;
Word MR_Table_Prof_LookupInsertUser_Call = 0;
Word MR_Table_Prof_LookupInsertPoly_Call = 0;
Word MR_Table_Prof_HaveAns_Call = 0;
Word MR_Table_Prof_HasFailed_Call = 0;
Word MR_Table_Prof_CreateAnsBlock_Call = 0;
Word MR_Table_Prof_SaveIntAns_Call = 0;
Word MR_Table_Prof_SaveCharAns_Call = 0;
Word MR_Table_Prof_SaveStringAns_Call = 0;
Word MR_Table_Prof_SaveFloatAns_Call = 0;
Word MR_Table_Prof_SaveAnyAns_Call = 0;
Word MR_Table_Prof_SaveFailure_Call = 0;
Word MR_Table_Prof_RestoreInt_Call = 0;
Word MR_Table_Prof_RestoreChar_Call = 0;
Word MR_Table_Prof_RestoreString_Call = 0;
Word MR_Table_Prof_RestoreFloat_Call = 0;
Word MR_Table_Prof_RestoreAny_Call = 0;
Word MR_Table_Prof_Setup_Call = 0;
Word MR_Table_Prof_RetAllAns_Call = 0;
Word MR_Table_Prof_GenAnsTable_Call = 0;
Word MR_Table_Prof_HaveAllAns_Call = 0;
Word MR_Table_Prof_HaveSomeAns_Call = 0;
Word MR_Table_Prof_NewAns_Call = 0;
Word MR_Table_Prof_MarkHaveAllAns_Call = 0;
Word MR_Table_Prof_MarkHaveSomeAns_Call = 0;
Word MR_Table_Prof_MarkAsReturned_Call = 0;
Word MR_Table_Prof_Suspend_Call = 0;
Word MR_Table_Prof_Resume_Call = 0;
Word MR_Table_Prof_NewAnsSlot_Call = 0;
Word MR_Table_Prof_MemCpy_Call = 0;
Word MR_Table_Prof_Malloc_Call = 0;
Word MR_Table_Prof_Reallc_Call = 0;
Word MR_Table_Prof_Free_Call = 0;
Word MR_Table_Prof_Moved_Mem = 0;
Word MR_Table_Prof_Malloc_Mem = 0;
Word MR_Table_Prof_Realloc_Mem = 0;
void
table_dump_profile()
{
printf(" Profilng stats for table operation\n");
printf(" Number of calls to TableHasFailed = %d \n",
(int) MR_Table_Prof_HasFailed_Call);
printf(" Number of calls to TableCreateAnsBlock = %d \n",
(int) MR_Table_Prof_CreateAnsBlock_Call);
printf(" Number of calls to TableSaveIntAns = %d \n",
(int) MR_Table_Prof_SaveIntAns_Call);
printf(" Number of calls to TableSaveCharAns = %d \n",
(int) MR_Table_Prof_SaveCharAns_Call);
printf(" Number of calls to TableSaveStringAns = %d \n",
(int) MR_Table_Prof_SaveStringAns_Call);
printf(" Number of calls to TableSaveFloatAns = %d \n",
(int) MR_Table_Prof_SaveFloatAns_Call);
printf(" Number of calls to TableSaveAnyAns = %d \n",
(int) MR_Table_Prof_SaveAnyAns_Call);
printf(" Number of calls to TableSaveFailure = %d \n",
(int) MR_Table_Prof_SaveFailure_Call);
printf(" Number of calls to TableRestoreInt = %d \n",
(int) MR_Table_Prof_RestoreInt_Call);
printf(" Number of calls to TableRestoreChar = %d \n",
(int) MR_Table_Prof_RestoreChar_Call);
printf(" Number of calls to TableRestoreString = %d \n",
(int) MR_Table_Prof_RestoreString_Call);
printf(" Number of calls to TableRestoreFloat = %d \n",
(int) MR_Table_Prof_RestoreFloat_Call);
printf(" Number of calls to TableRestoreAny = %d \n",
(int) MR_Table_Prof_RestoreAny_Call);
printf(" Number of calls to TableSetup = %d \n",
(int) MR_Table_Prof_Setup_Call);
printf(" Number of calls to TableRetAllAns = %d \n",
(int) MR_Table_Prof_RetAllAns_Call);
printf(" Number of calls to TableGenAnsTable = %d \n",
(int) MR_Table_Prof_GenAnsTable_Call);
printf(" Number of calls to TableHaveAllAns = %d \n",
(int) MR_Table_Prof_HaveAllAns_Call);
printf(" Number of calls to TableHaveSomeAns = %d \n",
(int) MR_Table_Prof_HaveSomeAns_Call);
printf(" Number of calls to TableNewAns = %d \n",
(int) MR_Table_Prof_NewAns_Call);
printf(" Number of calls to TableMarkHaveAllAns = %d \n",
(int) MR_Table_Prof_MarkHaveAllAns_Call);
printf(" Number of calls to TableMarkHaveSomeAns = %d \n",
(int) MR_Table_Prof_MarkHaveSomeAns_Call);
printf(" Number of calls to TableMarkAsReturned = %d \n",
(int) MR_Table_Prof_MarkAsReturned_Call);
printf(" Number of calls to TableSuspend = %d \n",
(int) MR_Table_Prof_Suspend_Call);
printf(" Number of calls to TableResume = %d \n",
(int) MR_Table_Prof_Resume_Call);
printf(" Number of calls to TableNewAnsSlot = %d \n",
(int) MR_Table_Prof_NewAnsSlot_Call);
printf(" Number of calls to TableMemCpy = %d Bytes moved %d\n",
(int) MR_Table_Prof_MemCpy_Call,
(int) MR_Table_Prof_Moved_Mem);
printf(" Number of calls to TableMalloc = %d Bytes allocated %d\n",
(int) MR_Table_Prof_Malloc_Call,
(int) MR_Table_Prof_Malloc_Mem);
printf(" Number of calls to TableReallc = %d Bytes reallocated %d\n",
(int) MR_Table_Prof_Reallc_Call,
(int) MR_Table_Prof_Realloc_Mem);
printf(" Number of calls to TableFree = %d \n",
(int) MR_Table_Prof_Free_Call);
}
New File: runtime/mercury_table_profile.h
===================================================================
#ifndef _MERCURY_TABLE_PROFILE
#define _MERCURY_TABLE_PROFILE
extern Word MR_Table_Prof_WorkingOnAns_Call;
extern Word MR_Table_Prof_MarkWorkingOnAns_Call;
extern Word MR_Table_Prof_LookupInsertInt_Call;
extern Word MR_Table_Prof_LookupInsertChar_Call;
extern Word MR_Table_Prof_LookupInsertString_Call;
extern Word MR_Table_Prof_LookupInsertFloat_Call;
extern Word MR_Table_Prof_LookupInsertEnum_Call;
extern Word MR_Table_Prof_LookupInsertUser_Call;
extern Word MR_Table_Prof_LookupInsertPoly_Call;
extern Word MR_Table_Prof_HaveAns_Call;
extern Word MR_Table_Prof_HasFailed_Call;
extern Word MR_Table_Prof_CreateAnsBlock_Call;
extern Word MR_Table_Prof_SaveIntAns_Call;
extern Word MR_Table_Prof_SaveCharAns_Call;
extern Word MR_Table_Prof_SaveStringAns_Call;
extern Word MR_Table_Prof_SaveFloatAns_Call;
extern Word MR_Table_Prof_SaveAnyAns_Call;
extern Word MR_Table_Prof_SaveFailure_Call;
extern Word MR_Table_Prof_RestoreInt_Call;
extern Word MR_Table_Prof_RestoreChar_Call;
extern Word MR_Table_Prof_RestoreString_Call;
extern Word MR_Table_Prof_RestoreFloat_Call;
extern Word MR_Table_Prof_RestoreAny_Call;
extern Word MR_Table_Prof_Setup_Call;
extern Word MR_Table_Prof_RetAllAns_Call;
extern Word MR_Table_Prof_GenAnsTable_Call;
extern Word MR_Table_Prof_HaveAllAns_Call;
extern Word MR_Table_Prof_HaveSomeAns_Call;
extern Word MR_Table_Prof_NewAns_Call;
extern Word MR_Table_Prof_MarkHaveAllAns_Call;
extern Word MR_Table_Prof_MarkHaveSomeAns_Call;
extern Word MR_Table_Prof_MarkAsReturned_Call;
extern Word MR_Table_Prof_Suspend_Call;
extern Word MR_Table_Prof_Resume_Call;
extern Word MR_Table_Prof_NewAnsSlot_Call;
extern Word MR_Table_Prof_MemCpy_Call;
extern Word MR_Table_Prof_Malloc_Call;
extern Word MR_Table_Prof_Reallc_Call;
extern Word MR_Table_Prof_Free_Call;
extern Word MR_Table_Prof_Moved_Mem;
extern Word MR_Table_Prof_Malloc_Mem;
extern Word MR_Table_Prof_Realloc_Mem;
void table_dump_profile(void);
#endif _MERCURY_TABLE_PROFILE /* not _MERCURY_TABLE_PROFILE */
New File: runtime/mercury_table_type_info.c
===================================================================
/*
** Copyright (C) 1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** This module defines the type_info_lookup_or_add() function.
*/
#include "mercury_imp.h"
#include "mercury_table_type_info.h"
typedef struct _tree_node {
Word * Key;
Word Value;
struct _tree_node * Right;
struct _tree_node * Left;
} TreeNode;
Word **
type_info_lookup_or_add(Word ** Table, Word * TypeInfo)
{
TreeNode *p, *q;
int i;
if (*Table == NULL) {
p = table_allocate(sizeof(TreeNode));
p->Key = TypeInfo;
p->Value = (Word) NULL;
p->Left = NULL;
p->Right = NULL;
*Table = (Word *) p;
return (Word**) &p->Value;
}
p = (TreeNode*) *Table;
while (p != NULL) {
i = MR_compare_type_info((Word) p->Key, (Word) TypeInfo);
if (i == COMPARE_EQUAL) {
return (Word**) &p->Value;
}
q = p;
if (i == COMPARE_LESS) {
p = p->Left;
} else {
p = p->Right;
}
}
p = table_allocate(sizeof(TreeNode));
p->Key = TypeInfo;
p->Value = (Word) NULL;
p->Left = NULL;
p->Right = NULL;
if (i == COMPARE_LESS) {
q->Left = p;
} else {
q ->Right = p;
}
return (Word**) &p->Value;
}
New File: runtime/mercury_table_type_info.h
===================================================================
#ifndef _MERCURY_TABLE_TYPE_INFO
#define _MERCURY_TABLE_TYPE_INFO
Word ** type_info_lookup_or_add(Word **, Word *);
#endif /* not _MERCURY_TABLE_TYPE_INFO */
New File: runtime/mercury_tabling.h
===================================================================
/*
** Copyright (C) 1995-1997 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** mercury_tabling.h - definitions of some basic macros used by the tabling
** code generated by the Mercury compiler and by the Mercury runtime.
*/
#ifndef _MERCURY_TABLING_H
#define _MERCURY_TABLING_H
#include "mercury_table_enum.h"
#include "mercury_table_any.h"
#include "mercury_table_profile.h"
#include "mercury_table_type_info.h"
#include "mercury_table_int_float_string.h"
#define MR_TABLE_DEBUG
#define MR_TABLE_PROFILING
#define MR_TABLE_WORD(Table, Value) \
(Word) int_hash_lookup_or_add(Table, (Integer)Value);
#define MR_TABLE_INT(Table, Value) \
(Word) int_hash_lookup_or_add(Table, Value);
#define MR_TABLE_FLOAT(Table, Value) \
(Word) float_hash_lookup_or_add(Table, Value);
#define MR_TABLE_CHAR(Table, Value) \
(Word) int_hash_lookup_or_add(Table, (Integer)Value);
#define MR_TABLE_STRING(Table, Value) \
(Word) string_hash_lookup_or_add(Table, (String)Value);
#define MR_TABLE_ENUM(Table, Range, Value) \
(Word) int_index_lookup_or_add(Table, Value, Range)
#define MR_TABLE_ARRAY(Table, Array) \
(Word**)0;fatal_error("Tabling of arrays not yet supported")
#define MR_TABLE_TAG(Table, Tag) \
(Word) int_index_lookup_or_add(Table, Tag, 1 << TAGBITS)
#define MR_TABLE_TYPE_INFO(Table, Type) \
(Word) type_info_lookup_or_add(Table, (Word*) Type)
#define MR_TABLE_ANY(Table, TypeInfo, Value) \
(Word) mercury_table_type((Word*)TypeInfo, Value, (Word**)Table)
#define MR_TABLE_CREATE_ANSWER_BLOCK(AnswerBlock, Elements) \
do { \
*((Word**)AnswerBlock) = \
pool_alloc(sizeof(Word)*Elements); \
} while(0)
#define MR_TABLE_GET_ANSWER(Offset, AnswerBlock) \
(*((Word**)AnswerBlock))[Offset]
#ifdef CONSERVATIVE_GC
#define MR_TABLE_SAVE_ANSWER(Offset, AnswerBlock, Value, TypeInfo) \
do { \
(*((Word**)AnswerBlock))[Offset] = Value; \
} while(0)
#else /* not CONSERVATIVE_GC */
#define MR_TABLE_SAVE_ANSWER(Offset, AnswerBlock, Value, TypeInfo) \
do { \
(*((Word**)AnswerBlock))[Offset] = \
deep_copy(Value, &TypeInfo, NULL, NULL); \
restore_transient_registers(); \
} while(0)
#endif /* CONSERVATIVE_GC */
#ifdef MR_TABLE_PROFILING
#define append3(Var1, Var2, Var3) \
Var1 ## Var2 ## Var3
#define TABLE_PROFILE_CALL(Func) \
++append3(MR_Table_Prof_, Func, _Call);
#define TABLE_PROFILE_MEMMOVE(Size) \
++MR_Table_Prof_MemCpy_Call; \
MR_Table_Prof_Moved_Mem += Size;
#define TABLE_PROFILE_MALLOC(Size) \
++MR_Table_Prof_Malloc_Call; \
MR_Table_Prof_Malloc_Mem += Size;
#define TABLE_PROFILE_REALLOC(Size) \
++MR_Table_Prof_Reallc_Call; \
MR_Table_Prof_Realloc_Mem += Size;
#define TABLE_PROFILE_FREE() \
++MR_Table_Prof_Free_Call;
#define table_allocate(Size) \
GC_malloc(Size); \
TABLE_PROFILE_MALLOC(Size);
#define table_reallocate(Pointer, Size) \
GC_realloc(Pointer, Size); \
TABLE_PROFILE_REALLOC(Size);
#define table_free(Pointer) \
GC_free(Pointer); \
TABLE_PROFILE_FREE();
#define table_copy_mem(Dest, Source, Size) \
memcpy(Dest, Source, Size); \
TABLE_PROFILE_MEMMOVE(Size);
#else /* not MR_TABLE_PROFILING */
#define TABLE_PROFILE_CALL(Func)
#define TABLE_PROFILE_MEMMOVE(Size)
#define TABLE_PROFILE_MALLOC(Size)
#define TABLE_PROFILE_REALLOC(Pointer, Size)
#define TABLE_PROFILE_FREE()
#define table_allocate(Size) \
GC_malloc(Size);
#define table_reallocate(Pointer, Size) \
GC_realloc(Pointer, Size);
#define table_free(Pointer) \
GC_free(Pointer);
#define table_copy_mem(Dest, Source, Size) \
memcpy(Dest, Source, Size);
#endif /* not MR_TABLE_PROFILING */
#ifdef MR_TABLE_DEBUG
#include <stdio.h>
#include <varargs.h>
static void table_printf(const char*, ...);
static void table_printf(const char *A, ...)
{
va_list list;
va_start(list);
vprintf(A, list);
}
#else /* not MR_TABLE_DEBUG */
static void table_printf(const char*, ...);
static void table_printf(const char *A, ...)
{
}
#endif /* not MR_TABLE_DEBUG */
#endif /* not MERCURY_TABLING_H */
More information about the developers
mailing list