[m-rev.] semidet code managed in ssdb
Olivier Annet
oan at missioncriticalit.com
Sat Oct 27 20:30:58 AEST 2007
Hi,
could someone review my code before the commit please.
===================================================================
Estimated hours taken: 50
Branches: main
The source-to-source debugger is able to manage the semidet predicate/function
now.
compiler/ssdebug.m:
Modification to manage the semidet function.
Optimization in the generation of the goal's argument at exit point.
ssdb/ssdb.m:
Correction of some bugs in the prompt.
tools/lmc.in:
Search in the `ssdb' directory for C header files and modules.
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.6
diff -u -r1.6 ssdebug.m
--- compiler/ssdebug.m 18 Oct 2007 14:59:44 -0000 1.6
+++ compiler/ssdebug.m 26 Oct 2007 06:06:35 -0000
@@ -149,6 +149,7 @@
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
+:- import_module check_hlds.purity.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.instmap.
@@ -177,9 +178,51 @@
%-----------------------------------------------------------------------------%
-process_proc(PredId, _ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ %
+ % Switch on the determinism used. It's the compiler determinism which
+ % is used. The determinism for the goal migth be the same.
+ %
+process_proc(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+
+ proc_info_get_inferred_determinism(!.ProcInfo, Determinism),
+
+ ( Determinism = detism_det,
+ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+
+ ; Determinism = detism_semi,
+ process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+
+ ; Determinism = detism_multi,
+ error("determ_multi: not yet implemented in ssdb")
+
+ ; Determinism = detism_non,
+ error("determ_non: not yet implemented in ssdb")
+
+ ; Determinism = detism_cc_multi,
+ error("determ_cc_multi: not yet implemented in ssdb")
+
+ ; Determinism = detism_cc_non,
+ error("detism_cc_non: not yet implemented in ssdb")
+
+ ; Determinism = detism_erroneous,
+ error("detism_erroneous: not yet implemented in ssdb")
+
+ ; Determinism = detism_failure,
+ error("detism_failure: not yet implemented in ssdb")
+
+ ).
+
+ %
+ % Generate code for a deterministic goal
+ %
+:- pred process_proc_det(pred_id::in, proc_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
proc_info_get_goal(!.ProcInfo, Goal0),
-
+ HldsGoalInfo = get_hlds_goal_info(Goal0),
+
some [!PredInfo, !Varset, !Vartypes] (
proc_info_get_varset(!.ProcInfo, !:Varset),
proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
@@ -196,120 +239,241 @@
%
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
-
- %
+
+ %
% Make a list which records the value for each of the head variables at
% the call port.
%
- make_call_list_arg(ssdb_call, InitInstMap, HeadVars, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes),
+ make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, map.init, BoundVarDescsAtCall),
%
% Generate the call.
% Generate the call to handle_event(call).
- % Return a list of goals.
%
- make_handle_event_call(ssdb_call, ProcIdVar, CallArgListVar,
+ make_call_handle_event(ssdb_call, ProcIdVar, CallArgListVar,
HandleEventCallGoals, !ModuleInfo, !Varset, !Vartypes),
-
+
%
% Get the updated InstMap.
%
update_instmap(Goal0, InitInstMap, UpdatedInstMap),
- %
+ %
+ % Rename the variable
+ %
+ proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
+ InstantiatedVars),
+ goal_info_get_instmap_delta(HldsGoalInfo) = InstMapDelta,
+ create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
+ RenamingGoals, _NewVars, Renaming),
+ rename_some_vars_in_goal(Renaming, Goal0, Goal1),
+
+ %
% Make the variable list at the exit port. It's currently a completely
% new list instead of adding on to the list generated for the call
% port.
%
- % XXX Optimization : Only output variables should be regenerated.
- %
- make_call_list_arg(ssdb_exit, UpdatedInstMap, HeadVars, ExitArgListVar,
- ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes),
+ make_arg_list(0, UpdatedInstMap, HeadVars, Renaming, ExitArgListVar,
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
%
% Generate the exit.
% Generate the call to handle_event(exit).
- % Return a list of goals.
%
- make_handle_event_call(ssdb_exit, ProcIdVar, ExitArgListVar,
+ make_call_handle_event(ssdb_exit, ProcIdVar, ExitArgListVar,
HandleEventExitGoals, !ModuleInfo, !Varset, !Vartypes),
%
- % Place the call and exit events around the initial goal.
+ % Organize the order of the generated code.
%
ConjGoals = ProcIdGoals ++ CallArgListGoals ++ HandleEventCallGoals ++
- [Goal0 | ExitArgListGoals] ++ HandleEventExitGoals,
+ [Goal1 | ExitArgListGoals] ++ HandleEventExitGoals ++ RenamingGoals,
+ goal_info_init(GoalInfoWP),
+ GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoals), GoalInfoWP),
+
+ %
+ % Get the purity of the goal
+ %
+ Purity = goal_info_get_purity(HldsGoalInfo),
+ ScopeReason = promise_purity(dont_make_implicit_promises, Purity),
goal_info_init(GoalInfo),
- Goal = hlds_goal(conj(plain_conj, ConjGoals), GoalInfo),
+ Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo),
- proc_info_set_varset(!.Varset, !ProcInfo),
- proc_info_set_vartypes(!.Vartypes, !ProcInfo),
+ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.Varset, !.Vartypes)
+ ).
- proc_info_set_goal(Goal, !ProcInfo),
- requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ %
+ % Generate code for un semi-det goal
+ %
+:- pred process_proc_semi(pred_id::in, proc_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
- module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
- ).
+process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ proc_info_get_goal(!.ProcInfo, Goal0),
+ some [!PredInfo, !Varset, !Vartypes] (
+ proc_info_get_varset(!.ProcInfo, !:Varset),
+ proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
+ %
+ % Make the ssdb_proc_id.
+ %
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
+ ProcIdVar, !Varset, !Vartypes),
+
+ %
+ % Get list(prog_var) and there type.
+ %
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
+ %
+ % Make a list which records the value for each of the head variables at
+ % the call port.
+ %
+ make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, map.init, BoundVarDescsAtCall),
-:- pred make_call_list_arg(ssdb_event_type::in, instmap::in,
- list(prog_var)::in, prog_var::out, list(hlds_goal)::out,
- module_info::in, module_info::out, proc_info::in, proc_info::out,
- pred_info::in, pred_info::out, prog_varset::in, prog_varset::out,
- vartypes::in, vartypes::out) is det.
+ %
+ % Generate the call.
+ % Generate the call to handle_event(call).
+ %
+ make_call_handle_event(ssdb_call, ProcIdVar, CallArgListVar,
+ HandleEventCallGoals, !ModuleInfo, !Varset, !Vartypes),
-make_call_list_arg(Event, InstMap, HeadVars, ArgListVar, ArgListGoals,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes) :-
+ %
+ % Get the updated InstMap.
+ %
+ update_instmap(Goal0, InitInstMap, UpdatedInstMap),
- (
- ( Event = ssdb_call
- ; Event = ssdb_exit
- ),
-
%
- % Make the list of argument at call/exit point
+ % Rename the variable
%
- make_arg_list(0, InstMap, HeadVars, ArgListVar, ArgListGoals,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes)
+ proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
+ InstantiatedVars),
+ get_hlds_goal_info(Goal0) = HldsGoalInfo,
+ goal_info_get_instmap_delta(HldsGoalInfo) = InstMapDelta,
+ create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
+ RenamingGoals, _NewVars, Renaming),
+ rename_some_vars_in_goal(Renaming, Goal0, Goal1),
+
+ %
+ % Make the variable list at the exit port. It's currently a completely
+ % new list instead of adding on to the list generated for the call
+ % port.
+ %
+ make_arg_list(0, UpdatedInstMap, HeadVars, Renaming, ExitArgListVar,
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
- ;
- ( Event = ssdb_fail
- ; Event = ssdb_redo
- ),
+ %
+ % Generate the exit.
+ % Generate the call to handle_event(exit).
+ %
+ make_call_handle_event(ssdb_exit, ProcIdVar, ExitArgListVar,
+ HandleEventExitGoals, !ModuleInfo, !Varset, !Vartypes),
+
+
+ %
+ % Generate the goal's list argument.
+ %
+ make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
+ FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
%
- % Make the list of argument at fail/redo point
- % Need only to generate the empty list.
+ % Generate the fail.
+ % Generate the call to handle_event(fail).
+ %
+ make_call_handle_event(ssdb_fail, ProcIdVar, FailArgListVar,
+ HandleEventFailGoals, !ModuleInfo, !Varset, !Vartypes),
+
+ make_fail(FailGoal, !.ModuleInfo),
+
+
%
- make_arg_list(0, InstMap, HeadVars, ArgListVar, ArgListGoals,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes)
+ % Organize the order of the generated code.
+ %
+ CallVarGoal = ProcIdGoals ++ CallArgListGoals ++ HandleEventCallGoals,
+ GoalsIf = [Goal1],
+ GoalsThen = ExitArgListGoals ++ HandleEventExitGoals ++ RenamingGoals,
+ GoalsElse = FailArgListGoals ++ HandleEventFailGoals ++ [FailGoal],
+
+ goal_info_init(GoalInfo0),
+ goal_list_determinism(GoalsIf, Detism),
+ goal_info_set_determinism(Detism, GoalInfo0, GoalInfo),
+
+ goal_info_set_determinism(detism_det, GoalInfo0, GoalInfoThen),
+ goal_info_set_determinism(detism_semi, GoalInfo0, GoalInfoElse),
+
+ IteExistVars = [],
+ IfGoal = hlds_goal(conj(plain_conj, GoalsIf), GoalInfo),
+ ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), GoalInfoThen),
+ ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), GoalInfoElse),
+
+ % XXX not sure about determinism
+ GoalITE = hlds_goal(if_then_else(IteExistVars, IfGoal, ThenGoal,
+ ElseGoal), GoalInfo),
+
+ ConjGoal = CallVarGoal ++ [GoalITE],
+ GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoal), GoalInfo),
+
+ %
+ % Get the purity of the initial goal.
+ %
+ Purity = goal_info_get_purity(HldsGoalInfo),
+ ScopeReason = promise_purity(dont_make_implicit_promises, Purity),
+ Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo),
+
+ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.Varset, !.Vartypes)
).
+:- pred commit_goal_changes(hlds_goal::in, pred_id::in, proc_id::in,
+ pred_info::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, prog_varset::in, vartypes::in) is det.
+
+commit_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo, !ModuleInfo,
+ Varset, Vartypes) :-
+ proc_info_set_varset(Varset, !ProcInfo),
+ proc_info_set_vartypes(Vartypes, !ProcInfo),
+
+ proc_info_set_goal(Goal, !ProcInfo),
+
+ requantify_proc(!ProcInfo),
+ recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, !.ProcInfo, !PredInfo),
+ repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
-:- pred make_handle_event_call(ssdb_event_type::in, prog_var::in,
+
+%-----------------------------------------------------------------------------%
+
+
+ %
+ % Build the following goal : handle_event(ProcId, Event, ListOfArgument).
+ %
+:- pred make_call_handle_event(ssdb_event_type::in, prog_var::in,
prog_var::in, list(hlds_goal)::out, module_info::in, module_info::out,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
-make_handle_event_call(Event, ProcIdVar, ArgListVar, Goals, !ModuleInfo,
+make_call_handle_event(Event, ProcIdVar, ArgListVar, Goals, !ModuleInfo,
!Varset, !Vartypes) :-
make_ssdb_event_type_construction(Event, EventConstructor, EventVar,
!Varset, !Vartypes),
- %
- % Build the following goal
- % handle_event(ProcId, Event, VarList).
- %
SSDBModule = mercury_ssdb_builtin_module,
Features = [],
InstMapSrc = [],
@@ -321,7 +485,6 @@
Goals = [EventConstructor, HandleEventGoal].
-%-----------------------------------------------------------------------------%
%
% make_proc_id_construction(PredInfo, ProcInfo,
@@ -332,8 +495,7 @@
% ssdb_proc_id.
%
:- pred make_proc_id_construction(pred_info::in, proc_info::in,
- hlds_goals::out, prog_var::out,
- prog_varset::in, prog_varset::out,
+ hlds_goals::out, prog_var::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out) is det.
make_proc_id_construction(PredInfo,
@@ -360,6 +522,22 @@
Goals = [ConstructModuleName, ConstructPredName, ConstructProcIdGoal].
+
+ %
+ % make_fail(FailGoal, ModuleInfo)
+ %
+ % Contruct the fail goal.
+ %
+:- pred make_fail(hlds_goal::out, module_info::in) is det.
+
+make_fail(FailGoal, ModuleInfo) :-
+ Features = [],
+ InstMapSrc = [],
+ Context = term.context_init,
+ goal_util.generate_simple_call(mercury_public_builtin_module,
+ "false", pf_predicate, only_mode, detism_failure, purity_pure,
+ [], Features, InstMapSrc, ModuleInfo, Context, FailGoal).
+
%-----------------------------------------------------------------------------%
@@ -374,27 +552,37 @@
% to display.
%
:- pred make_arg_list(int::in, instmap::in, list(prog_var)::in,
- prog_var::out, list(hlds_goal)::out, module_info::in, module_info::out,
- proc_info::in, proc_info::out, pred_info::in, pred_info::out,
- prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
+ map(prog_var, prog_var)::in, prog_var::out, list(hlds_goal)::out,
+ module_info::in, module_info::out, proc_info::in, proc_info::out,
+ pred_info::in, pred_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out,
+ map(prog_var, prog_var)::in, map(prog_var, prog_var)::out) is det.
-make_arg_list(_, _, [], Var, [Goal], !ModuleInfo, !ProcInfo, !PredInfo,
- !Varset, !Vartypes) :-
+make_arg_list(_, _, [], _, Var, [Goal], !ModuleInfo, !ProcInfo, !PredInfo,
+ !Varset, !Vartypes, !BoundVarDescs) :-
svvarset.new_named_var("EmptyVarList", Var, !Varset),
svmap.det_insert(Var, list_var_value_type, !Vartypes),
ConsId = cons(qualified(unqualified("list"), "[]" ), 0),
construct_functor(Var, ConsId, [], Goal).
-make_arg_list(Pos0, InstMap, [VarToInspect | ListCallVar], Var, Goals,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes) :-
+make_arg_list(Pos0, InstMap, [VarToInspect | ListCallVar], Renaming, Var,
+ Goals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes,
+ !BoundVarDescs) :-
Pos = Pos0 + 1,
- make_arg_list(Pos, InstMap, ListCallVar, Var0, Goals0,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes),
- make_var_value(InstMap, VarToInspect, VarDesc, Pos0, ValueGoals,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes),
+ make_arg_list(Pos, InstMap, ListCallVar, Renaming, Var0, Goals0,
+ !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes, !BoundVarDescs),
+
+ ( map.search(!.BoundVarDescs, VarToInspect, ExistingVarDesc) ->
+ ValueGoals = [],
+ VarDesc = ExistingVarDesc
+ ;
+ make_var_value(InstMap, VarToInspect, Renaming, VarDesc, Pos0,
+ ValueGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes,
+ !BoundVarDescs)
+ ),
svvarset.new_named_var("FullListVar", Var, !Varset),
svmap.det_insert(Var, list_var_value_type, !Vartypes),
@@ -426,22 +614,23 @@
% -> unbound_head_var(Name, Pos) if it is an unbound argument
% -> bound_head_var(type_of_T, Name, Position, T) if it is a bound argument
%
-:- pred make_var_value(instmap::in, prog_var::in, prog_var::out,
- int::in, list(hlds_goal)::out, module_info::in, module_info::out,
- proc_info::in, proc_info::out, pred_info::in, pred_info::out,
- prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
+:- pred make_var_value(instmap::in, prog_var::in, map(prog_var, prog_var)::in,
+ prog_var::out, int::in, list(hlds_goal)::out,
+ module_info::in, module_info::out, proc_info::in, proc_info::out,
+ pred_info::in, pred_info::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, map(prog_var, prog_var)::in,
+ map(prog_var, prog_var)::out) is det.
-make_var_value(InstMap, VarToInspect, VarDesc, VarPos, Goals,
- !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes) :-
+make_var_value(InstMap, VarToInspect, Renaming, VarDesc, VarPos, Goals,
+ !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes, !BoundVarDescs) :-
SSDBModule = mercury_ssdb_builtin_module,
TypeCtor = type_ctor(qualified(SSDBModule, "var_value"), 0),
- % Find the name of the prog_var.
varset.lookup_name(!.VarSet, VarToInspect, VarName),
-
+
make_string_const_construction_alloc(VarName, yes("VarName"),
ConstructVarName, VarNameVar, !VarSet, !VarTypes),
@@ -450,15 +639,16 @@
( var_is_ground_in_instmap(!.ModuleInfo, InstMap, VarToInspect) ->
- %
- % Update proc_varset and proc_vartypes, without this, the
- % polymorphism_make_type_info_var uses a prog_var which is
- % already bound.
- %
- proc_info_set_varset(!.VarSet, !ProcInfo),
- proc_info_set_vartypes(!.VarTypes, !ProcInfo),
- %
+ %
+ % Update proc_varset and proc_vartypes, without this, the
+ % polymorphism_make_type_info_var uses a prog_var which is
+ % already bound.
+ %
+ proc_info_set_varset(!.VarSet, !ProcInfo),
+ proc_info_set_vartypes(!.VarTypes, !ProcInfo),
+
+ %
% Create dynamic constructor for the value of the argument.
%
% Call polymorphism.m to create the type_infos, add an hidden field
@@ -467,31 +657,44 @@
% some[T] bound_head_var(string, int, T) ---->
% some[T] bound_head_var(type_of_T, string, int, T)
%
- create_poly_info(!.ModuleInfo, !.PredInfo, !.ProcInfo,
- PolyInfo0),
- term.context_init(Context),
- map.lookup(!.VarTypes, VarToInspect, MerType),
- polymorphism_make_type_info_var(MerType, Context, TypeInfoVar,
- TypeInfoGoal, PolyInfo0, PolyInfo),
- poly_info_extract(PolyInfo, !PredInfo, !ProcInfo,
- !:ModuleInfo),
-
- %
- % Give a new prog_var to the polymorphic structure.
- %
- svvarset.new_named_var("VarType", VarTypo, !VarSet),
- svmap.det_insert(VarTypo, MerType, !VarTypes),
+ create_poly_info(!.ModuleInfo, !.PredInfo, !.ProcInfo,
+ PolyInfo0),
+ term.context_init(Context),
+ map.lookup(!.VarTypes, VarToInspect, MerType),
+ polymorphism_make_type_info_var(MerType, Context, TypeInfoVar,
+ TypeInfoGoal, PolyInfo0, PolyInfo),
+ poly_info_extract(PolyInfo, !PredInfo, !ProcInfo,
+ !:ModuleInfo),
+
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
+
+ %
+ % Give a new prog_var to the polymorphic structure.
+ %
+ svvarset.new_named_var("VarType", VarTypo, !VarSet),
+ svmap.det_insert(VarTypo, MerType, !VarTypes),
% Constructor of the variable's description.
svvarset.new_named_var("VarDesc", VarDesc, !VarSet),
ConsId = cons(qualified(SSDBModule, "bound_head_var"), 3),
construct_type(TypeCtor, [], VarType),
svmap.det_insert(VarDesc, VarType, !VarTypes),
- construct_functor(VarDesc, ConsId, [TypeInfoVar, VarNameVar,
- VarPosVar, VarToInspect], ConstructVarGoal),
+
+ ( map.is_empty(Renaming) ->
+ construct_functor(VarDesc, ConsId, [TypeInfoVar, VarNameVar,
+ VarPosVar, VarToInspect], ConstructVarGoal)
+ ;
+ map.lookup(Renaming, VarToInspect, RenamedVar),
+ construct_functor(VarDesc, ConsId, [TypeInfoVar, VarNameVar,
+ VarPosVar, RenamedVar], ConstructVarGoal)
+ ),
Goals = [ConstructVarName, ConstructVarPos | TypeInfoGoal] ++
- [ConstructVarGoal]
+ [ConstructVarGoal],
+
+ svmap.det_insert(VarToInspect, VarDesc, !BoundVarDescs)
+
;
svvarset.new_named_var("VarDesc", VarDesc, !VarSet),
ConsId = cons(qualified(SSDBModule, "unbound_head_var"), 2),
Index: ssdb/ssdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
retrieving revision 1.6
diff -u -r1.6 ssdb.m
--- ssdb/ssdb.m 18 Oct 2007 08:27:08 -0000 1.6
+++ ssdb/ssdb.m 26 Oct 2007 06:06:35 -0000
@@ -173,6 +173,7 @@
% XXX Not yet implemented : redo, fail.
%
handle_event(ProcId, Event, ListVarValue) :-
+
impure get_event_num_inc(EventNum),
impure update_depth(Event, PrintDepth),
@@ -180,6 +181,7 @@
Event = ssdb_call,
% set the new CSN.
impure get_csn_inc(_),
+
% set the list_var_value of the debugger state with the list received
impure set_list_var_value(ListVarValue),
@@ -197,12 +199,14 @@
impure set_list_var_value_in_stack(ListVarValue),
semipure get_debugger_state(InitialState),
stack.top_det(InitialState ^ ssdb_stack, StackFrame)
+
;
Event = ssdb_redo,
error("ssdb_redo: not yet implemented")
;
Event = ssdb_fail,
- error("ssdb_fail: not yet implemented")
+ semipure get_debugger_state(InitialState),
+ stack.top_det(InitialState ^ ssdb_stack, StackFrame)
),
semipure get_debugger_state(State0),
@@ -228,7 +232,9 @@
;
NextStop0 = ns_final_port(StopCSN),
(
- Event = ssdb_exit,
+ ( Event = ssdb_exit
+ ; Event = ssdb_fail
+ ),
is_same_event(StopCSN, CSN, Stop)
;
Event = ssdb_call,
@@ -256,7 +262,7 @@
io.nl(!IO),
semipure get_shadow_stack(ShadowStack),
- impure prompt(ShadowStack, 0, WhatNext, !IO),
+ impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
impure consume_io(!.IO),
@@ -291,12 +297,16 @@
StateEv1 = PopState ^ ssdb_stack := FinalStack1,
impure set_debugger_state(StateEv1)
+ ; Event = ssdb_fail,
+ semipure get_debugger_state(PopState),
+ stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
+ StateEv1 = PopState ^ ssdb_stack := FinalStack1,
+ impure set_debugger_state(StateEv1)
+
/* XXX currently commented out because above these two cases
** throw an exception above and hence the compiler warns about
** these two cases being redundant
; Event = ssdb_redo
-
- ; Event = ssdb_fail
*/
).
@@ -426,10 +436,10 @@
% d :: down
%
-:- impure pred prompt(stack(stack_elem)::in, int::in, what_next::out,
- io::di, io::uo) is det.
+:- impure pred prompt(ssdb_event_type::in, stack(stack_elem)::in, int::in,
+ what_next::out, io::di, io::uo) is det.
-prompt(ShadowStack, Depth, WhatNext, !IO) :-
+prompt(Event, ShadowStack, Depth, WhatNext, !IO) :-
io.write_string("ssdb> ", !IO),
% Read a string in input and return a string.
io.read_line_as_string(Result, !IO),
@@ -455,28 +465,33 @@
io.nl(!IO),
io.write_string("p :: print goal's argument", !IO),
io.nl(!IO),
- io.write_string("dump :: print stack trace", !IO),
+ io.write_string("stack :: print stack trace", !IO),
io.nl(!IO),
io.write_string("u :: up", !IO),
io.nl(!IO),
io.write_string("d :: down", !IO),
io.nl(!IO),
io.nl(!IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
; Words = ["p"] ->
CurrentFrame = stack.top_det(ShadowStack),
ListVarValue = CurrentFrame ^ se_initial_state ^
ssdb_list_var_value,
print_vars(ListVarValue, !IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
- ; Words = ["dump"] ->
+ ; Words = ["stack"] ->
print_frames_list(ShadowStack, Depth, !IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
; Words = ["n"] ->
- WhatNext = wn_next
+ ( Event = ssdb_call ->
+ WhatNext = wn_next
+ ;
+ io.write_string("Impossible at exit or fail port\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
;
( Words = ["s"]
@@ -498,22 +513,27 @@
State = State0 ^ ssdb_breakpoints := Breakpoints,
io.print(Breakpoints, !IO),nl(!IO),
impure set_debugger_state(State),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
; Words = ["f"] ->
- stack.top_det(ShadowStack, FrameStack),
- CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
- WhatNext = wn_finish(CSN)
+ ( Event = ssdb_call ->
+ stack.top_det(ShadowStack, FrameStack),
+ CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
+ WhatNext = wn_finish(CSN)
+ ;
+ io.write_string("Impossible at exit or fail port\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
; Words = ["d"] ->
(
DownDepth = Depth - 1,
DownDepth >= 0
->
- impure prompt(ShadowStack, DownDepth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, DownDepth, WhatNext, !IO)
;
io.print("Impossible to go down\n", !IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
; Words = ["u"] ->
@@ -521,15 +541,15 @@
UpDepth = Depth + 1,
UpDepth < stack.depth(ShadowStack)
->
- impure prompt(ShadowStack, UpDepth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, UpDepth, WhatNext, !IO)
;
io.print("Impossible to go up\n", !IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
;
io.write_string("huh?\n", !IO),
- impure prompt(ShadowStack, Depth, WhatNext, !IO)
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
;
Result = eof,
@@ -578,7 +598,7 @@
io.format(" %s.%s(\n", [s(Module), s(Procedure)], !IO),
ListVarValue = Frame ^ se_initial_state ^ ssdb_list_var_value,
print_vars(ListVarValue, !IO),
- io.write_string(")\n", !IO).
+ io.write_string(" )\n", !IO).
%
% Print the given list of variables and their values, if bound.
@@ -601,21 +621,14 @@
io.nl(!IO).
print_var(bound_head_var(Name, Pos, T), !IO) :-
- ( if not string.prefix(Name, "STATE_VARIABLE_IO") then
- io.write_char('\t', !IO),
- io.write_string("bound_head\t", !IO),
- io.write_string(Name, !IO),
- io.write_string(":\t", !IO),
- io.write_int(Pos, !IO),
- io.write_string("\t=\t", !IO),
- io.print(T, !IO),
- io.nl(!IO)
- else
- io.write_char('\t', !IO),
- io.write_string("bound_head\t", !IO),
- io.write_string(Name, !IO),
- io.nl(!IO)
- ).
+ io.write_char('\t', !IO),
+ io.write_string("bound_head\t", !IO),
+ io.write_string(Name, !IO),
+ io.write_string(":\t", !IO),
+ io.write_int(Pos, !IO),
+ io.write_string("\t=\t", !IO),
+ io.print(T, !IO),
+ io.nl(!IO).
print_var(bound_other_var(Name, T), !IO) :-
io.write_char('\t', !IO),
Index: tools/lmc.in
===================================================================
RCS file: /home/mercury1/repository/mercury/tools/lmc.in,v
retrieving revision 1.11
diff -u -r1.11 lmc.in
--- tools/lmc.in 24 Oct 2007 09:21:19 -0000 1.11
+++ tools/lmc.in 26 Oct 2007 06:06:35 -0000
@@ -143,7 +143,14 @@
CDEBUG_FLAGS="$CDEBUG_FLAGS --cflags \"$MMC_ADDED_CFLAGS\""
fi
-C_FLAGS="--c-include-directory $WORKSPACE/trace --c-include-directory $WORKSPACE/library --c-include-directory $WORKSPACE/library/Mercury/mihs --c-include-directory $WORKSPACE/runtime --c-include-directory $WORKSPACE/boehm_gc --c-include-directory $WORKSPACE/boehm_gc/include"
+C_FLAGS="--c-include-directory $WORKSPACE/trace \
+ --c-include-directory $WORKSPACE/library \
+ --c-include-directory $WORKSPACE/library/Mercury/mihs \
+ --c-include-directory $WORKSPACE/ssdb \
+ --c-include-directory $WORKSPACE/ssdb/Mercury/mihs \
+ --c-include-directory $WORKSPACE/runtime \
+ --c-include-directory $WORKSPACE/boehm_gc \
+ --c-include-directory $WORKSPACE/boehm_gc/include"
if test "$MMC_UNDER_GDB" != ""
then
@@ -159,4 +166,10 @@
PATH="$WORKSPACE/scripts:$WORKSPACE/util:$PATH"
export PATH
-exec mmc --no-mercury-stdlib-dir --config-file $WORKSPACE/scripts/Mercury.config -I $WORKSPACE/library -I $WORKSPACE/mdbcomp -I $WORKSPACE/analysis $CDEBUG_FLAGS $C_FLAGS $INIT_FLAGS $LIB_FLAGS $LINK_FLAGS "$@"
+exec mmc --no-mercury-stdlib-dir \
+ --config-file $WORKSPACE/scripts/Mercury.config \
+ -I $WORKSPACE/library \
+ -I $WORKSPACE/mdbcomp \
+ -I $WORKSPACE/ssdb \
+ -I $WORKSPACE/analysis \
+ $CDEBUG_FLAGS $C_FLAGS $INIT_FLAGS $LIB_FLAGS $LINK_FLAGS "$@"
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list