[m-rev.] ssdb version 1.0.
Peter Wang
novalazy at gmail.com
Fri Nov 30 12:52:44 AEDT 2007
On 2007-11-29, Olivier Annet <oan at missioncriticalit.com> wrote:
> Hi,
>
> Here is the version 1.0 of the source-to-source debugger. A bootcheck had been
> successfully done some days ago.
For the record, it didn't actually run the test cases due to missing
TEST_FLAGS (or similar). stage2 was accidentally built in
none.ssdebug.gc grade. It took about 9 hrs, I think. Also it was built
at -O1 to avoid a compiler abort, which has been worked around now by
moving the ssdb pass a bit later (see below).
> It look like stable and without bug except
> these in the description bellow.
>
> Could someone can review my code before commiting. Thanks.
>
> Olivier.
>
> ===================================================================
>
>
> Estimated hours taken: 120
> Branches: main
>
> The debugger lose the CSN and the event number when a redo port follow an exit
> port (in nondet procedure so). The solution was to create a second stack for
> nondet procedure.
>
>
> There are some modification for the nondet code generated. When a retry is
> asked during the execution of the program, the decision tree of the nondet
> procedure stay in memory.
I think you mean a "choicepoint is left behind". A decision tree is
something else: http://en.wikipedia.org/wiki/Decision_tree
> So, when the retry call will terminate, the redo left
> from the caller procedure will be executed.
It's not a very clear explanation.
> The proposed solution is : when a
> retry occurs at a exit port of a nondet procedure, the debugger will jump to
> the fail port of this procedure and make the recursive call from there.
Explain how the "jump" works. I would call it "deferring" rather than
jumping.
> The new transformed schema of the generated code are now :
>
> model nondet/multi transformed:
There is just model_non.
> p(...) :-
> promise_<original_purity> (
> (
> CallVarDescs = [ ... ],
> impure call_port(ProcId, CallVarDescs),
> <original body>,
> ExitVarDescs = [ ... | CallVarDescs ],
> (
> impure exit_port(ProcId, ExitVarDescs)
> % Go to fail port if retry.
> ;
> % preserve_backtrack_into,
> impure redo_port(ProcId, ExitVarDescs),
> fail
> )
> ;
> % preserve_backtrack_into
> impure fail_port(ProcId, CallVarDescs, DoRetryB),
> (
> DoRetryB = do_retry,
> p(...)
> ;
> DoRetryB = do_not_retry,
> fail
> )
> )
> ).
>
>
> KNEW BUG : When most than one solution is asked for a nondet/multi procedure,
Known problem: when more than
> and that the user make retry, if a predicate like solutions.unsorted_solutions
> is used, the same solutions are displayed more than one time.
The problem is not just displaying, but that retrying a procedure which
is being called by unsorted_solutions will add the same solution to the
solution set multiple times.
Mention that `solutions' is okay because it removes duplicates.
> This is a
> LIMITATION OF THE PROGRAM and the ssdb will going to live with it for the
> moment.
>
> browser/util.m:
> Some modifications was necessary to take in account the invocation in
> the ssdb.
Describe *what* the changes are. In this case,
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.
[Actually, the change I made won't be enough for non-C backends, but
don't worry about it.]
> 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:
> - The generated code for failure and erroneous procedure have been
> added.
Transform procedures with `failure' and `erroneous' determinisms.
> - Funny type of some argument are not managed, the argument should be
> fully input or fully output.
> Funny type means :
> <reserved_object(free, free, free)> instead of <free>
> and <reserved_object(ground, ground, ground)> instead of <ground>
You mean _modes_ instead of types. Delete the example.
`reserved_object(...)' was just a case that popped up in the compiler in
a generated unify procedure.
I think we can and should handle `unused' arguments as well, but later.
> This is an other LIMITATION OF THE PROGRAM.
"Transformation" instead of "program". No need for capitals.
> profiler/Mmakefile:
> Modification to invoque to browser in the ssdb.
Link with the mer_ssdb library.
> ssdb/Mercury.options:
> Ditto.
Link with the mer_browser library to support browsing of terms.
> ssdb/SSDB_FLAGS.in:
> To enable the source-to-source transformation or not from the ssdb
> and to don't do the transformation on the ssdb himself.
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.
Which commands?
> - There is the possibility to call the browser.
> - Introduction of the pretty printer formating on arguments because
> some could be very big (thousand lines).
>
> tests/.mgnuc_copts.ws:
> Modification for bootcheck.
Search in the ssdb directory for header files.
> tests/WS_FLAGS.ws:
> Ditto.
Just put the two lines together instead of writing ditto.
> 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 29 Nov 2007 02:17:32 -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,44 @@
> 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;
> ").
Fix the tabs.
>
> 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("error")
> + ).
> +
Fix the tabs. And throw a better error (yes, I know I wrote that :-)
> 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 29 Nov 2007 02:17:32 -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,26 @@
> % )
> % )
> % ).
> +%
> +% model_failure:
detism_failure
> +%
> +% p(...) :-
> +% promise_<original_purity> (
> +% (
> +% CallVarDescs = [ ... ],
> +% impure call_port(ProcId, CallVarDescs),
> +% <original body>,
> +% impure fail_port(ProcId, CallVarDescs, DoRetry),
> +% (
> +% DoRetry = do_retry,
> +% p(...)
> +% ;
> +% DoRetry = do_not_retry,
> +% fail
> +% )
> +% )
> +% ).
Are you sure? How does it reach the call to `fail_port'?
Did you document the transformation for erroneous procedures?
> +%
> %
> % where CallVarDescs, ExitVarDescs are lists of var_value
> %
> @@ -136,8 +147,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 the debugging.
Delete "the".
> :- pred ssdebug.process_proc(pred_id::in, proc_id::in,
> proc_info::in, proc_info::out, module_info::in, module_info::out,
> @@ -148,6 +159,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 +215,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)
> ).
>
>
> @@ -233,15 +245,16 @@
> % Get the list of head variables and their instantiation 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),
>
> - % Generate the call to handle_event_call(ProcId, VarList).
> - make_handle_event("call", [ProcIdVar, CallArgListVar],
> + % Generate the call to
> + % handle_event_call(ProcId, EventNum, CSN, VarList).
> + make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
This new comment and other similar ones are out of date.
> HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
>
> % Get the InstMap at the end of the procedure.
> @@ -262,43 +275,47 @@
> 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),
> + % Generate the call to
> + % handle_event_exit(ProcId, EventNum, CSN, VarList, DoRetry).
> + 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, !IO)
> ).
>
>
> @@ -316,121 +333,150 @@
> 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),
> -
> - % 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("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_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],
> + proc_info_get_argmodes(!.ProcInfo, ListMerMode),
> + check_arguments_modes(!.ModuleInfo, ListMerMode, AllModeAreCorrect),
>
> - 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),
> + ( AllModeAreCorrect = yes
> + ->
Formatting.
"Correct" is the wrong word. The modes are not wrong, just incompatible
with the transformation.
{
> + Goal),
>
> - commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
> - !ModuleInfo, !.Varset, !.Vartypes)
> + commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
> + !ModuleInfo, !.Varset, !.Vartypes, !IO)
> + ;
> + % In the case of a mode is different from fully input or output,
> + % nothing is generated for this procedure.
which is not fully input or output
the procedure is not transformed.
> + true
> + )
> ).
>
>
> + %
> + % Source-to-source transformation for a failure goal.
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 type.
instantiation state
{
> + !ModuleInfo, !.Varset, !.Vartypes, !IO)
> + ).
> +
> +
> + %
> + % Source-to-source transformation for an erroneous goal.
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.
> +
> @@ -655,10 +851,11 @@
> %
> :- 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.
> + module_info::in, module_info::out, prog_varset::in, vartypes::in,
> + io::di, io::uo) is det.
>
> commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo, !ModuleInfo,
> - Varset, Vartypes) :-
> + Varset, Vartypes, !IO) :-
What's the !IO for?
>
> proc_info_set_varset(Varset, !ProcInfo),
> proc_info_set_vartypes(Vartypes, !ProcInfo),
> @@ -670,9 +867,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 +876,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 +941,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, bool::out)
> + is det.
> +
> +check_arguments_modes(ModuleInfo, HeadModes, IsCorrectMode) :-
> + (
> + all [Modes] (
> + list.member(Mode, HeadModes)
> + =>
> + ( mode_is_fully_input(ModuleInfo, Mode)
> + ; mode_is_fully_output(ModuleInfo, Mode)
> + )
> + )
> + ->
> + IsCorrectMode = yes
> + ;
> + IsCorrectMode = no
> + ).
You could make it semidet.
> +
> %-----------------------------------------------------------------------------%
>
> + %
> + % The following code concern predicates which create the list argument at
> + % event point.
> + %
> +
>
> %
> % make_arg_list(Pos, InstMap, Vars, RenamedVar, FullListVar, Goals,
> @@ -812,7 +1034,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 +1140,73 @@
>
> Goals = [ConstructVarName, ConstructVarPos, ConstructVarGoal]
> ).
> +
> +
> +%-----------------------------------------------------------------------------%
> +
> + %
> + % The following goals generate the code for introduce the getters and
> + % setters of EventNum and CSN in the code.
> + %
> +
> +
> + %
> + % make_call_getter(ProcedureName, VarName, Purity, Var, Goal, !ModuleInfo,
> + % !VarSet, !VarTypes)
> + %
> + % Call a getter, the Purity could be semipure or impure to allow calling to
> + % getters which increment the argument before returning it.
> + %
> +:- pred make_call_getter(string::in, string::in, purity::in, prog_var::out,
> + hlds_goal::out, module_info::in, module_info::out,
> + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
Do you call this anymore?
> +
> +make_call_getter(GetterToCallName, VarName, Purity, CSNVar, Goal, !ModuleInfo,
> + !VarSet, !VarTypes) :-
> + % Make output event number variable
> + make_output_int(VarName, CSNVar, !VarSet, !VarTypes),
> +
> + SSDBModule = mercury_ssdb_builtin_module,
> + Arguments = [CSNVar],
> + Features = [],
> + InstMapSrc = [],
> + Context = term.context_init,
> + goal_util.generate_simple_call(SSDBModule, GetterToCallName,
> + pf_predicate, only_mode, detism_det, Purity, Arguments, Features,
> + InstMapSrc, !.ModuleInfo, Context, Goal).
> +
> +
> + %
> + % make_call_setter(ProcedureName, Var, Goal, !ModuleInfo).
> + %
> + % Call any setter.
> + %
> +:- pred make_call_setter(string::in, prog_var::in, hlds_goal::out,
> + module_info::in, module_info::out) is det.
And this?
> +
> +make_call_setter(SetterToCallName, CSNVar, Goal, !ModuleInfo) :-
> + SSDBModule = mercury_ssdb_builtin_module,
> + Arguments = [CSNVar],
> + Features = [],
> + InstMapSrc = [],
> + Context = term.context_init,
> + goal_util.generate_simple_call(SSDBModule, SetterToCallName,
> + pf_predicate, only_mode, detism_det, purity_impure,
> + Arguments, Features, InstMapSrc, !.ModuleInfo, Context, Goal).
> +
> +
> + %
> + % Generate an output variable with type : int.
> + %
> +:- pred make_output_int(string::in, prog_var::out,
> + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
And this.
> +
> +make_output_int(Name, Var, !VarSet, !VarTypes) :-
> + TypeCtor = type_ctor(unqualified("int"), 0),
> + construct_type(TypeCtor, [], Type),
> + svvarset.new_named_var(Name, Var, !VarSet),
> + svmap.det_insert(Var, Type, !VarTypes).
> +
>
> %-----------------------------------------------------------------------------%
> %-----------------------------------------------------------------------------%
> 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 29 Nov 2007 02:17:32 -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,132 @@
> %
> :- 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_redo(ssdb_proc_id::in, list_var_value::in) is det.
> +:- 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_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.
> +
> +:- import_module mdb.
> +:- import_module mdb.browse.
> +:- import_module mdb.browser_info.
> +:- import_module mdb.browser_term.
>
> %----------------------------------------------------------------------------%
>
> -:- type debugger_state
> - ---> state(
> - % Current event number.
> - ssdb_event_number :: int,
> + %
> + % These variables are all mutable, they are used to record the diffrents
> + % state of the debugger.
> + %
Do you need all of these equivalence types?
> +
> +:- type cur_ssdb_event_number == int.
> +
> +:- type cur_ssdb_csn == int.
>
> - % Call Sequence Number.
> - ssdb_csn :: int,
> +:- type cur_ssdb_depth == int.
>
> - % Depth of the function.
> - ssdb_call_depth :: int,
> +:- type cur_ssdb_next_stop == next_stop.
>
> - % Where the program should stop next time.
> - ssdb_next_stop :: next_stop,
> +:- type cur_ssdb_breakpoints == map(pair(string,string), breakpoint).
>
> - % The shadow stack.
> - ssdb_stack :: stack(stack_elem),
> +:- type cur_ssdb_number_of_breakpoint == int.
>
> - % 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: disable_debugger 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 disable_debugger first, it will
> + % be represented by zero so the SSDB port code will correctly do nothing
> + % until after the library is initialised.
> + %
> +:- type do_nothing
> + ---> disable_debugger
> + ; do_something
> + ; do_nothing.
Rename this type and the last two function symbols.
> + %
> + % Picture of the current call procedure.
> + %
A stack frame representing a procedure call.
> :- type stack_elem
> ---> elem(
> - se_proc_id :: ssdb_proc_id,
> + % 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 goal's argument.
procedure's arguments
> @@ -162,460 +226,668 @@
> %
> :- type next_stop
> ---> ns_step
> - % Stop at next step.
> + % Stop at next step.
>
> ; ns_next(int)
> - % Stop at next event of the number between brakets.
> + % Stop at next event of the number between brakets.
>
> ; ns_continue
> - % Continue until next breakpoint.
> + % Continue until next breakpoint.
>
> - ; 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.
> + ; ns_final_port(int, ssdb_retry)
> + % Stop at final port (exit or fail) of the number between brakets,
brackets
> + % the ssdb_retry is used to retry the rigth csn number.
right
>
> + ; ns_final_port_nondet(int, ssdb_retry)
> + % Same than ns_final_port but for nondet procedure.
Same as
>
> + ; ns_goto(int).
> + % Stop at the Event Number give in argument.
given in
> +
> +
> + %
> + % A breakpoint is represented by his module and procedure name.
> + % It is possible to insert a breakpoint in the debugger with the following
> + % command:
> + % b ModuleName ProcedureName
> + %
Delete that, it should just be in the help. Then we don't have to
maintain it.
> :- 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_enable
> + ; bp_state_disable.
enabled / disabled
> %----------------------------------------------------------------------------%
>
> +
> %
> - % Initialize the debugger state.
> - % XXX Will be modifie.
> + % Initialization of the mutable variable.
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, cur_ssdb_event_number, 0, ground,
> + [untrailed, attach_to_io_state]).
>
> -:- mutable(debugger_state, debugger_state, init_debugger_state, ground,
> +:- mutable(cur_ssdb_csn, cur_ssdb_csn, 0, ground,
> [untrailed, attach_to_io_state]).
>
> -%----------------------------------------------------------------------------%
> +:- mutable(cur_ssdb_depth, cur_ssdb_depth, 0, ground,
> + [untrailed, attach_to_io_state]).
>
> - %
> - % Call at call port. It writes the event out and call the prompt.
> - %
> -handle_event_call(ProcId, ListVarValue) :-
> - Event = ssdb_call,
> - 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),
> -
> - % 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),
> -
> - semipure get_debugger_state(State0),
> +:- mutable(cur_ssdb_next_stop, cur_ssdb_next_stop, ns_step, ground,
> + [untrailed, attach_to_io_state]).
>
> - CSN = StackFrame ^ se_initial_state ^ ssdb_csn,
> +:- mutable(cur_ssdb_breakpoints, cur_ssdb_breakpoints, map.init, ground,
> + [untrailed, attach_to_io_state]).
>
> - should_stop_at_this_event(Event, CSN, State0, ProcId, Stop, _AutoRetry),
> - (
> - Stop = yes,
> - some [!IO]
> - (
> - impure invent_io(!:IO),
> -
> - print_event_info(Event, EventNum, ProcId, PrintDepth, CSN, !IO),
> -
> - semipure get_shadow_stack(ShadowStack),
> - impure prompt(Event, ShadowStack, 0, WhatNext, !IO),
> +:- mutable(cur_ssdb_number_of_breakpoint, cur_ssdb_number_of_breakpoint, 0,
> + ground, [untrailed, attach_to_io_state]).
>
> - impure consume_io(!.IO),
> +:- 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(do_nothing, do_nothing, init_do_nothing, ground,
> + [untrailed, attach_to_io_state]).
>
> - impure what_next_stop(CSN, WhatNext, ShadowStack, NextStop, _Retry),
> +:- func init_do_nothing = do_nothing is det.
>
> - % 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)
> +init_do_nothing = DoNothing :-
> + promise_pure (
> + some [!IO] (
Put an XXX here. The check for the SSDB environment variable is only
temporary. Eventually it should check whatever mdb checks.
> + impure invent_io(!:IO),
> + io.get_environment_var("SSDB", MaybeEnv, !IO),
> + impure consume_io(!.IO)
> )
> + ),
> + (
> + MaybeEnv = yes(_),
> + DoNothing = do_something
> ;
> - Stop = no
> + MaybeEnv = no,
> + DoNothing = disable_debugger
> ).
>
>
>
> -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).
> +is_same_int(INTA, INTB, IsSame) :-
> + IsSame = (INTA = INTB -> yes ; no).
IntA, IntB
> % 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) :-
This predicate is too big and heavily indented. Split it up.
> @@ -835,6 +1427,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) :-
You could use list.filter_map.
> + (
> + 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).
> + %
> + % If Num = 1, the current frame will be return.
> + % Num should be in the interval of 1 >= Num <= Depth.
Do you mean: 1 =< Num =< Depth
I can't tell what this predicate is supposed to do from the comment.
> + % 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 ->
Formatting.
> + 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("\nUnexpected error : get_correct_frame_with_num\n")
Delete the newlines.
> + ).
> +
> + %
> + % 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).
> +
> +
> + %
> + % Modifie state of one breakpoint.
Modify
> + %
> +:- 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.
Rename it. What does it do?
> +
> +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.
Ditto.
> + % find_breakpoint_with_num(Num, ListBreakPoint, BreakPointFound)
> + %
> + % Return BreakPointFound that match the corresponding Num.
> + %
> +:- pred find_breakpoint_with_num(int::in, list(breakpoint)::in,
> + breakpoint::out) is semidet.
> +
> +% find_breakpoint_with_num(_Num, [], _BreakPointToModify) :-
> +% error("\nError : No breakpoint found").
Delete that.
> +find_breakpoint_with_num(Num, [BP|ListBreakPoint], BreakPointToModify) :-
> + (
> + BP ^ bp_number = Num
> + ->
> + BreakPointToModify = BP
> + ;
> + find_breakpoint_with_num(Num, ListBreakPoint, BreakPointToModify)
> + ).
BreakPointToModify doesn't make sense without looking at the caller.
Can you send a new diff made with `cvs diff --ignore-space-change' after
you make the changes? The changes in ssdb.m are hard to see. Thanks.
Peter
--------------------------------------------------------------------------
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