[m-rev.] ssdb version 1.0 misstakes fixed
Olivier Annet
oan at missioncriticalit.com
Mon Dec 3 16:21:38 AEDT 2007
Hi,
This second review for the ssdb version 1.0 fix some misstakes.
Thank to Peter Wang for his eagle eyes ;)
Could someone review my code before committing. Thanks.
===================================================================
Estimated hours taken: 2
Branches: main
Correction of the review ssdb version 1.0
There are some modification for the nondet transformation. When a retry of a
nondet procedure A is asked during the execution of the program, a choicepoint
is left behind and the execution start the retry on procedure B. When the retry
on B is finished, the compiler come back at the choicepoint and finish the call
of the procedure A. This give a wrong number of event.
The proposed solution is: when a retry is asked in a nondet procedure named A
at an exit port, the debugger do not execute any operation until it reach the
fail of the procedure A. It is only at this moment that the execution of B
begin.
If user use a predicate like solutions.unsorted_solutions, he will obtain more
than one time the same solution. The use of solutions is right because it
remove the duplicates
Determinism failure tranformed:
% detism_failure:
%
% p(...) :-
% promise_<original_purity> (
% (
% CallVarDescs = [ ... ],
% impure call_port(ProcId, CallVarDescs),
% <original body>,
% % preserve_backtrack_into
% impure fail_port(ProcId, CallVarDescs, DoRetry),
% (
% DoRetry = do_retry,
% p(...)
% ;
% DoRetry = do_not_retry,
% fail
% )
% )
% ).
Determinism erroneous transformed:
% p(...) :-
% promise_<original_purity> (
% (
% CallVarDescs = [ ... ],
% impure call_port(ProcId, CallVarDescs),
% <original body>,
% )
% ).
browser/util.m:
At the browser prompt, use io.read_line_as_string instead of
functions in the trace library to read input if the trace library is
not linked in.
compiler/mercury_compile.m:
Move the ssdb transformation to after the higher order specialisation
pass to work around a compiler abort. The higher order specialisation
removes predicates which are used to "force the production of
user-requested type specializations, since they are not called from
anywhere and are no longer needed". Let `p' be such a procedure, and
the specialised version be `p1'. Then remove `p'. But due to the ssdb
transformation, `p1' will contain a call to `p', in order to support
retry.
I'm not sure where the ssdb transform should go. I assume as early as
possible.
compiler/ssdebug.m:
- Transform procedures with `failure' and `erroneous' determinisms.
- Funny modes are not managed
I think we can and should handle `unused' arguments as well, but
later.
profiler/Mmakefile:
Link with the mer_ssdb library.
ssdb/Mercury.options:
Link with the mer_browser library to support browsing of terms.
ssdb/SSDB_FLAGS.in:
Don't perform the ssdb transformation on procedures in the ssdb library
as it would result in unbounded recursion.
ssdb/ssdb.m:
- 4 new event for the nondet procedure are now use. They are :
ssdb_call_nondet, ssdb_exit_nondet, ssdb_fail_nondet,
and ssdb_redo_nondet. In the same way, an different event handler
has been created to managed each of them.
The ssdb_redo event was no more useful.
- The old structure debugger_state has been divided in different
mutable variables to allow more flexibility.
- The old breakpoint list are now a map with (module_name, pred_name)
as key and the breakpoint structure as value.
- The depth is now compute with the stack depth, it is easier to manage
and more flexible.
- Some new command have been added: delete/enable/disable breakpoint,
break info, finish N, retry N, browse X
tests/.mgnuc_copts.ws:
tests/WS_FLAGS.ws:
Search in the ssdb directory for header files.
Index: browser/util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/util.m,v
retrieving revision 1.34
diff -u -r1.34 util.m
--- browser/util.m 19 Jan 2007 07:03:59 -0000 1.34
+++ browser/util.m 3 Dec 2007 04:38:16 -0000
@@ -133,7 +133,7 @@
:- pragma foreign_proc("C",
trace_get_command(Prompt::in, Line::out, MdbIn::in,
MdbOut::in, State0::di, State::uo),
- [will_not_call_mercury, promise_pure, tabled_for_io],
+ [may_call_mercury, promise_pure, tabled_for_io],
"
char *line;
MercuryFile *mdb_in = (MercuryFile *) MdbIn;
@@ -143,20 +143,45 @@
line = (*MR_address_of_trace_get_command)(
(char *) Prompt,
MR_file(*mdb_in), MR_file(*mdb_out));
+
+ MR_make_aligned_string_copy(Line, line);
+ MR_free(line);
+
} else {
- MR_tracing_not_enabled();
- /* not reached */
+ BROWSER_trace_get_command_fallback(Prompt, &Line, MdbIn, MdbOut);
}
- MR_make_aligned_string_copy(Line, line);
- MR_free(line);
-
State = State0;
").
trace_get_command(_, _, _, _, !IO) :-
private_builtin.sorry("mdb.trace_get_command/6").
+ % This is called by trace_get_command when the trace library is not linked
+ % in.
+ %
+:- pred trace_get_command_fallback(string::in, string::out, io.input_stream::in,
+ io.output_stream::in, io::di, io::uo) is det.
+
+:- pragma foreign_export("C",
+ trace_get_command_fallback(in, out, in, in, di, uo),
+ "BROWSER_trace_get_command_fallback").
+
+trace_get_command_fallback(Prompt, String, MdbIn, MdbOut, !IO) :-
+ io.write_string(MdbOut, Prompt, !IO),
+ io.flush_output(MdbOut, !IO),
+ io.read_line_as_string(MdbIn, Result, !IO),
+ (
+ Result = ok(String)
+ ;
+ Result = eof,
+ String = "quit"
+ ;
+ Result = error(_Error),
+ error("Unexpected error in browser/util.m :
+ trace_get_command_fallback failed")
+ ).
+
zip_with(Pred, XXs, YYs, Zipped) :-
( (XXs = [], YYs = []) ->
Zipped = []
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.453
diff -u -r1.453 mercury_compile.m
--- compiler/mercury_compile.m 1 Nov 2007 06:23:21 -0000 1.453
+++ compiler/mercury_compile.m 3 Dec 2007 04:38:18 -0000
@@ -2564,9 +2564,6 @@
maybe_termination2(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 121, "termination2", !DumpInfo, !IO),
- maybe_ssdb(Verbose, Stats, !HLDS, !IO),
- maybe_dump_hlds(!.HLDS, 123, "ssdb", !DumpInfo, !IO),
-
maybe_type_ctor_infos(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 125, "type_ctor_infos", !DumpInfo, !IO),
@@ -2590,6 +2587,9 @@
maybe_higher_order(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
+ maybe_ssdb(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 137, "ssdb", !DumpInfo, !IO),
+
maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 139, "implicit_parallelism", !DumpInfo, !IO),
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.10
diff -u -r1.10 ssdebug.m
--- compiler/ssdebug.m 9 Nov 2007 02:07:36 -0000 1.10
+++ compiler/ssdebug.m 3 Dec 2007 04:38:19 -0000
@@ -74,20 +74,11 @@
% (
% CallVarDescs = [ ... ],
% impure call_port(ProcId, CallVarDescs),
-% <original body>, % renaming outputs
+% <original body>,
% ExitVarDescs = [ ... | CallVarDescs ],
% (
-% impure exit_port(ProcId, ExitVarDescs, DoRetryA),
-% (
-% DoRetryA = do_retry,
-% p(...)
-% % Will give same result as long as p is pure or
-% % semipure. Retry of impure procedures should probably
-% % be disallowed anyway.
-% ;
-% DoRetryA = do_not_retry,
-% % bind outputs
-% )
+% impure exit_port(ProcId, ExitVarDescs)
+% % Go to fail port if retry.
% ;
% % preserve_backtrack_into,
% impure redo_port(ProcId, ExitVarDescs),
@@ -105,6 +96,40 @@
% )
% )
% ).
+%
+% detism_failure:
+%
+% p(...) :-
+% promise_<original_purity> (
+% (
+% CallVarDescs = [ ... ],
+% impure call_port(ProcId, CallVarDescs),
+% <original body>,
+% % preserve_backtrack_into
+% impure fail_port(ProcId, CallVarDescs, DoRetry),
+% (
+% DoRetry = do_retry,
+% p(...)
+% ;
+% DoRetry = do_not_retry,
+% fail
+% )
+% )
+% ).
+%
+%
+% detism_erroneous:
+%
+% p(...) :-
+% promise_<original_purity> (
+% (
+% CallVarDescs = [ ... ],
+% impure call_port(ProcId, CallVarDescs),
+% <original body>,
+% )
+% ).
+%
+%
%
% where CallVarDescs, ExitVarDescs are lists of var_value
%
@@ -136,8 +161,8 @@
:- import_module io.
%
-% Place the different events (call/exit/fail/redo) at the beginning/end of each
-% procedure.
+% Place the different events (call/exit/fail/redo) around of each procedure to
+% allow debugging.
%
:- pred ssdebug.process_proc(pred_id::in, proc_id::in,
proc_info::in, proc_info::out, module_info::in, module_info::out,
@@ -148,6 +173,7 @@
:- implementation.
+:- import_module check_hlds.modes.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.purity.
@@ -203,10 +229,10 @@
process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
;
Determinism = detism_erroneous,
- error("detism_erroneous: not yet implemented in ssdb")
+ process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
;
Determinism = detism_failure,
- error("detism_failure: not yet implemented in ssdb")
+ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
).
@@ -230,10 +256,10 @@
make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
ProcIdVar, !Varset, !Vartypes),
- % Get the list of head variables and their instantiation type.
+ % Get the list of head variables and their instantiation state.
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,
@@ -241,7 +267,7 @@
!Vartypes, map.init, BoundVarDescsAtCall),
% Generate the call to handle_event_call(ProcId, VarList).
- make_handle_event("call", [ProcIdVar, CallArgListVar],
+ make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
% Get the InstMap at the end of the procedure.
@@ -262,43 +288,46 @@
make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
-
+
% Create DoRetry output variable.
make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
% Generate the call to handle_event_exit(ProcId, VarList, DoRetry).
- make_handle_event("exit", [ProcIdVar, ExitArgListVar, RetryVar],
- HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
+ make_handle_event("handle_event_exit",
+ [ProcIdVar, ExitArgListVar, RetryVar], HandleEventExitGoal,
+ !ModuleInfo, !Varset, !Vartypes),
% Generate the recursive call in the case of a retry.
make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
RecursiveGoal),
% Organize the order of the generated code.
- % XXX Need optimization in list append.
goal_to_conj_list(BodyGoal1, BodyGoalList),
% Set the determinism.
Determinism = detism_det,
goal_info_init(GoalInfo0),
- goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
+ goal_info_set_determinism(Determinism, GoalInfo0,
+ GoalInfoDet),
+ goal_info_set_purity(purity_impure, GoalInfoDet, GoalInfoImpureDet),
- conj_list_to_goal(RenamingGoals, GoalInfo, RenamingGoal),
+ conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
+ conj_list_to_goal([RecursiveGoal], GoalInfoImpureDet, ReSetGoal),
% Create the switch on Retry at exit port.
- make_switch_goal(RetryVar, RecursiveGoal, RenamingGoal, GoalInfo,
+ make_switch_goal(RetryVar, ReSetGoal, RenamingGoal, GoalInfoImpureDet,
SwitchGoal),
ConjGoals = ProcIdGoals ++ CallArgListGoals ++
- [HandleEventCallGoal | BodyGoalList] ++ ExitArgListGoals ++
- [HandleEventExitGoal, SwitchGoal],
+ [HandleEventCallGoal | BodyGoalList] ++
+ ExitArgListGoals ++ [HandleEventExitGoal, SwitchGoal],
- conj_list_to_goal(ConjGoals, GoalInfo, GoalWithoutPurity),
+ conj_list_to_goal(ConjGoals, GoalInfoImpureDet, GoalWithoutPurity),
% Add the purity scope.
Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfo, GoalWithoutPurity, Goal),
+ wrap_with_purity_scope(Purity, GoalInfoDet, GoalWithoutPurity, Goal),
commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
+ !ModuleInfo, !.Varset, !.Vartypes)
).
@@ -316,121 +345,147 @@
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 the list of head variables and their instantiation type.
+ % Get the list of head variables and their initial instantiations.
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),
-
- % Generate the call to handle_event_call(ProcId, VarList).
- make_handle_event("call", [ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
+ proc_info_get_argmodes(!.ProcInfo, ListMerMode),
- % Get the InstMap at the end of the procedure.
- update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
+ ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
- % We have to rename the output variables because, if we do a retry,
- % we can get an other value.
- proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
- InstantiatedVars),
- goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
- create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
- RenamingGoals, _NewVars, Renaming),
- rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
-
- % 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, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
- ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
-
- % Create DoRetryA output variable
- make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
-
- % Generate the call to handle_event_exit(ProcId, VarList, DoRetryA).
- make_handle_event("exit", [ProcIdVar, ExitArgListVar, RetryAVar],
- HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Generate the recursive call in the case of a retry
- make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
- RecursiveGoal),
-
- % Generate the list of arguments at the fail port.
- make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
- FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
-
- % Create DoRetryA output variable
- make_retry_var("DoRetryB", RetryBVar, !Varset, !Vartypes),
-
- % Generate the call to handle_event_fail(ProcId, VarList, DoRetryB).
- make_handle_event("fail", [ProcIdVar, FailArgListVar, RetryBVar],
- HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
+ % Make the ssdb_proc_id.
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
+ ProcIdVar, !Varset, !Vartypes),
+
+ % 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),
+
+ % Generate the call to handle_event_call(ProcId, VarList).
+ make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+ HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
+
+ % Get the InstMap at the end of the procedure.
+ update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
+
+ % We have to rename the output variables because, if we do a retry,
+ % we can get an other value.
+ proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
+ InstantiatedVars),
+ goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
+ create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
+ RenamingGoals, _NewVars, Renaming),
+ rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
+
+ % 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, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
+
+ % Create DoRetryA output variable
+ make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
+
+ % Generate the call to
+ % handle_event_exit(ProcId, VarList, DoRetryA).
+ make_handle_event("handle_event_exit",
+ [ProcIdVar, ExitArgListVar, RetryAVar], HandleEventExitGoal,
+ !ModuleInfo, !Varset, !Vartypes),
+
+ % Generate the recursive call in the case of a retry
+ make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
+ HeadVars, RecursiveGoal),
+
+ % Generate the list of arguments at the fail port.
+ make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
+ FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
+
+ % Create DoRetryA output variable
+ make_retry_var("DoRetryB", RetryBVar, !Varset, !Vartypes),
+
+ % Generate the call to
+ % handle_event_fail(ProcId, VarList, DoRetryB).
+ make_handle_event("handle_event_fail",
+ [ProcIdVar, FailArgListVar, RetryBVar], HandleEventFailGoal,
+ !ModuleInfo, !Varset, !Vartypes),
+
+ make_fail_call(FailGoal, !.ModuleInfo),
+
+ % Organize the order of the generated code.
+
+ % Get a flattened goal to avoid nested conjuction.
+ goal_to_conj_list(BodyGoal1, BodyGoalList),
+ GoalsCond = BodyGoalList,
+
+ % Create the switch on DoRetryA at exit port.
+ goal_info_init(GoalInfo0),
+ goal_info_set_purity(purity_impure, GoalInfo0, GoalInfoImpure),
+ goal_list_purity(GoalsCond, PurityCond),
+ goal_list_determinism(GoalsCond, DetismCond),
+ goal_info_set_determinism(DetismCond, GoalInfo0,
+ GoalInfoCondDet),
+ goal_info_set_purity(PurityCond, GoalInfoCondDet,
+ GoalInfoCondPurDet),
+
+ SemiDet = detism_semi,
+ goal_info_set_determinism(SemiDet, GoalInfo0, GoalInfoSemiDet),
+ goal_info_set_purity(purity_impure, GoalInfoSemiDet,
+ GoalInfoImpureSemiDet),
+ goal_info_set_determinism(detism_det, GoalInfoImpure,
+ GoalInfoImpureDet),
+ conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
+ conj_list_to_goal([RecursiveGoal], GoalInfoImpureSemiDet,
+ ReSetGoal),
+
+ % Create the switch on DoRetryA at exit port.
+ make_switch_goal(RetryAVar, ReSetGoal, RenamingGoal,
+ GoalInfoImpureSemiDet, SwitchExitPortGoal),
+ % Create the switch on DoRetryB at fail port.
+ make_switch_goal(RetryBVar, ReSetGoal, FailGoal,
+ GoalInfoImpureSemiDet, SwitchFailPortGoal),
+
+ GoalsThen = ExitArgListGoals ++
+ [HandleEventExitGoal, SwitchExitPortGoal],
+ GoalsElse = FailArgListGoals ++
+ [HandleEventFailGoal, SwitchFailPortGoal],
+
+ goal_info_set_determinism(detism_det, GoalInfoImpure, GoalInfoThen),
+ goal_info_set_determinism(detism_semi, GoalInfoImpure,
+ GoalInfoElse),
+
+ IteExistVars = [],
+ conj_list_to_goal(GoalsCond, GoalInfoCondPurDet, CondGoal),
+ ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), GoalInfoThen),
+ ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), GoalInfoElse),
+
+ CallVarGoal = ProcIdGoals ++ CallArgListGoals ++
+ [HandleEventCallGoal],
+ % XXX not sure about determinism.
+ GoalITE = hlds_goal(if_then_else(IteExistVars, CondGoal, ThenGoal,
+ ElseGoal), GoalInfoCondPurDet),
+
+ ConjGoal = CallVarGoal ++ [GoalITE],
+ GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoal),
+ GoalInfoCondPurDet),
+
+ % Add the purity scope.
+ Purity = goal_info_get_purity(BodyGoalInfo0),
+ wrap_with_purity_scope(Purity, GoalInfoSemiDet, GoalWithoutPurity,
+ Goal),
- make_fail_call(FailGoal, !.ModuleInfo),
-
- % Organize the order of the generated code.
- % XXX Need optimization in list append.
-
- % Get a flattened goal to avoid nested conjuction.
- goal_to_conj_list(BodyGoal1, BodyGoalList),
- GoalsCond = BodyGoalList,
-
- % Create the switch on DoRetryA at exit port.
- Determinism = detism_det,
- goal_info_init(GoalInfo1),
- goal_info_set_determinism(Determinism, GoalInfo1, GoalInfo),
- conj_list_to_goal(RenamingGoals, GoalInfo, RenamingGoal),
- make_switch_goal(RetryAVar, RecursiveGoal, RenamingGoal, GoalInfo,
- SwitchExitPortGoal),
-
- % Create the switch on DoRetryB at fail port.
- make_switch_goal(RetryBVar, RecursiveGoal, FailGoal, GoalInfo,
- SwitchFailPortGoal),
-
- GoalsThen = ExitArgListGoals ++
- [HandleEventExitGoal, SwitchExitPortGoal],
- GoalsElse = FailArgListGoals ++
- [HandleEventFailGoal, SwitchFailPortGoal],
-
- goal_info_init(GoalInfo0),
- goal_list_determinism(GoalsCond, Detism),
- goal_info_set_determinism(Detism, GoalInfo0, GoalInfoCond),
-
- goal_info_set_determinism(detism_det, GoalInfo0, GoalInfoThen),
- goal_info_set_determinism(detism_semi, GoalInfo0, GoalInfoElse),
-
- IteExistVars = [],
- conj_list_to_goal(GoalsCond, GoalInfoCond, CondGoal),
- ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), GoalInfoThen),
- ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), GoalInfoElse),
-
- CallVarGoal = ProcIdGoals ++ CallArgListGoals ++ [HandleEventCallGoal],
- % XXX not sure about determinism.
- GoalITE = hlds_goal(if_then_else(IteExistVars, CondGoal, ThenGoal,
- ElseGoal), GoalInfoCond),
-
- ConjGoal = CallVarGoal ++ [GoalITE],
- GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoal),
- GoalInfoCond),
-
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfo, GoalWithoutPurity, Goal),
-
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
+ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.Varset, !.Vartypes)
+ ;
+ % In the case of a mode which is not fully input or output,
+ % the procedure is not transformed.
+ true
+ )
).
@@ -454,7 +509,7 @@
make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
ProcIdVar, !Varset, !Vartypes),
- % Get the list of head variables and their instantiation type.
+ % Get the list of head variables and their instantiation state.
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
@@ -465,60 +520,51 @@
!Vartypes, map.init, BoundVarDescsAtCall),
% Generate the call to handle_event_call(ProcId, VarList).
- make_handle_event("call", [ProcIdVar, CallArgListVar],
+ make_handle_event("handle_event_call_nondet",
+ [ProcIdVar, CallArgListVar],
HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
% Get the InstMap at the end of the procedure.
update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
- % We have to rename the output variables because, if we do a retry,
- % we can get an other value.
- proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
- InstantiatedVars),
- goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
- create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
- RenamingGoals, _NewVars, Renaming),
- rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
-
% 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, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
+ make_arg_list(0, FinalInstMap, HeadVars, map.init, ExitArgListVar,
ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
- % Create DoRetryA output variable
- make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
-
- % Generate the call to handle_event_exit(ProcId, VarList, DoRetryA).
- make_handle_event("exit", [ProcIdVar, ExitArgListVar, RetryAVar],
+ % Generate the call to handle_event_exit_nondet(ProcId, VarList).
+ make_handle_event("handle_event_exit_nondet",
+ [ProcIdVar, ExitArgListVar],
HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
% Generate the call to handle_event_redo(ProcId, VarList).
- make_handle_event("redo", [ProcIdVar, ExitArgListVar],
+ make_handle_event("handle_event_redo_nondet",
+ [ProcIdVar, ExitArgListVar],
HandleEventRedoGoal, !ModuleInfo, !Varset, !Vartypes),
% Generate the list of argument at the fail port.
- make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
+ make_arg_list(0, InitInstMap, [], map.init, FailArgListVar,
FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
% Create DoRetryB output variable
- make_retry_var("DoRetryB", RetryBVar, !Varset, !Vartypes),
+ make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
- % Generate the call to handle_event_fail(ProcId, VarList, DoRetryB).
- make_handle_event("fail", [ProcIdVar, FailArgListVar, RetryBVar],
+ % Generate the call to
+ % handle_event_fail_nondet(ProcId, VarList, DoRetry).
+ make_handle_event("handle_event_fail_nondet",
+ [ProcIdVar, FailArgListVar, RetryVar],
HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
make_fail_call(FailGoal, !.ModuleInfo),
% Organize the order of the generated code.
- % XXX Need optimization in list append.
-
% Get a flattened goal to avoid nested conjuction.
- goal_to_conj_list(BodyGoal1, BodyGoalList1),
+ goal_to_conj_list(BodyGoal0, BodyGoalList0),
CallVarGoal0 = CallArgListGoals ++
- [HandleEventCallGoal | BodyGoalList1] ++ ExitArgListGoals,
+ [HandleEventCallGoal | BodyGoalList0] ++ ExitArgListGoals,
goal_info_init(GoalInfo0),
conj_list_to_goal(CallVarGoal0, GoalInfo0, CallVarGoal1),
goal_to_conj_list(CallVarGoal1, CallVarGoal),
@@ -528,46 +574,210 @@
RecursiveGoal),
% Create the switch on DoRetryA at exit port.
- Determinism = detism_det,
- goal_info_set_determinism(Determinism, GoalInfo0, GoalInfo),
- conj_list_to_goal(RenamingGoals, GoalInfo, RenamingGoal),
- make_switch_goal(RetryAVar, RecursiveGoal, RenamingGoal, GoalInfo,
- SwitchExitPortGoal),
+ Det = detism_det,
+ FailDet = detism_failure,
+ NonDet = detism_non,
+ goal_info_set_purity(purity_impure, GoalInfo0,
+ GoalInfoImpure),
+ goal_info_set_determinism(Det, GoalInfoImpure, GoalInfoImpureDet),
+ goal_info_set_determinism(FailDet, GoalInfoImpure,
+ GoalInfoImpureFailDet),
+ goal_info_set_determinism(NonDet, GoalInfoImpure,
+ GoalInfoImpureNonDet),
+ goal_list_determinism(BodyGoalList0, Detism),
+ goal_info_set_determinism(Detism, GoalInfo0, GoalInfoDetism),
+ goal_info_set_determinism(Detism, GoalInfoImpure,
+ GoalInfoImpureDetism),
+
+ conj_list_to_goal([RecursiveGoal], GoalInfoImpureDetism, ReSetGoal),
% Create the switch on DoRetryB at fail port.
- make_switch_goal(RetryBVar, RecursiveGoal, FailGoal, GoalInfo,
+ make_switch_goal(RetryVar, ReSetGoal, FailGoal, GoalInfoImpureNonDet,
SwitchFailPortGoal),
ConjGoal11 = hlds_goal(conj(plain_conj,
- [HandleEventExitGoal, SwitchExitPortGoal]), GoalInfo0),
+ [HandleEventExitGoal]), GoalInfoImpureDet),
ConjGoal120 = hlds_goal(conj(plain_conj,
- [HandleEventRedoGoal, FailGoal]), GoalInfo0),
+ [HandleEventRedoGoal, FailGoal]), GoalInfoImpureFailDet),
goal_add_feature(feature_preserve_backtrack_into, ConjGoal120,
ConjGoal12),
- DisjGoal1 = hlds_goal(disj([ConjGoal11, ConjGoal12]), GoalInfo0),
+
+ DisjGoal1 = hlds_goal(disj([ConjGoal11, ConjGoal12]),
+ GoalInfoImpureDetism),
ConjGoal21 = hlds_goal(conj(plain_conj,
- CallVarGoal ++ [DisjGoal1]), GoalInfo0),
- ConjGoal220 = hlds_goal(conj(plain_conj,
- FailArgListGoals ++ [HandleEventFailGoal, SwitchFailPortGoal]),
- GoalInfo0),
+ CallVarGoal ++ [DisjGoal1]), GoalInfoImpureDetism),
+ ConjGoal220 = hlds_goal(conj(plain_conj, FailArgListGoals ++
+ [HandleEventFailGoal, SwitchFailPortGoal]), GoalInfoImpureNonDet),
goal_add_feature(feature_preserve_backtrack_into, ConjGoal220,
ConjGoal22),
DisjGoal2 = hlds_goal(disj([ConjGoal21, ConjGoal22]),
- GoalInfo0),
+ GoalInfoImpureDetism),
GoalWithoutPurity = hlds_goal(conj(plain_conj,
- ProcIdGoals ++ [DisjGoal2]), GoalInfo0),
+ ProcIdGoals ++ [DisjGoal2]), GoalInfoImpureDetism),
% Add the purity scope.
Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfo, GoalWithoutPurity, Goal),
+ wrap_with_purity_scope(Purity, GoalInfoDetism, GoalWithoutPurity, Goal),
commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
!ModuleInfo, !.Varset, !.Vartypes)
).
+ %
+ % Source-to-source transformation for a failure procedure.
+ %
+:- pred process_proc_failure(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_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ proc_info_get_goal(!.ProcInfo, BodyGoal0),
+ BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
+
+ 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 the list of head variables and their instantiation state.
+ 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),
+
+ % Generate the call to handle_event_call(ProcId, VarList).
+ make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+ HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
+
+ % 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, InitInstMap, [], map.init, FailArgListVar,
+ FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
+ !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
+
+ % Create DoRetry output variable.
+ make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
+
+ % Generate the call to handle_event_exit(ProcId, VarList, DoRetry).
+ make_handle_event("handle_event_fail",
+ [ProcIdVar, FailArgListVar, RetryVar],
+ HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
+
+ make_fail_call(FailGoal, !.ModuleInfo),
+
+ % Generate the recursive call in the case of a retry.
+ make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
+ RecursiveGoal),
+
+ % Organize the order of the generated code.
+
+ goal_to_conj_list(BodyGoal0, BodyGoalList),
+ % Set the determinism.
+ Determinism = detism_failure,
+ goal_info_init(GoalInfo0),
+ goal_info_set_determinism(Determinism, GoalInfo0, GoalInfoFail),
+ goal_info_set_purity(purity_impure, GoalInfoFail, GoalInfoImpureFail),
+
+ conj_list_to_goal([RecursiveGoal], GoalInfoImpureFail, ReSetGoal),
+ % Create the switch on Retry at exit port.
+ make_switch_goal(RetryVar, ReSetGoal, FailGoal, GoalInfoImpureFail,
+ SwitchGoal),
+
+ ConjGoal1 = hlds_goal(conj(plain_conj, BodyGoalList),
+ GoalInfoImpureFail),
+ ConjGoal20 = hlds_goal(conj(plain_conj, FailArgListGoals ++
+ [HandleEventFailGoal, SwitchGoal]), GoalInfoImpureFail),
+ goal_add_feature(feature_preserve_backtrack_into, ConjGoal20,
+ ConjGoal2),
+
+ DisjGoal = hlds_goal(disj([ConjGoal1, ConjGoal2]), GoalInfoImpureFail),
+
+ ConjGoals = ProcIdGoals ++ CallArgListGoals ++
+ [HandleEventCallGoal, DisjGoal],
+
+ conj_list_to_goal(ConjGoals, GoalInfoImpureFail, GoalWithoutPurity),
+
+ % Add the purity scope.
+ Purity = goal_info_get_purity(BodyGoalInfo0),
+ wrap_with_purity_scope(Purity, GoalInfoFail, GoalWithoutPurity, Goal),
+
+ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.Varset, !.Vartypes)
+ ).
+
+
+ %
+ % Source-to-source transformation for an erroneous procedure.
+ % XXX ERRONEOUS procedure have currently just a call port.
+ %
+:- pred process_proc_erroneous(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_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ proc_info_get_goal(!.ProcInfo, BodyGoal0),
+ BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
+
+ 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 the list of head variables and their instantiation state.
+ 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),
+
+ % Generate the call to handle_event_call(ProcId, VarList).
+ make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+ HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
+
+ % Organize the order of the generated code.
+ goal_to_conj_list(BodyGoal0, BodyGoalList),
+ % Set the determinism.
+ DeterminismErr = detism_erroneous,
+ goal_info_init(GoalInfo0),
+ goal_info_set_determinism(DeterminismErr, GoalInfo0,
+ GoalInfoErr),
+ goal_info_set_purity(purity_impure, GoalInfoErr, GoalInfoImpureErr),
+
+ ConjGoals = ProcIdGoals ++ CallArgListGoals ++
+ [HandleEventCallGoal | BodyGoalList],
+
+ conj_list_to_goal(ConjGoals, GoalInfoImpureErr, GoalWithoutPurity),
+
+ % Add the purity scope.
+ Purity = goal_info_get_purity(BodyGoalInfo0),
+ wrap_with_purity_scope(Purity, GoalInfoErr, GoalWithoutPurity, Goal),
+
+ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.Varset, !.Vartypes)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+
%
% Create the output variable DoRetry.
%
@@ -629,24 +839,14 @@
% wrap_with_purity_scope(Purity, GoalInfo, Goal0, Goal)
%
% The Goal0 is wrap with the Purity to give Goal.
- % Not wrapping impure procedures with redundant promise_impure scopes.
%
:- pred wrap_with_purity_scope(purity::in, hlds_goal_info::in, hlds_goal::in,
hlds_goal::out) is det.
-wrap_with_purity_scope(Purity, GoalInfo, GoalWithoutPurity, Goal) :-
- % The scope are not introduce when the purity is impure because it is the
- % default case.
- (
- Purity = purity_impure,
- Goal = GoalWithoutPurity
- ;
- ( Purity = purity_pure
- ; Purity = purity_semipure
- ),
- ScopeReason = promise_purity(dont_make_implicit_promises, Purity),
- Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo)
- ).
+wrap_with_purity_scope(Purity, GoalInfo0, GoalWithoutPurity, Goal) :-
+ goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
+ ScopeReason = promise_purity(dont_make_implicit_promises, Purity),
+ Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo).
%
@@ -670,9 +870,6 @@
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
-%-----------------------------------------------------------------------------%
-
-
%
% Build the following goal : handle_event_EVENT(ProcId, Arguments).
% EVENT = call,exit,fail or redo
@@ -682,15 +879,14 @@
module_info::in, module_info::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out) is det.
-make_handle_event(Event, Arguments, HandleEventGoal, !ModuleInfo,
+make_handle_event(HandleTypeString, Arguments, HandleEventGoal, !ModuleInfo,
!Varset, !Vartypes) :-
- CallString = "handle_event_" ++ Event,
SSDBModule = mercury_ssdb_builtin_module,
Features = [],
InstMapSrc = [],
Context = term.context_init,
- goal_util.generate_simple_call(SSDBModule, CallString,
+ goal_util.generate_simple_call(SSDBModule, HandleTypeString,
pf_predicate, only_mode, detism_det, purity_impure,
Arguments, Features, InstMapSrc, !.ModuleInfo, Context,
HandleEventGoal).
@@ -748,8 +944,37 @@
"false", pf_predicate, only_mode, detism_failure, purity_pure,
[], Features, InstMapSrc, ModuleInfo, Context, FailGoal).
+
+ %
+ % Detect if all argument's mode are fully input or output.
+ % XXX Other mode than fully input or output are not managed for the
+ % moment. So the code of these procedures will not be generated.
+ %
+:- pred check_arguments_modes(module_info::in, list(mer_mode)::in)
+ is semidet.
+
+check_arguments_modes(ModuleInfo, HeadModes) :-
+ (
+ all [Modes] (
+ list.member(Mode, HeadModes)
+ =>
+ ( mode_is_fully_input(ModuleInfo, Mode)
+ ; mode_is_fully_output(ModuleInfo, Mode)
+ )
+ )
+ ->
+ true
+ ;
+ fail
+ ).
+
%-----------------------------------------------------------------------------%
+ %
+ % The following code concern predicates which create the list argument at
+ % event point.
+ %
+
%
% make_arg_list(Pos, InstMap, Vars, RenamedVar, FullListVar, Goals,
@@ -812,7 +1037,6 @@
ConsId = cons(qualified(unqualified("list"), "[|]" ), 2),
construct_functor(Var, ConsId, [VarDesc, Var0], Goal),
- %XXX Optimization : Unefficience problem with append.
Goals = Goals0 ++ ValueGoals ++ [Goal].
@@ -919,6 +1143,6 @@
Goals = [ConstructVarName, ConstructVarPos, ConstructVarGoal]
).
-
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: profiler/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/Mmakefile,v
retrieving revision 1.28
diff -u -r1.28 Mmakefile
--- profiler/Mmakefile 20 Jul 2007 01:22:05 -0000 1.28
+++ profiler/Mmakefile 3 Dec 2007 04:38:19 -0000
@@ -17,6 +17,8 @@
MAIN_TARGET=all
MERCURY_MAIN_MODULES=mercury_profile
+VPATH = $(LIBRARY_DIR) $(SSDB_DIR)
+
#-----------------------------------------------------------------------------#
MLFLAGS += --shared
Index: ssdb/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/Mercury.options,v
retrieving revision 1.1
diff -u -r1.1 Mercury.options
--- ssdb/Mercury.options 3 Oct 2007 12:11:57 -0000 1.1
+++ ssdb/Mercury.options 3 Dec 2007 04:38:19 -0000
@@ -10,8 +10,8 @@
# XXX This line is needed so that `mmake --use-mmc-make libmer_ssdb'
# passes `-lmer_mdbcomp' to `mmc --make' in the MLLIBS variable.
-EXTRA_LIBRARIES-libmer_ssdb = mer_mdbcomp
+EXTRA_LIBRARIES-libmer_ssdb = mer_mdbcomp mer_browser
# Whereas these lines are needed for plain `mmake'.
-EXTRA_LIBRARIES-libmer_ssdb.so = mer_mdbcomp
-EXTRA_LIBRARIES-libmer_ssdb.dylib = mer_mdbcomp
+EXTRA_LIBRARIES-libmer_ssdb.so = mer_mdbcomp mer_browser
+EXTRA_LIBRARIES-libmer_ssdb.dylib = mer_mdbcomp mer_browser
Index: ssdb/SSDB_FLAGS.in
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/SSDB_FLAGS.in,v
retrieving revision 1.1
diff -u -r1.1 SSDB_FLAGS.in
--- ssdb/SSDB_FLAGS.in 3 Oct 2007 12:11:58 -0000 1.1
+++ ssdb/SSDB_FLAGS.in 3 Dec 2007 04:38:19 -0000
@@ -5,6 +5,7 @@
--no-mercury-stdlib-dir
--no-shlib-linker-use-install-name
--force-disable-tracing
+--no-ssdb
-I../library
-I../mdbcomp
-I../browser
Index: ssdb/ssdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
retrieving revision 1.10
diff -u -r1.10 ssdb.m
--- ssdb/ssdb.m 9 Nov 2007 02:07:37 -0000 1.10
+++ ssdb/ssdb.m 3 Dec 2007 04:38:19 -0000
@@ -18,6 +18,7 @@
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
+
:- module ssdb.
:- interface.
:- import_module list.
@@ -31,11 +32,16 @@
:- type ssdb_event_type
---> ssdb_call
; ssdb_exit
- ; ssdb_redo
; ssdb_fail
+ ; ssdb_call_nondet
+ ; ssdb_exit_nondet
+ ; ssdb_redo_nondet
+ ; ssdb_fail_nondet
.
-
+ %
+ % Type to determine if it is necessary to do a retry.
+ %
:- type ssdb_retry
---> do_retry
; do_not_retry
@@ -67,77 +73,125 @@
%
:- type pos == int.
+
%
% This routine is called at each call event that occurs.
%
:- impure pred handle_event_call(ssdb_proc_id::in, list_var_value::in) is det.
%
+ % This routine is called at each call event in a nondet procedure.
+ %
+:- impure pred handle_event_call_nondet(ssdb_proc_id::in,
+ list_var_value::in) is det.
+
+ %
% This routine is called at each exit event that occurs.
%
:- impure pred handle_event_exit(ssdb_proc_id::in, list_var_value::in,
ssdb_retry::out) is det.
%
+ % This routine is called at each exit event in a nondet procedure.
+ %
+:- impure pred handle_event_exit_nondet(ssdb_proc_id::in,
+ list_var_value::in) is det.
+
+ %
% This routine is called at each fail event that occurs.
%
:- impure pred handle_event_fail(ssdb_proc_id::in, list_var_value::in,
ssdb_retry::out) is det.
%
- % This routine is called at each redo event that occurs.
+ % This routine is called at each fail event in a nondet procedure.
+ %
+:- impure pred handle_event_fail_nondet(ssdb_proc_id::in, list_var_value::in,
+ ssdb_retry::out) is det.
+
+ %
+ % This routine is called at each redo event in a nondet procedure.
%
-:- impure pred handle_event_redo(ssdb_proc_id::in, list_var_value::in) is det.
+:- impure pred handle_event_redo_nondet(ssdb_proc_id::in,
+ list_var_value::in) is det.
+
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
+:- import_module assoc_list.
:- import_module bool.
:- import_module io.
:- import_module int.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module pretty_printer.
:- import_module require.
:- import_module set.
:- import_module stack.
:- import_module string.
+:- import_module univ.
-%----------------------------------------------------------------------------%
-
-:- type debugger_state
- ---> state(
- % Current event number.
- ssdb_event_number :: int,
+:- import_module mdb.
+:- import_module mdb.browse.
+:- import_module mdb.browser_info.
+:- import_module mdb.browser_term.
- % Call Sequence Number.
- ssdb_csn :: int,
+%----------------------------------------------------------------------------%
- % Depth of the function.
- ssdb_call_depth :: int,
+ %
+ % These variables are all mutable, they are used to record the diffrents
+ % state of the debugger.
+ %
- % Where the program should stop next time.
- ssdb_next_stop :: next_stop,
+:- type cur_ssdb_next_stop == next_stop.
- % The shadow stack.
- ssdb_stack :: stack(stack_elem),
+:- type cur_ssdb_breakpoints == map(pair(string,string), breakpoint).
- % The set of breakpoint added.
- ssdb_breakpoints :: set(breakpoint),
+:- type cur_ssdb_shadow_stack == stack(stack_elem).
- % The list of the goal's argument.
- ssdb_list_var_value :: list(var_value)
- ).
+:- type cur_ssdb_shadow_stack_nondet == stack(stack_elem).
+ %
+ % Note: debugger_disabled must be first because io.init_state/2 is called
+ % before the `do_nothing' mutable is initialised. At that time `do_nothing'
+ % will have a value of zero. By putting debugger_disabled first, it will
+ % be represented by zero so the SSDB port code will correctly do nothing
+ % until after the library is initialised.
+ % XXX In near futur, the debugger_disabled state should be removed.
+ %
+:- type debugger_state
+ ---> debugger_disabled
+ ; debugger_on
+ ; debugger_off.
+ %
+ % Frame of the current call procedure.
+ %
:- type stack_elem
---> elem(
+ % Event Number
+ se_event_number :: int,
+
+ % Call Sequence Number.
+ se_csn :: int,
+
+ % Depth of the procedure.
+ se_depth :: int,
+
+ % The goal's module name and procedure name.
se_proc_id :: ssdb_proc_id,
- % The debugger state at the call port.
- se_initial_state :: debugger_state
+ % The list of the procedure's arguments.
+ se_list_var_value :: list(var_value)
).
+%----------------------------------------------------------------------------%
+
%
% Type used by the prompt predicate to configure the next step in the
% handle_event predicate.
@@ -147,13 +201,16 @@
; wn_next
; wn_continue
; wn_finish(int)
- ; wn_retry(int).
+ ; wn_retry(int)
+ ; wn_retry_nondet(int)
+ ; wn_goto(int).
:- inst what_next_no_retry
---> wn_step
; wn_next
; wn_continue
- ; wn_finish(ground).
+ ; wn_finish(ground)
+ ; wn_goto(ground).
%
@@ -165,97 +222,188 @@
% Stop at next step.
; ns_next(int)
- % Stop at next event of the number between brakets.
+ % Stop at next event of the number between brackets.
; ns_continue
% Continue until next breakpoint.
- ; ns_final_port(int, ssdb_retry).
+ ; ns_final_port(int, ssdb_retry)
% Stop at final port (exit or fail) of the number between brakets,
- % the ssdb_retry is used to retry the rigth csn number.
+ % the ssdb_retry is used to retry the right csn number.
+ ; ns_final_port_nondet(int, ssdb_retry)
+ % Same as ns_final_port but for nondet procedure.
+ ; ns_goto(int).
+ % Stop at the Event Number given in argument.
+
+
+ %
+ % A breakpoint is represented by his module and procedure name.
+ %
:- type breakpoint
---> breakpoint(
+ bp_number :: int,
bp_module_name :: string,
- bp_pred_name :: string
+ bp_pred_name :: string,
+ bp_state :: bp_state
).
+:- type bp_state
+ ---> bp_state_enabled
+ ; bp_state_disabled.
%----------------------------------------------------------------------------%
+
%
- % Initialize the debugger state.
- % XXX Will be modifie.
+ % Initialization of the mutable variables.
%
-:- func init_debugger_state = debugger_state.
-init_debugger_state = DbgState :-
- EventNum = 0,
- CSN = 0,
- Depth = 0,
- NextStop = ns_step,
- Stack = stack.init,
- Breakpoints = set.init,
- ListVarValue = [],
- DbgState = state(EventNum, CSN, Depth, NextStop, Stack, Breakpoints,
- ListVarValue).
+:- mutable(cur_ssdb_event_number, int, 0, ground,
+ [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_csn, int, 0, ground, [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_depth, int, 0, ground, [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_next_stop, cur_ssdb_next_stop, ns_step, ground,
+ [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_breakpoints, cur_ssdb_breakpoints, map.init, ground,
+ [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_number_of_breakpoint, int, 0,
+ ground, [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_shadow_stack, cur_ssdb_shadow_stack, stack.init, ground,
+ [untrailed, attach_to_io_state]).
+
+:- mutable(cur_ssdb_shadow_stack_nondet, cur_ssdb_shadow_stack_nondet,
+ stack.init, ground, [untrailed, attach_to_io_state]).
:- mutable(debugger_state, debugger_state, init_debugger_state, ground,
[untrailed, attach_to_io_state]).
+:- func init_debugger_state = debugger_state is det.
+
+init_debugger_state = DebuggerState :-
+ promise_pure (
+ some [!IO] (
+ impure invent_io(!:IO),
+ io.get_environment_var("SSDB", MaybeEnv, !IO),
+ impure consume_io(!.IO)
+ )
+ ),
+ (
+ MaybeEnv = yes(_),
+ DebuggerState = debugger_on
+ ;
+ MaybeEnv = no,
+ DebuggerState = debugger_disabled
+ ).
+
+
%----------------------------------------------------------------------------%
%
% Call at call port. It writes the event out and call the prompt.
%
handle_event_call(ProcId, ListVarValue) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
+
Event = ssdb_call,
- impure get_event_num_inc(EventNum),
- impure update_depth(Event, PrintDepth),
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_csn_inc(CSN),
+ impure get_ssdb_depth_inc(PrintDepth),
- % Set the new CSN.
- impure get_csn_inc(_),
+ % Push the new stack frame on top of the shadow stack.
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ StackFrame = elem(EventNum, CSN, PrintDepth, ProcId, ListVarValue),
+ stack.push(ShadowStack0, StackFrame, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack),
- % Set the list_var_value of the debugger state with the list received.
- impure set_list_var_value(ListVarValue),
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ _AutoRetry),
+ (
+ Stop = yes,
+ some [!IO]
+ (
+ impure invent_io(!:IO),
- % Push the new stack frame on top of the shadow stack.
- semipure get_debugger_state(InitialState),
- StackFrame = elem(ProcId, InitialState),
- stack.push(InitialState ^ ssdb_stack, StackFrame, FinalStack),
- StateEv = InitialState ^ ssdb_stack := FinalStack,
- impure set_debugger_state(StateEv),
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN,
+ !IO),
- semipure get_debugger_state(State0),
+ impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
- CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
+ impure consume_io(!.IO),
- should_stop_at_this_event(Event, CSN, State0, ProcId, Stop, _AutoRetry),
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack,
+ _Retry)
+ )
+ ;
+ Stop = no
+ )
+ ;
+ DebuggerState = debugger_off
+ ;
+ DebuggerState = debugger_disabled
+ ).
+
+
+ %
+ % Call at call port of nondet procedure. It writes the event out and call
+ % the prompt.
+ %
+handle_event_call_nondet(ProcId, ListVarValue) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
+
+ Event = ssdb_call_nondet,
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_csn_inc(CSN),
+ impure get_ssdb_depth_inc(PrintDepth),
+
+ % Push the new stack frame on top of the shadow stack.
+ StackFrame = elem(EventNum, CSN, PrintDepth, ProcId, ListVarValue),
+
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.push(ShadowStack0, StackFrame, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack),
+
+ semipure get_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet0),
+ stack.push(ShadowStackNonDet0, StackFrame, ShadowStackNonDet),
+ impure set_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet),
+
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ _AutoRetry),
(
Stop = yes,
some [!IO]
(
impure invent_io(!:IO),
- print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN,
+ !IO),
- semipure get_shadow_stack(ShadowStack),
impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
impure consume_io(!.IO),
- impure what_next_stop(CSN, WhatNext, ShadowStack, NextStop, _Retry),
-
- % We need to get a new state because breakpoint could have been
- % added in the prompt.
- semipure get_debugger_state(State1),
- State = State1 ^ ssdb_next_stop := NextStop,
- impure set_debugger_state(State)
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack,
+ _Retry)
)
;
Stop = no
+ )
+ ;
+ DebuggerState = debugger_off
+ ;
+ DebuggerState = debugger_disabled
).
@@ -263,359 +411,471 @@
% Call at exit port. Write the event out and call the prompt.
%
handle_event_exit(ProcId, ListVarValue, Retry) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
+
Event = ssdb_exit,
- impure get_event_num_inc(EventNum),
- impure update_depth(Event, PrintDepth),
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_depth_dec(PrintDepth),
+ impure set_list_var_value_in_shadow_stack(ListVarValue),
% Just get the top stack frame. It will be popped at the end of
% handle_event. We need to leave the frame in place, e.g. for
- % printing variables at the end of the procedure.
- impure set_list_var_value_in_stack(ListVarValue),
- semipure get_debugger_state(State0),
- stack.top_det(State0 ^ ssdb_stack, StackFrame),
+ % printing variables at the exit port of the procedure.
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.top_det(ShadowStack0, StackFrame),
+ CSN = StackFrame ^ se_csn,
- CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
-
- should_stop_at_this_event(Event, CSN, State0, ProcId, Stop, AutoRetry),
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ AutoRetry),
(
Stop = yes,
some [!IO]
(
impure invent_io(!:IO),
- print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+ print_event_info(Event, EventNum, ProcId, PrintDepth + 1, CSN,
+ !IO),
- semipure get_shadow_stack(ShadowStack),
(
AutoRetry = do_retry,
WhatNext = wn_retry(CSN)
;
AutoRetry = do_not_retry,
- impure prompt(Event, ShadowStack, 0, WhatNext, !IO)
+ impure prompt(Event, ShadowStack0, 0, WhatNext, !IO)
),
impure consume_io(!.IO),
- impure what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry),
-
- % We need to get a new state because breakpoint could have been
- % added in the prompt.
- semipure get_debugger_state(State1),
- State = State1 ^ ssdb_next_stop := NextStop,
- impure set_debugger_state(State)
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack0,
+ Retry)
)
;
Stop = no,
Retry = do_not_retry
),
- semipure get_debugger_state(PopState),
- stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
- StateEv = PopState ^ ssdb_stack := FinalStack1,
- impure set_debugger_state(StateEv).
+ stack.pop_det(ShadowStack0, _StackFrame1, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack)
+ ;
+ ( DebuggerState = debugger_off
+ ; DebuggerState = debugger_disabled
+ ),
+ Retry = do_not_retry
+ ).
%
- % Call at fail port. Write the event out and call the prompt.
+ % Call at exit port of nondet procedure only.
%
-handle_event_fail(ProcId, _ListVarValue, Retry) :-
- Event = ssdb_fail,
- impure get_event_num_inc(EventNum),
- impure update_depth(Event, PrintDepth),
+handle_event_exit_nondet(ProcId, ListVarValue) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
- semipure get_debugger_state(State0),
- stack.top_det(State0 ^ ssdb_stack, StackFrame),
+ Event = ssdb_exit_nondet,
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_depth_dec(PrintDepth),
+ impure set_list_var_value_in_shadow_stack(ListVarValue),
- CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
+ % Just get the top stack frame. It will be popped at the end of
+ % handle_event. We need to leave the frame in place, e.g. for
+ % printing variables at the exit port of the procedure.
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.top_det(ShadowStack0, StackFrame),
+ CSN = StackFrame ^ se_csn,
- should_stop_at_this_event(Event, CSN, State0, ProcId, Stop, AutoRetry),
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ AutoRetry),
(
Stop = yes,
some [!IO]
(
impure invent_io(!:IO),
- print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+ print_event_info(Event, EventNum, ProcId, PrintDepth + 1, CSN,
+ !IO),
- semipure get_shadow_stack(ShadowStack),
(
AutoRetry = do_retry,
WhatNext = wn_retry(CSN)
;
AutoRetry = do_not_retry,
- impure prompt(Event, ShadowStack, 0, WhatNext, !IO)
+ impure prompt(Event, ShadowStack0, 0, WhatNext, !IO)
),
impure consume_io(!.IO),
- impure what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry),
-
- % We need to get a new state because breakpoint could have been
- % added in the prompt.
- semipure get_debugger_state(State1),
- State = State1 ^ ssdb_next_stop := NextStop,
- impure set_debugger_state(State)
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack0,
+ _Retry)
)
;
- Stop = no,
- Retry = do_not_retry
+ Stop = no
),
- semipure get_debugger_state(PopState),
- stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
- StateEv = PopState ^ ssdb_stack := FinalStack1,
- impure set_debugger_state(StateEv).
+ stack.pop_det(ShadowStack0, _StackFrame1, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack)
+ ;
+ ( DebuggerState = debugger_off
+ ; DebuggerState = debugger_disabled
+ )
+ ).
%
- % Call at redo port. Write the event out and call the prompt.
+ % Call at fail port. Write the event out and call the prompt.
%
-handle_event_redo(ProcId, ListVarValue) :-
- Event = ssdb_redo,
- impure get_event_num_inc(EventNum),
- impure update_depth(Event, PrintDepth),
-
- % 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),
-
- semipure get_debugger_state(InitialState),
- StackFrame = elem(ProcId, InitialState),
- stack.push(InitialState ^ ssdb_stack, StackFrame, FinalStack),
- StateEv = InitialState ^ ssdb_stack := FinalStack,
- impure set_debugger_state(StateEv),
-
- semipure get_debugger_state(State0),
+handle_event_fail(ProcId, _ListVarValue, Retry) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
- CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
+ Event = ssdb_fail,
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_depth_dec(PrintDepth),
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.top_det(ShadowStack0, StackFrame),
+ CSN = StackFrame ^ se_csn,
- should_stop_at_this_event(Event, CSN, State0, ProcId, Stop, _AutoRetry),
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ AutoRetry),
(
Stop = yes,
some [!IO]
(
impure invent_io(!:IO),
- print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
+ print_event_info(Event, EventNum, ProcId, PrintDepth + 1, CSN,
+ !IO),
- semipure get_shadow_stack(ShadowStack),
- impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
+ (
+ AutoRetry = do_retry,
+ WhatNext = wn_retry(CSN)
+ ;
+ AutoRetry = do_not_retry,
+ impure prompt(Event, ShadowStack0, 0, WhatNext, !IO)
+ ),
impure consume_io(!.IO),
- impure what_next_stop(CSN, WhatNext, ShadowStack, NextStop, _Retry),
-
- % We need to get a new state because breakpoint could have been
- % added in the prompt.
- semipure get_debugger_state(State1),
- State = State1 ^ ssdb_next_stop := NextStop,
- impure set_debugger_state(State)
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack0,
+ Retry)
)
;
- Stop = no
+ Stop = no,
+ Retry = do_not_retry
+ ),
+
+ stack.pop_det(ShadowStack0, _StackFrame1, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack)
+ ;
+ ( DebuggerState = debugger_off
+ ; DebuggerState = debugger_disabled
+ ),
+ Retry = do_not_retry
).
%
- % IsSame is 'yes' iff the two call sequence numbers are equal,
- % 'no' otherwise.
+ % Call at fail port of nondet procedure only.
%
-:- pred is_same_csn(int::in, int::in, bool::out) is det.
+handle_event_fail_nondet(ProcId, _ListVarValue, Retry) :-
+ Event = ssdb_fail_nondet,
-is_same_csn(CSNA, CSNB, IsSame) :-
- IsSame = (CSNA = CSNB -> yes ; no).
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
+ impure get_ssdb_event_number_inc(EventNum),
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.top_det(ShadowStack0, StackFrame),
+ CSN = StackFrame ^ se_csn,
+ impure get_ssdb_depth_dec(PrintDepth),
+ semipure get_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet0),
- %
- % Return the current event number.
- %
-:- semipure pred get_event_num(int::out) is det.
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId, Stop,
+ AutoRetry),
+ (
+ Stop = yes,
-get_event_num(EventNum) :-
- semipure get_debugger_state(State0),
- EventNum = State0 ^ ssdb_event_number.
+ some [!IO]
+ (
+ impure invent_io(!:IO),
+ print_event_info(Event, EventNum, ProcId, PrintDepth + 1, CSN,
+ !IO),
- %
- % Increment the current event number in the debugger state,
- % returning the new event number.
- %
-:- impure pred get_event_num_inc(int::out) is det.
+ (
+ AutoRetry = do_retry,
+ (
+ semipure get_correct_frame_nondet(ProcId, PrintDepth+1,
+ StackFrame)
+ ->
+ EventNumF = StackFrame ^ se_event_number,
+ CSNF = StackFrame ^ se_csn,
+ impure set_cur_ssdb_event_number(EventNumF-1),
+ impure set_cur_ssdb_csn(CSNF-1)
+ ;
+ error("Unexpected error : In handle_event_fail_nondet :
+ get_correct_frame_nondet failed")
+ ),
+ WhatNext = wn_retry(CSN)
+ ;
+ AutoRetry = do_not_retry,
+ impure prompt(Event, ShadowStack0, 0, WhatNext, !IO)
+ ),
-get_event_num_inc(EventNum) :-
- semipure get_debugger_state(State0),
- EventNum0 = State0 ^ ssdb_event_number,
- EventNum = EventNum0 + 1,
- State = State0 ^ ssdb_event_number := EventNum,
- impure set_debugger_state(State).
+ impure consume_io(!.IO),
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack0,
+ Retry)
+ )
+ ;
+ Stop = no,
+ Retry = do_not_retry
+ ),
- %
- % Setter of the ssdb_event_number field.
- %
-:- impure pred set_event_num(int::in) is det.
+ stack.pop_det(ShadowStack0, _StackFrame, ShadowStack),
+ stack.pop_det(ShadowStackNonDet0, _StackFrameNonDet, ShadowStackNonDet),
+ impure set_cur_ssdb_shadow_stack(ShadowStack),
+ impure set_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet)
+ ;
+ DebuggerState = debugger_off,
-set_event_num(EventNum) :-
- semipure get_debugger_state(State0),
- State = State0 ^ ssdb_event_number := EventNum,
- impure set_debugger_state(State).
+ semipure get_cur_ssdb_depth(Depth),
+ % Do not succeed at each call
+ (
+ semipure get_correct_frame_nondet(ProcId, Depth+1, _StackFrame)
+ ->
+ Stop = yes
+ ;
+ Stop = no
+ ),
+ (
+ Stop = yes,
+ impure set_debugger_state(debugger_on),
+ Retry = do_retry
+ ;
+ Stop = no,
+ Retry = do_not_retry
+ )
+ ;
+ DebuggerState = debugger_disabled,
+ Retry = do_not_retry
+ ).
%
- % For a given event type, update the depth in the debugger state,
- % returning the updated depth.
+ % Call at redo port in nondet procedure. Write the event out and call
+ % the prompt.
%
-:- impure pred update_depth(ssdb_event_type::in, int::out) is det.
+handle_event_redo_nondet(ProcId, _ListVarValue) :-
+ semipure get_debugger_state(DebuggerState),
+ (
+ DebuggerState = debugger_on,
+
+ Event = ssdb_redo_nondet,
+ impure get_ssdb_event_number_inc(EventNum),
+ impure get_ssdb_depth_inc(PrintDepth),
-update_depth(Event, ReturnDepth) :-
- semipure get_debugger_state(State0),
- Depth0 = State0 ^ ssdb_call_depth,
(
- ( Event = ssdb_call
- ; Event = ssdb_redo
- ),
- Depth = Depth0 + 1,
- ReturnDepth = Depth0
+ semipure get_correct_frame_nondet(ProcId, PrintDepth, StackFrame)
+ ->
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.push(ShadowStack0, StackFrame, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack),
+ CSN = StackFrame ^ se_csn,
+
+ semipure should_stop_at_this_event(Event, EventNum, CSN, ProcId,
+ Stop, _AutoRetry),
+ (
+ Stop = yes,
+ some [!IO]
+ (
+ impure invent_io(!:IO),
+
+ print_event_info(Event, EventNum, ProcId, PrintDepth, CSN,
+ !IO),
+
+ impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
+
+ impure consume_io(!.IO),
+
+ impure what_next_stop(EventNum, CSN, WhatNext, ShadowStack,
+ _Retry)
+ )
;
- ( Event = ssdb_exit
- ; Event = ssdb_fail
- ),
- Depth = Depth0 - 1,
- ReturnDepth = Depth
- ),
- State = State0 ^ ssdb_call_depth := Depth,
- impure set_debugger_state(State).
+ Stop = no
+ )
+ ;
+ error("\nUnexpected error : In handle_event_redo_nondet :
+ get_correct_frame_nondet failed")
+ )
- %
- % Increment the current call sequence number in the debugger state,
- % returning the new call seuqence number.
- %
-:- impure pred get_csn_inc(int::out) is det.
+ ;
+ ( DebuggerState = debugger_off
+ ; DebuggerState = debugger_disabled
+ )
+ ).
-get_csn_inc(CSN) :-
- semipure get_debugger_state(State0),
- CSN0 = State0 ^ ssdb_csn,
- CSN = CSN0 + 1,
- State = State0 ^ ssdb_csn := CSN,
- impure set_debugger_state(State).
+
+%----------------------------------------------------------------------------%
%
- % Return the current call sequence number.
+ % IsSame is 'yes' iff the two call sequence numbers are equal,
+ % 'no' otherwise.
%
-:- semipure pred get_csn(int::out) is det.
+:- pred is_same_int(int::in, int::in, bool::out) is det.
-get_csn(CSN) :-
- semipure get_debugger_state(State0),
- CSN = State0 ^ ssdb_csn.
+is_same_int(IntA, IntB, IsSame) :-
+ IsSame = (IntA = IntB -> yes ; no).
%
- % Setter of the ssdb_csn field.
+ % Increment the CSN and return the new value.
%
-:- impure pred set_csn(int::in) is det.
+:- impure pred get_ssdb_csn_inc(int::out) is det.
-set_csn(CSN) :-
- semipure get_debugger_state(State0),
- State = State0 ^ ssdb_csn := CSN,
- impure set_debugger_state(State).
+get_ssdb_csn_inc(CSN) :-
+ semipure get_cur_ssdb_csn(CSN0),
+ CSN = CSN0 + 1,
+ impure set_cur_ssdb_csn(CSN).
%
- % Return the current shadow stack.
+ % Increment the Event Number and return the new value.
%
-:- semipure pred get_shadow_stack(stack(stack_elem)::out) is det.
+:- impure pred get_ssdb_event_number_inc(int::out) is det.
-get_shadow_stack(ShadowStack) :-
- semipure get_debugger_state(State0),
- ShadowStack = State0 ^ ssdb_stack.
+get_ssdb_event_number_inc(EventNum) :-
+ semipure get_cur_ssdb_event_number(EventNum0),
+ EventNum = EventNum0 + 1,
+ impure set_cur_ssdb_event_number(EventNum).
+ %
+ % Increment the depth and return the new value.
+ %
+:- impure pred get_ssdb_depth_inc(int::out) is det.
+
+get_ssdb_depth_inc(Depth) :-
+ semipure get_cur_ssdb_shadow_stack(ShadowStack),
+ Depth0 = stack.depth(ShadowStack),
+ Depth = Depth0 + 1,
+ impure set_cur_ssdb_depth(Depth).
%
- % Setter of the ssdb_list_var_value field in the debugger_state.
+ % Decrement the depth and return the new value.
%
-:- impure pred set_list_var_value(list(var_value)::in) is det.
+:- impure pred get_ssdb_depth_dec(int::out) is det.
-set_list_var_value(ListVarValue) :-
- semipure get_debugger_state(State0),
- State = State0 ^ ssdb_list_var_value := ListVarValue,
- impure set_debugger_state(State).
+get_ssdb_depth_dec(Depth) :-
+ semipure get_cur_ssdb_shadow_stack(ShadowStack),
+ Depth0 = stack.depth(ShadowStack),
+ Depth = Depth0 - 1,
+ impure set_cur_ssdb_depth(Depth).
%
- % Setter of the ssdb_list_var_value in the first element of the ssdb_stack.
+ % Setter of the se_list_var_value in the first stack_elem.
%
-:- impure pred set_list_var_value_in_stack(list(var_value)::in) is det.
+:- impure pred set_list_var_value_in_shadow_stack(list(var_value)::in) is det.
-set_list_var_value_in_stack(ListVarValue) :-
- semipure get_debugger_state(State0),
- stack.pop_det(State0 ^ ssdb_stack, StackFrame, PopedStack),
- ProcId = StackFrame ^ se_proc_id,
- InitialState = StackFrame ^ se_initial_state,
- NewState = InitialState ^ ssdb_list_var_value := ListVarValue,
- Elem = elem(ProcId, NewState),
- stack.push(PopedStack, Elem, FinalStack),
- State = State0 ^ ssdb_stack := FinalStack,
- impure set_debugger_state(State).
+set_list_var_value_in_shadow_stack(ListVarValue) :-
+ semipure get_cur_ssdb_shadow_stack(ShadowStack0),
+ stack.pop_det(ShadowStack0, StackFrame0, PopedStack),
+ StackFrame = StackFrame0 ^ se_list_var_value := ListVarValue,
+ stack.push(PopedStack, StackFrame, ShadowStack),
+ impure set_cur_ssdb_shadow_stack(ShadowStack).
%
- % Set Stop, if Stop equals yes, we will call the prompt.
+ % should_stop_at_the_event(Event, CSN, EventNum, ProcId, Stop, AutoRetry).
%
-:- pred should_stop_at_this_event(ssdb_event_type::in, int::in,
- debugger_state::in, ssdb_proc_id::in, bool::out, ssdb_retry::out) is det.
+ % Set Stop, if Stop equals yes, the prompt will be call.
+ %
+:- semipure pred should_stop_at_this_event(ssdb_event_type::in, int::in,
+ int::in, ssdb_proc_id::in, bool::out, ssdb_retry::out) is det.
-should_stop_at_this_event(Event, CSN, State, ProcId, ShouldStopAtEvent,
+should_stop_at_this_event(Event, EventNum, CSN, ProcId, ShouldStopAtEvent,
AutoRetry) :-
- NextStop = State ^ ssdb_next_stop,
+ semipure get_cur_ssdb_next_stop(NextStop),
(
NextStop = ns_step,
ShouldStopAtEvent = yes,
AutoRetry = do_not_retry
;
NextStop = ns_next(StopCSN),
- is_same_csn(StopCSN, CSN, ShouldStopAtEvent),
+ is_same_int(StopCSN, CSN, ShouldStopAtEvent),
AutoRetry = do_not_retry
;
NextStop = ns_continue,
+ semipure get_cur_ssdb_breakpoints(BreakPoints),
+ (
+ map.search(BreakPoints,
+ pair(ProcId ^ module_name, ProcId ^ proc_name), BreakPoint)
+ ->
(
- set.contains(State ^ ssdb_breakpoints,
- breakpoint(ProcId ^ module_name, ProcId ^ proc_name))
+ BreakPoint ^ bp_state = bp_state_enabled
->
ShouldStopAtEvent = yes
;
ShouldStopAtEvent = no
+ )
+ ;
+ ShouldStopAtEvent = no
),
AutoRetry = do_not_retry
;
NextStop = ns_final_port(StopCSN, AutoRetry),
(
( Event = ssdb_exit
+ ; Event = ssdb_exit_nondet
; Event = ssdb_fail
+ ; Event = ssdb_fail_nondet
),
- is_same_csn(StopCSN, CSN, ShouldStopAtEvent)
+ is_same_int(StopCSN, CSN, ShouldStopAtEvent)
;
( Event = ssdb_call
- ; Event = ssdb_redo
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_redo_nondet
),
ShouldStopAtEvent = no
)
+ ;
+ NextStop = ns_final_port_nondet(StopCSN, AutoRetry),
+ (
+ Event = ssdb_fail_nondet,
+ is_same_int(StopCSN, CSN, ShouldStopAtEvent)
+ ;
+ ( Event = ssdb_call
+ ; Event = ssdb_exit
+ ; Event = ssdb_fail
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_exit_nondet
+ ; Event = ssdb_redo_nondet
+ ),
+ ShouldStopAtEvent = no
+ )
+ ;
+ NextStop = ns_goto(EventNumToGo),
+ is_same_int(EventNumToGo, EventNum, ShouldStopAtEvent),
+ AutoRetry = do_not_retry
).
%
- % what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry).
+ % what_next_stop(CSN, EventNum, WhatNext, ShadowStack, Retry).
%
% Set the NextStop and the Retry variable according to the WhatNext value.
% In the case where the WathNext is set for a retry, it modify the
% debugger_state at his old value which it had at the call point.
%
-:- impure pred what_next_stop(int::in, what_next::in, stack(stack_elem)::in,
- next_stop::out, ssdb_retry::out) is det.
+:- impure pred what_next_stop(int::in, int::in, what_next::in,
+ stack(stack_elem)::in, ssdb_retry::out) is det.
-what_next_stop(CSN, WhatNext, ShadowStack, NextStop, Retry) :-
+what_next_stop(EventNum, CSN, WhatNext, _ShadowStack, Retry) :-
(
WhatNext = wn_step,
NextStop = ns_step,
@@ -638,17 +898,64 @@
RetryCSN = CSN
->
NextStop = ns_step,
- Retry = do_retry,
- % Set the debugger state for the retry
- stack.top_det(ShadowStack, FrameStack),
- SetCSN = FrameStack ^ se_initial_state ^ ssdb_csn,
- SetEventNum = FrameStack ^ se_initial_state ^ ssdb_event_number,
- impure set_csn(SetCSN - 1),
- impure set_event_num(SetEventNum - 1)
+ Retry = do_retry
;
NextStop = ns_final_port(RetryCSN, do_retry),
Retry = do_not_retry
)
+ ;
+ WhatNext = wn_retry_nondet(RetryCSN),
+ (
+ NextStop = ns_final_port_nondet(RetryCSN, do_retry),
+ Retry = do_not_retry
+ )
+ ;
+ WhatNext = wn_goto(EventNumToGo),
+ (
+ EventNum = EventNumToGo
+ ->
+ NextStop = ns_step,
+ Retry = do_not_retry
+ ;
+ NextStop = ns_goto(EventNumToGo),
+ Retry = do_not_retry
+ )
+ ),
+ impure set_cur_ssdb_next_stop(NextStop).
+
+
+ %
+ % This two following predicates get the right informations in the
+ % shadow_stack_nondet about the current analysed procedure.
+ %
+:- semipure pred get_correct_frame_nondet(ssdb_proc_id::in, int::in,
+ stack_elem::out) is semidet.
+
+get_correct_frame_nondet(ProcId, Depth, StackFrame) :-
+ semipure get_cur_ssdb_shadow_stack_nondet(ShadowStackNonDet),
+ get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet, StackFrame).
+
+
+:- pred get_correct_frame_nondet_2(ssdb_proc_id::in, int::in,
+ stack(stack_elem)::in, stack_elem::out) is semidet.
+
+get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet0, StackFrame) :-
+ (
+ stack.is_empty(ShadowStackNonDet0)
+ ->
+ fail
+ ;
+ stack.pop_det(ShadowStackNonDet0, Frame, ShadowStackNonDet),
+ (
+ Frame ^ se_proc_id ^ module_name = ProcId ^ module_name,
+ Frame ^ se_proc_id ^ proc_name = ProcId ^ proc_name,
+ Frame ^ se_depth = Depth
+ ->
+ StackFrame = Frame
+ ;
+ get_correct_frame_nondet_2(ProcId, Depth, ShadowStackNonDet,
+ StackFrame)
+ )
).
@@ -666,11 +973,29 @@
io.write_string("\t", !IO),
io.write_int(PrintDepth, !IO),
io.write_string("\t", !IO),
+ (
+ ( Event = ssdb_call
+ ; Event = ssdb_call_nondet
+ ),
+ io.write_string("CALL", !IO)
+ ;
+ ( Event = ssdb_exit
+ ; Event = ssdb_exit_nondet
+ ),
+ io.write_string("EXIT", !IO)
+ ;
+ ( Event = ssdb_fail
+ ; Event = ssdb_fail_nondet
+ ),
+ io.write_string("FAIL", !IO)
+ ;
+ Event = ssdb_redo_nondet,
+ io.write_string("REDO", !IO)
+ ),
+ io.write_string("\t\t", !IO),
io.write_string(ProcId ^ module_name, !IO),
io.write_string(".", !IO),
io.write_string(ProcId ^ proc_name, !IO),
- io.write_string(".", !IO),
- io.write(Event, !IO),
io.nl(!IO).
@@ -685,68 +1010,90 @@
% s | _ :: next step
% c :: continue
% b X Y :: breakpoint X = module_name Y = predicate_name
+ % b info:: print info of breakpoints
+ % delete/enable/disable */N
+ % :: delete/enable/disable all/Nth breakpoint
% p :: print
% dump :: print stack trace
% u :: up
% d :: down
+ % g N :: goto Nth event number
%
:- impure pred prompt(ssdb_event_type::in, stack(stack_elem)::in, int::in,
what_next::out, io::di, io::uo) is det.
prompt(Event, ShadowStack, Depth, WhatNext, !IO) :-
+ % XXX use stdout_stream
io.write_string("ssdb> ", !IO),
% Read a string in input and return a string.
- io.read_line_as_string(Result, !IO),
+ io.read_line_as_string(io.stdin_stream, Result, !IO),
(
Result = ok(String0),
% String minus any single trailing newline character.
String = string.chomp(String0),
Words = string.words(String),
- ( Words = ["h"] ->
- io.nl(!IO),
- io.write_string("s :: step", !IO),
- io.nl(!IO),
- io.write_string("n :: next", !IO),
- io.nl(!IO),
- io.write_string("b X Y :: insert breakpoint where :", !IO),
- io.write_string(" X = module name", !IO),
- io.write_string(" and Y = predicate name", !IO),
- io.nl(!IO),
- io.write_string("c :: continue until next breakpoint", !IO),
- io.nl(!IO),
- io.write_string("f :: finish", !IO),
- io.nl(!IO),
- io.write_string("p :: print goal's argument", !IO),
- io.nl(!IO),
- io.write_string("stack :: print stack trace", !IO),
+ (
+ ( Words = ["h"]
+ ; Words = ["help"]
+ )
+ ->
io.nl(!IO),
- io.write_string("u :: up", !IO),
+ io.write_string("\nPrincipal Commands", !IO),
+ io.write_string("\n------------------", !IO),
io.nl(!IO),
- io.write_string("d :: down", !IO),
+ io.write_string("\n<step> or <s> or < >", !IO),
+ io.write_string("\n<next> or <n>n", !IO),
+ io.write_string("\n<continue> or <c>", !IO),
+ io.write_string("\n<finish> or <f>", !IO),
+ io.write_string("\n<retry> or <r>", !IO),
+ io.write_string("\n<break X Y> or <b X Y>", !IO),
+ io.write_string("\n<break info> or <b info>", !IO),
+ io.write_string("\n<enable / disable / delete *>", !IO),
+ io.write_string("\n<enable / disable / delete N>", !IO),
+ io.write_string("\n<print> or <p>", !IO),
+ io.write_string("\n<stack> or <st>", !IO),
+ io.write_string("\n<up> or <u>", !IO),
+ io.write_string("\n<down> or <d>", !IO),
+ io.write_string("\n<goto N> or <g N>", !IO),
+ io.write_string("\n<help> or <h>", !IO),
io.nl(!IO),
- io.write_string("r :: retry", !IO),
io.nl(!IO),
+ io.write_string("\nConsult the file :
+ compiler/ssdb/SSDB_COMMAND_HELP.txt for details", !IO),
io.nl(!IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
- ; Words = ["p"] ->
+ ;
+ ( Words = ["p"]
+ ; Words = ["print"]
+ )
+ ->
CurrentFrame = stack.top_det(ShadowStack),
- ListVarValue = CurrentFrame ^ se_initial_state ^
- ssdb_list_var_value,
+ ListVarValue = CurrentFrame ^ se_list_var_value,
print_vars(ListVarValue, !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
- ; Words = ["stack"] ->
+ ;
+ ( Words = ["st"]
+ ; Words = ["stack"]
+ )
+ ->
print_frames_list(ShadowStack, Depth, !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
- ; Words = ["n"] ->
+ ;
+ ( Words = ["n"]
+ ; Words = ["next"]
+ )
+ ->
(
( Event = ssdb_call
- ; Event = ssdb_redo
- ) ->
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_redo_nondet
+ )
+ ->
WhatNext = wn_next
;
io.write_string("Impossible at exit or fail port\n", !IO),
@@ -754,74 +1101,307 @@
)
;
- ( Words = ["s"]
- ; list.is_empty(Words)
+ ( list.is_empty(Words)
+ ; Words = ["s"]
+ ; Words = ["step"]
)
->
WhatNext = wn_step
- ; Words = ["c"] ->
+ ;
+ ( Words = ["c"]
+ ; Words = ["continue"]
+ )
+ ->
WhatNext = wn_continue
;
- Words = ["b", ModuleName, ProcedureName]
+ ( Words = ["b", ModuleName, ProcedureName]
+ ; Words = ["break", ModuleName, ProcedureName]
+ )
+ ->
+ semipure get_cur_ssdb_breakpoints(BreakPoints0),
+ Key = pair(ModuleName, ProcedureName),
+ ( map.contains(BreakPoints0, Key)
->
- semipure get_debugger_state(State0),
- Breakpoints0 = State0 ^ ssdb_breakpoints,
- Breakpoints = set.insert(Breakpoints0, breakpoint(ModuleName,
- ProcedureName)),
- State = State0 ^ ssdb_breakpoints := Breakpoints,
- io.print(Breakpoints, !IO),nl(!IO),
- impure set_debugger_state(State),
+ io.write_string("The new breakpoint already exist\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ ;
+ semipure get_cur_ssdb_number_of_breakpoint(Number),
+ NewBreakPoint = breakpoint(Number+1, ModuleName,
+ ProcedureName, bp_state_enabled),
+ map.det_insert(BreakPoints0, Key, NewBreakPoint,
+ BreakPoints),
+ BreakPointsListValue = map.values(BreakPoints),
+ print_breakpoints(BreakPointsListValue, !IO),
+ impure set_cur_ssdb_breakpoints(BreakPoints),
+ impure set_cur_ssdb_number_of_breakpoint(Number+1),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
- ; Words = ["f"] ->
+ ;
+ ( Words = ["f"]
+ ; Words = ["finish"]
+ )
+ ->
(
( Event = ssdb_call
- ; Event = ssdb_redo
- ) ->
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_redo_nondet
+ )
+ ->
stack.top_det(ShadowStack, FrameStack),
- CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
+ CSN = FrameStack ^ se_csn,
WhatNext = wn_finish(CSN)
;
- io.write_string("Impossible at exit or fail port\n", !IO),
+ io.write_string("impossible at exit or fail port\n", !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
- ; Words = ["d"] ->
+ ;
+ ( Words = ["f", NStr]
+ ; Words = ["finish", NStr]
+ )
+ ->
+ (
+ string.to_int(NStr, Num),
+ semipure get_cur_ssdb_depth(CurDepth)
+ ->
+ (
+ Num >= 1,
+ Num =< CurDepth
+ ->
+ get_correct_frame_with_num(Num, ShadowStack,
+ StackFrame),
+ CSN = StackFrame ^ se_csn,
+ WhatNext = wn_finish(CSN)
+ ;
+ io.format("The number must be between 1 and %i\n",
+ [i(CurDepth)], !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ;
+ ( Words = ["d"]
+ ; Words = ["down"]
+ )
+ ->
(
DownDepth = Depth - 1,
DownDepth >= 0
->
impure prompt(Event, ShadowStack, DownDepth, WhatNext, !IO)
;
- io.print("Impossible to go down\n", !IO),
+ io.write_string("Impossible to go down\n", !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
- ; Words = ["u"] ->
+ ;
+ ( Words = ["u"]
+ ; Words = ["up"]
+ )
+ ->
(
UpDepth = Depth + 1,
UpDepth < stack.depth(ShadowStack)
->
impure prompt(Event, ShadowStack, UpDepth, WhatNext, !IO)
;
- io.print("Impossible to go up\n", !IO),
+ io.write_string("Impossible to go up\n", !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
- ; Words = ["r"] ->
+ ;
+ ( Words = ["r"]
+ ; Words = ["retry"]
+ )
+ ->
(
( Event = ssdb_exit
; Event = ssdb_fail
- ) ->
+ ; Event = ssdb_fail_nondet
+ ),
stack.top_det(ShadowStack, FrameStack),
- CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
+ EventNum = FrameStack ^ se_event_number,
+ CSN = FrameStack ^ se_csn,
+ impure set_cur_ssdb_event_number(EventNum-1),
+ impure set_cur_ssdb_csn(CSN-1),
WhatNext = wn_retry(CSN)
;
+ Event = ssdb_exit_nondet,
+ stack.top_det(ShadowStack, FrameStack),
+ EventNum = FrameStack ^ se_event_number,
+ CSN = FrameStack ^ se_csn,
+ impure set_debugger_state(debugger_off),
+ % Set the event number and the CSN minus 1 because it will
+ % be increment at the next event. So, we need to be the
+ % event just before
+ impure set_cur_ssdb_event_number(EventNum-1),
+ impure set_cur_ssdb_csn(CSN-1),
+ WhatNext = wn_retry_nondet(CSN)
+ ;
+ ( Event = ssdb_call
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_redo_nondet
+ ),
io.write_string("Impossible at call or redo port\n", !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
)
+
+ ;
+ ( Words = ["r", NStr]
+ ; Words = ["retry", NStr]
+ )
+ ->
+ (
+ string.to_int(NStr, Num),
+ semipure get_cur_ssdb_depth(CurDepth)
+ ->
+ (
+ Num >= 1,
+ Num =< CurDepth
+ ->
+ (
+ ( Event = ssdb_exit
+ ; Event = ssdb_fail
+ ; Event = ssdb_fail_nondet
+ ),
+ get_correct_frame_with_num(Num, ShadowStack,
+ FrameStack),
+ EventNum = FrameStack ^ se_event_number,
+ CSN = FrameStack ^ se_csn,
+ impure set_cur_ssdb_event_number(EventNum-1),
+ impure set_cur_ssdb_csn(CSN-1),
+ WhatNext = wn_retry(CSN)
+ ;
+ Event = ssdb_exit_nondet,
+ get_correct_frame_with_num(Num, ShadowStack,
+ FrameStack),
+ EventNum = FrameStack ^ se_event_number,
+ CSN = FrameStack ^ se_csn,
+ impure set_debugger_state(debugger_off),
+ % Set the event number and the CSN minus 1 because
+ % it will be increment at the next event. So, we
+ % need to be at the event just before the call.
+ impure set_cur_ssdb_event_number(EventNum-1),
+ impure set_cur_ssdb_csn(CSN-1),
+ WhatNext = wn_retry_nondet(CSN)
+ ;
+ ( Event = ssdb_call
+ ; Event = ssdb_call_nondet
+ ; Event = ssdb_redo_nondet
+ ),
+ io.write_string("Impossible at call or redo
+ port\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext,
+ !IO)
+ )
+ ;
+ io.format("The number must be between 1 and %i\n",
+ [i(CurDepth)], !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ;
+ ( Words = ["g", EventNumToGoStr]
+ ; Words = ["goto", EventNumToGoStr]
+ )
+ ->
+ (
+ string.to_int(EventNumToGoStr, EventNumToGo)
+ ->
+ WhatNext = wn_goto(EventNumToGo)
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ;
+ ( Words = ["b", "info"]
+ ; Words = ["break", "info"]
+ )
+ ->
+ semipure get_cur_ssdb_breakpoints(BreakPoints),
+ BreakPointsListValue = map.values(BreakPoints),
+ print_breakpoints(BreakPointsListValue, !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+
+ ; Words = ["disable", "*"] ->
+ impure modif_state_breakpoints(bp_state_disabled, !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+
+ ; Words = ["disable", NumStr] ->
+ (
+ string.to_int(NumStr, Num)
+ ->
+ impure modif_state_breakpoint_with_num(bp_state_disabled, Num,
+ !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ; Words = ["enable", "*"] ->
+ impure modif_state_breakpoints(bp_state_enabled, !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+
+ ; Words = ["enable", NumStr] ->
+ (
+ string.to_int(NumStr, Num)
+ ->
+ impure modif_state_breakpoint_with_num(bp_state_enabled, Num,
+ !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ; Words = ["delete", "*"] ->
+ BreakPoints = map.init,
+ impure set_cur_ssdb_breakpoints(BreakPoints),
+ io.write_string("All breakpoints have been deleted.\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+
+ ; Words = ["delete", NumStr] ->
+ (
+ string.to_int(NumStr, Num)
+ ->
+ impure delete_breakpoint_with_num(Num, !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ ;
+ io.write_string("The number must be an integer\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
+
+ ; Words = ["browse", VarName] ->
+ (
+ get_correct_frame_with_num(1, ShadowStack, CurFrame),
+ ListVarValue = CurFrame ^ se_list_var_value,
+ list_var_value_to_assoc_list(ListVarValue, AssListVarValue),
+ assoc_list.search(AssListVarValue, VarName, Univ)
+ ->
+ io.stdin_stream(StdIn, !IO),
+ io.stdout_stream(StdOut, !IO),
+ browser_info.init_persistent_state(State0),
+ BT = browser_term.univ_to_browser_term(Univ),
+ promise_equivalent_solutions [!:IO] (
+ browse.browse_browser_term_no_modes(BT, StdIn, StdOut, _,
+ State0, _State1, !IO)),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ ;
+ io.write_string("\nError in browse command\n", !IO),
+ impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
+ )
;
io.write_string("huh?\n", !IO),
impure prompt(Event, ShadowStack, Depth, WhatNext, !IO)
@@ -835,6 +1415,151 @@
).
+ %
+ % Transform the list(var_value) into a assoc_list. As it is for the browser
+ % use, only the bound variable are put into the assoc_list structure.
+ %
+:- pred list_var_value_to_assoc_list(list(var_value)::in,
+ assoc_list(string, univ)::out) is det.
+
+list_var_value_to_assoc_list([], []).
+list_var_value_to_assoc_list([VarValue | VarValues], AssocListVarValue) :-
+ (
+ VarValue = unbound_head_var(_Name, _Pos),
+ list_var_value_to_assoc_list(VarValues, AssocListVarValue)
+ ;
+ VarValue = bound_head_var(Name, _Pos, Value),
+ type_to_univ(Value, ValueUniv),
+ list_var_value_to_assoc_list(VarValues, AssocListVarValue0),
+ AssocListVarValue = [pair(Name, ValueUniv) | AssocListVarValue0]
+ ;
+ VarValue = bound_other_var(Name, Value),
+ type_to_univ(Value, ValueUniv),
+ list_var_value_to_assoc_list(VarValues, AssocListVarValue0),
+ AssocListVarValue = [pair(Name, ValueUniv) | AssocListVarValue0]
+ ).
+
+ %
+ % get_correct_frame_with_num(Num, ShadowStack, Frame).
+ %
+ % Get the Nth frame from the shadow stack, begin from the top.
+ % If Num = 1, the current frame will be return.
+ % Num should be in the interval of 1 =< Num =< Depth.
+ % If Num = Depth, the debugger will reach the end of the program.
+ %
+:- pred get_correct_frame_with_num(int::in, stack(stack_elem)::in,
+ stack_elem::out) is det.
+
+get_correct_frame_with_num(Num, ShadowStack0, StackFrame) :-
+ ( Num = 1 ->
+ stack.top_det(ShadowStack0, StackFrame)
+
+ ; Num > 1 ->
+ stack.pop_det(ShadowStack0, _Frame, ShadowStack),
+ get_correct_frame_with_num(Num-1, ShadowStack, StackFrame)
+
+ ;
+ % it shouldn't arrive here.
+ error("Unexpected error : get_correct_frame_with_num")
+ ).
+
+ %
+ % Disable or enable all breakpoints.
+ %
+:- impure pred modif_state_breakpoints(bp_state::in, io::di, io::uo) is det.
+
+modif_state_breakpoints(State, !IO) :-
+ semipure get_cur_ssdb_breakpoints(BreakPoints),
+ BreakPointListValue = map.values(BreakPoints),
+ modif_state_breakpoint(State, BreakPointListValue, BreakPoints,
+ BreakPointsModif, !IO),
+ impure set_cur_ssdb_breakpoints(BreakPointsModif).
+
+
+ %
+ % Modify state (enable or disable) of one breakpoint.
+ %
+:- pred modif_state_breakpoint(bp_state::in, list(breakpoint)::in,
+ map(pair(string, string), breakpoint)::in,
+ map(pair(string, string), breakpoint)::out,
+ io::di, io::uo) is det.
+
+modif_state_breakpoint(_State, [], !BreakPoints, !IO).
+modif_state_breakpoint(State, [BreakPoint0|BreakPoints], !BreakPoints, !IO) :-
+ BreakPoint = BreakPoint0 ^ bp_state := State,
+ print_breakpoint(BreakPoint, !IO),
+ map.det_update(!.BreakPoints,
+ pair(BreakPoint0 ^ bp_module_name, BreakPoint0 ^ bp_pred_name),
+ BreakPoint, !:BreakPoints),
+ modif_state_breakpoint(State, BreakPoints, !BreakPoints, !IO).
+
+
+ %
+ % modif_state_breakpoint_with_num(State, Num, !IO).
+ %
+ % Modify the state of the breakpoint with the number which match Num.
+ %
+:- impure pred modif_state_breakpoint_with_num(bp_state::in, int::in,
+ io::di, io::uo) is det.
+
+modif_state_breakpoint_with_num(State, Num, !IO) :-
+ (
+ semipure get_cur_ssdb_breakpoints(BreakPoints),
+ BreakPointListValue = map.values(BreakPoints),
+ find_breakpoint_with_num(Num, BreakPointListValue, BreakPointToModify)
+ ->
+ modif_state_breakpoint(State, [BreakPointToModify], BreakPoints,
+ BreakPointsModif, !IO),
+ impure set_cur_ssdb_breakpoints(BreakPointsModif)
+ ;
+ io.write_string("No breakpoint found.\n", !IO)
+ ).
+
+
+
+ %
+ % delete_breakpoint_with_num(Num, !IO).
+ %
+ % Delete the breakpoint that match with Num.
+ %
+:- impure pred delete_breakpoint_with_num(int::in, io::di, io::uo) is det.
+
+delete_breakpoint_with_num(Num, !IO) :-
+ (
+ semipure get_cur_ssdb_breakpoints(BreakPoints0),
+ BreakPointsListValue = map.values(BreakPoints0),
+ find_breakpoint_with_num(Num, BreakPointsListValue, BPToDelete)
+ ->
+ Module = BPToDelete ^ bp_module_name,
+ Procedure = BPToDelete ^ bp_pred_name,
+ map.delete(BreakPoints0, pair(Module, Procedure), BreakPoints),
+ impure set_cur_ssdb_breakpoints(BreakPoints),
+ io.format("Breakpoint on %s.%s deleted\n", [s(Module), s(Procedure)],
+ !IO)
+ ;
+ io.write_string("No breakpoint found.\n", !IO)
+ ).
+
+
+ %
+ % find_breakpoint_with_num(Num, ListBreakPoint, BreakPointFound)
+ %
+ % As the structure of a breakpoint have a Number, this predicate will
+ % return BreakPointFound with bp_number that match with the given Num.
+ %
+:- pred find_breakpoint_with_num(int::in, list(breakpoint)::in,
+ breakpoint::out) is semidet.
+
+find_breakpoint_with_num(Num, [BP|ListBreakPoint], BreakPointFound) :-
+ (
+ BP ^ bp_number = Num
+ ->
+ BreakPointFound = BP
+ ;
+ find_breakpoint_with_num(Num, ListBreakPoint, BreakPointFound)
+ ).
+
+
%----------------------------------------------------------------------------%
%
@@ -874,7 +1599,7 @@
io.write_char(' ', !IO)
),
io.format(" %s.%s(\n", [s(Module), s(Procedure)], !IO),
- ListVarValue = Frame ^ se_initial_state ^ ssdb_list_var_value,
+ ListVarValue = Frame ^ se_list_var_value,
print_vars(ListVarValue, !IO),
io.write_string(" )\n", !IO).
@@ -906,7 +1631,8 @@
io.write_string(":\t", !IO),
io.write_int(Pos, !IO),
io.write_string("\t=\t", !IO),
- io.print(T, !IO),
+ Doc = pretty_printer.format(T),
+ write_doc(Doc, !IO),
io.nl(!IO).
print_var(bound_other_var(Name, T), !IO) :-
@@ -915,7 +1641,36 @@
io.write_string(Name, !IO),
io.write_string(":\t_\t", !IO),
io.write_string("=\t", !IO),
- io.print(T, !IO),
+ Doc = pretty_printer.format(T),
+ write_doc(Doc, !IO),
+ io.nl(!IO).
+
+
+ %
+ % Print the current list of breakpoints with their details.
+ %
+:- pred print_breakpoints(list(breakpoint)::in, io::di, io::uo) is det.
+
+print_breakpoints(BreakPoints, !IO) :-
+ list.foldl(print_breakpoint, BreakPoints, !IO).
+
+:- pred print_breakpoint(breakpoint::in, io::di, io::uo) is det.
+
+print_breakpoint(BreakPoint, !IO) :-
+ io.write_char('\t', !IO),
+ io.write_int(BreakPoint ^ bp_number, !IO),
+ io.write_char('\t', !IO),
+ io.write_string(BreakPoint ^ bp_module_name, !IO),
+ io.write_string(".", !IO),
+ io.write_string(BreakPoint ^ bp_pred_name, !IO),
+ io.write_string("\t", !IO),
+ (
+ BreakPoint ^ bp_state = bp_state_enabled,
+ io.write_string("enable", !IO)
+ ;
+ BreakPoint ^ bp_state = bp_state_disabled,
+ io.write_string("disable", !IO)
+ ),
io.nl(!IO).
Index: tests/.mgnuc_copts.ws
===================================================================
RCS file: /home/mercury1/repository/tests/.mgnuc_copts.ws,v
retrieving revision 1.1
diff -u -r1.1 .mgnuc_copts.ws
--- tests/.mgnuc_copts.ws 20 May 2005 06:15:24 -0000 1.1
+++ tests/.mgnuc_copts.ws 3 Dec 2007 04:38:19 -0000
@@ -8,3 +8,5 @@
-I at WORKSPACE@/browser
-I at WORKSPACE@/browser/Mercury/mihs
-I at WORKSPACE@/trace
+-I at WORKSPACE@/ssdb
+-I at WORKSPACE@/ssdb/Mercury/mihs
Index: tests/WS_FLAGS.ws
===================================================================
RCS file: /home/mercury1/repository/tests/WS_FLAGS.ws,v
retrieving revision 1.1
diff -u -r1.1 WS_FLAGS.ws
--- tests/WS_FLAGS.ws 6 May 2005 08:42:30 -0000 1.1
+++ tests/WS_FLAGS.ws 3 Dec 2007 04:38:19 -0000
@@ -12,5 +12,7 @@
--c-include-directory @WORKSPACE@/browser
--c-include-directory @WORKSPACE@/browser/Mercury/mihs
--c-include-directory @WORKSPACE@/trace
+--c-include-directory @WORKSPACE@/ssdb
+--c-include-directory @WORKSPACE@/ssdb/Mercury/mihs
--linkage shared
--config-file @WORKSPACE@/scripts/Mercury.config.bootstrap
--------------------------------------------------------------------------
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