[m-rev.] ssdb goal's argument generation at call and exit point
Peter Ross
pro at missioncriticalit.com
Thu Oct 18 11:30:38 AEST 2007
On Wed, Oct 17, 2007 at 02:16:12PM +1000, Olivier Annet wrote:
> Hi,
>
> Could someone can review my code before commit please.
>
> Thanks.
>
>
> ===================================================================
>
>
> Estimated hours taken: 50
> Branches: main
>
> Some command added in the prompt :
> -> p :: print
> -> pst :: print stack trace
> -> u :: up
> -> d :: down
>
> The main changement is the addition of the goal's arguments list generation at
> the call and exit point.
>
I would reword this as the following:
In this change each of head variables have their values recorded at the
call and exit ports. These values can then be printed out.
Also code was added to print the stack trace and navigate up and down
the stack.
> compiler/ssdebug.m:
> - Adapted to construct the list of arguments at the call and exit point
>
> ssdb/ssdb.m:
> - Adapted to recieve the list of argument at the call and exit point
> - Type var_value added to recieve the goal's arguments
> - Add an extra ssdb_list_var_value :: list(var_value) argument to the debugger
> state
why did you add this to the debugger state?
>
>
> Index: compiler/ssdebug.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
> retrieving revision 1.4
> diff -u -r1.4 ssdebug.m
> --- compiler/ssdebug.m 9 Oct 2007 01:22:13 -0000 1.4
> +++ compiler/ssdebug.m 17 Oct 2007 03:38:52 -0000
> @@ -109,9 +109,9 @@
> % where CallVarDescs, ExitVarDescs are lists of var_value
> %
> % :- type var_value
> -% ---> unbound_head_var(var_name, pos)
> -% ; some [T] bound_head_var(var_name, pos, T)
> -% ; some [T] bound_other_var(var_name, T).
> +% ---> unbound_head_var(var_name, pos) :: out variable
> +% ; some [T] bound_head_var(var_name, pos, T) :: in variable
> +% ; some [T] bound_other_var(var_name, T). :: intern variable
s/intern/internal/
> %
> % :- type var_name == string.
> %
> @@ -135,31 +135,38 @@
> +
> :- implementation.
>
> :- import_module check_hlds.mode_util.
> +:- import_module check_hlds.polymorphism.
> :- import_module hlds.goal_util.
> :- import_module hlds.hlds_goal.
> +:- import_module hlds.instmap.
> :- import_module hlds.pred_table.
> :- import_module hlds.quantification.
> :- import_module mdbcomp.prim_data.
> :- import_module parse_tree.prog_data.
> :- import_module parse_tree.prog_type.
> +:- import_module varset.
>
> :- import_module ssdb.
>
> :- import_module assoc_list.
> :- import_module bool.
> +:- import_module int.
> +:- import_module io.
> :- import_module list.
> +:- import_module map.
> :- import_module maybe.
> :- import_module pair.
> :- import_module string.
> @@ -172,22 +179,35 @@
> process_proc(PredId, _ProcId, !ProcInfo, !ModuleInfo, !IO) :-
> proc_info_get_goal(!.ProcInfo, Goal0),
>
> - some [!Varset, !Vartypes] (
> + 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),
> -
> - %
> - % Build the following two goals
> - % CallVar = ssdb_call,
> - % handle_event(CallVar)
> - %
> + %
> + % Make the ssdb_proc_id.
> + %
> + module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
> + make_proc_id_construction(!.PredInfo, !.ProcInfo, ProcIdGoals,
> + ProcIdVar, !Varset, !Vartypes),
> +
> + %
> + % Get list(prog_var) and there type.
> + %
s/there/their/g
> + proc_info_get_headvars(!.ProcInfo, HeadVars),
> + proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
> +
> + %
> + % Make the list of argument at call point
> + %
I would reword this as
Make a list which records the value for each of the head variables at
the call port.
> + make_arg_list(0, InitInstMap, HeadVars, FullListCallVar,
> + FullListCallGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> + !Vartypes),
> +
> + %
> + % Build the following two goals
> + % CallVar = ssdb_call,
> + % handle_event(ProcId, ssdb_call, VarList).
> + %
> make_ssdb_event_type_construction(ssdb_call,
> CallConstructor, CallVar, !Varset, !Vartypes),
>
> @@ -197,38 +217,56 @@
> Context = term.context_init,
> goal_util.generate_simple_call(SSDBModule, "handle_event",
> pf_predicate, only_mode, detism_det, purity_impure,
> - [ProcIdVar, CallVar],
> + [ProcIdVar, CallVar, FullListCallVar],
> Features, InstMapSrc, !.ModuleInfo, Context, HandleCallEventGoal),
> - %
> - % Build the following two goals
> - % ExitVar = ssdb_exit,
> - % handle_event(ExitVar)
> - %
> +
> + %
> + % Get the updated InstMap.
> + %
> + update_instmap(Goal0, InitInstMap, UpdatedInstMap),
> +
> + %
> + % Make the list argument at exit point, it's a new list instead reuse
> + % the call list.
> + % XXX Optimization : Only output variables should be generated
> + %
> + make_arg_list(0, UpdatedInstMap, HeadVars, FullListExitVar,
> + FullListExitGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
> + !Vartypes),
> +
> + %
> + % Build the following two goals
> + % ExitVar = ssdb_exit,
> + % handle_event(ProcId, ssdb_exit, VarList).
> + %
> make_ssdb_event_type_construction(ssdb_exit,
> ExitConstructor, ExitVar, !Varset, !Vartypes),
>
> goal_util.generate_simple_call(SSDBModule, "handle_event",
> pf_predicate, only_mode, detism_det, purity_impure,
> - [ProcIdVar, ExitVar],
> + [ProcIdVar, ExitVar, FullListExitVar],
> Features, InstMapSrc, !.ModuleInfo, Context, HandleExitEventGoal),
> - %
> - % Place the call and exit events around the initial goal.
> - % XXX we still need to extend this to handle the other event types
> - %
> - ConjGoals = ProcIdGoals ++ [CallConstructor, HandleCallEventGoal,
> - Goal0, ExitConstructor, HandleExitEventGoal],
> + %
> + % Place the call and exit events around the initial goal.
> + % XXX we still need to extend this to handle the other event types
> + %
> + ConjGoals = ProcIdGoals ++ FullListCallGoals ++ [CallConstructor,
> + HandleCallEventGoal, Goal0] ++ FullListExitGoals ++
> + [ExitConstructor, HandleExitEventGoal],
>
> goal_info_init(GoalInfo),
> Goal = hlds_goal(conj(plain_conj, ConjGoals), GoalInfo),
>
> proc_info_set_varset(!.Varset, !ProcInfo),
> - proc_info_set_vartypes(!.Vartypes, !ProcInfo)
> - ),
> + proc_info_set_vartypes(!.Vartypes, !ProcInfo),
> +
> + proc_info_set_goal(Goal, !ProcInfo),
>
> - proc_info_set_goal(Goal, !ProcInfo),
> + requantify_proc(!ProcInfo),
> + recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
>
> - requantify_proc(!ProcInfo),
> - recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo).
> + module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
> + ).
>
> %-----------------------------------------------------------------------------%
>
> @@ -268,8 +306,148 @@
> ConstructProcIdGoal),
>
> Goals = [ConstructModuleName, ConstructPredName, ConstructProcIdGoal].
> +
> +%-----------------------------------------------------------------------------%
> +
> + %
> + % make_arg_list(ArgumentPosition, InstMap, [VarToInspect | ListCallVar],
> + % Var, Goals, !Varset, !Vartypes) :-
> + %
> + % The first ArgumentPosition has been given when function is called.
> + % Goals contain all the arguments goals construction (Variables and list).
> + % Var is only used for the recursion.
> + %
> + % Construct the list of argument corresponding to the goal's argument.
> + %
I find this commend very hard to understand.
I find the following easier to understand.
make_arg_list(Pos, InstMap, Vars, ListVar, Goals, !Varset, !Vartypes)
processes each variable in Vars creating a list(var_value) which records
the value of each of the variables. ListVar points to the start of the
list and Goals is the list of goals to construct the list. Pos
indicates which argument position the first variable in Vars is.
InstMap is used to work out if the variable is instantiated enough yet
to display.
> +:- pred make_arg_list(int::in, instmap::in, list(prog_var)::in,
> + prog_var::out, list(hlds_goal)::out, module_info::in, module_info::out,
> + proc_info::in, proc_info::out, pred_info::in, pred_info::out,
> + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
> +
> +make_arg_list(_, _, [], Var, [Goal], !ModuleInfo, !ProcInfo, !PredInfo,
> + !Varset, !Vartypes) :-
> +
> + svvarset.new_named_var("EmptyVarList", Var, !Varset),
> + svmap.det_insert(Var, list_var_value_type, !Vartypes),
> + ConsId = cons(qualified(unqualified("list"), "[]" ), 0),
> + construct_functor(Var, ConsId, [], Goal).
> +
> +make_arg_list(Pos0, InstMap, [VarToInspect | ListCallVar], Var, Goals,
> + !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes) :-
> +
> + Pos = Pos0 + 1,
> +
> + make_arg_list(Pos, InstMap, ListCallVar, Var0, Goals0,
> + !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes),
> + make_var_value(InstMap, VarToInspect, VarDesc, Pos0, ValueGoals,
> + !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes),
> +
> + svvarset.new_named_var("FullListVar", Var, !Varset),
> + svmap.det_insert(Var, list_var_value_type, !Vartypes),
> + ConsId = cons(qualified(unqualified("list"), "[|]" ), 2),
> + construct_functor(Var, ConsId, [VarDesc, Var0], Goal),
> +
> + Goals = Goals0 ++ ValueGoals ++ [Goal].
> +
It is very inefficient to append a Goal at the end of a list.
Please add an XXX to say that this should be fixed.
> +
> + %
> + % Return the type list(var_value)
> + %
> +:- func list_var_value_type = mer_type.
> +
> +list_var_value_type = ListVarValueType :-
> + SSDBModule = mercury_ssdb_builtin_module,
> + VarValueTypeCtor = type_ctor(qualified(SSDBModule, "var_value"), 0),
> + construct_type(VarValueTypeCtor, [], VarValueType),
> +
> + ListTypeCtor = type_ctor(qualified(unqualified("list"), "list"), 1),
> + construct_type(ListTypeCtor, [VarValueType], ListVarValueType).
>
> +
> +%-----------------------------------------------------------------------------%
> +
> + %
> + % Create the goal's argument description :
> + % -> unbound_head_var(Name, Pos) if it is an unbound argument
> + % -> bound_head_var(type_of_T, Name, Position, T) if it is a bound argument
> + %
> +:- pred make_var_value(instmap::in, prog_var::in, prog_var::out,
> + int::in, list(hlds_goal)::out, module_info::in, module_info::out,
> + proc_info::in, proc_info::out, pred_info::in, pred_info::out,
> + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
> +
> +
> +make_var_value(InstMap, VarToInspect, VarDesc, VarPos, Goals,
> + !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes) :-
> +
> +
> + SSDBModule = mercury_ssdb_builtin_module,
> + TypeCtor = type_ctor(qualified(SSDBModule, "var_value"), 0),
> +
> + % Find the name of the prog_var.
> + varset.lookup_name(!.VarSet, VarToInspect, VarName),
>
> + make_string_const_construction_alloc(VarName, yes("VarName"),
> + ConstructVarName, VarNameVar, !VarSet, !VarTypes),
> +
> + make_int_const_construction_alloc(VarPos, yes("VarPos"),
> + ConstructVarPos, VarPosVar, !VarSet, !VarTypes),
> +
> + ( var_is_ground_in_instmap(!.ModuleInfo, InstMap, VarToInspect) ->
> +
> + % Create dynamic constructor for the value of the argument.
> + %
> + % Call polymorphism.m to create the type_infos, add an hidden field
> + % which is the polymorphic type of the value.
> + %
> + % some[T] bound_head_var(string, int, T) ---->
> + % some[T] bound_head_var(type_of_T, string, int, T)
> + %
> + (
> + %
> + % Update proc_varset and proc_vartypes, without this, the
> + % polymorphism_make_type_info_var use a prog_var already bound.
> + %
s/use a prog_var/uses a prog_var which is/
> + proc_info_set_varset(!.VarSet, !ProcInfo),
> + proc_info_set_vartypes(!.VarTypes, !ProcInfo),
> +
> + create_poly_info(!.ModuleInfo, !.PredInfo, !.ProcInfo,
> + PolyInfo0),
> + term.context_init(Context),
> + map.lookup(!.VarTypes, VarToInspect, MerType),
> + polymorphism_make_type_info_var(MerType, Context, TypeInfoVar,
> + TypeInfoGoal, PolyInfo0, PolyInfo),
> + poly_info_extract(PolyInfo, !PredInfo, !ProcInfo,
> + !:ModuleInfo),
> +
> + %
> + % Give a new prog_var to the polymorphic structure.
> + %
> + svvarset.new_named_var("VarType", VarTypo, !VarSet),
> + svmap.det_insert(VarTypo, MerType, !VarTypes)
> + ),
> +
> + % Constructor of the variable's description.
> + svvarset.new_named_var("VarDesc", VarDesc, !VarSet),
> + ConsId = cons(qualified(SSDBModule, "bound_head_var"), 3),
> + construct_type(TypeCtor, [], VarType),
> + svmap.det_insert(VarDesc, VarType, !VarTypes),
> + construct_functor(VarDesc, ConsId, [TypeInfoVar, VarNameVar,
> + VarPosVar, VarToInspect], ConstructVarGoal),
> +
> + Goals = [ConstructVarName, ConstructVarPos | TypeInfoGoal] ++
> + [ConstructVarGoal]
> + ;
> + svvarset.new_named_var("VarDesc", VarDesc, !VarSet),
> + ConsId = cons(qualified(SSDBModule, "unbound_head_var"), 2),
> + construct_type(TypeCtor, [], VarType),
> + svmap.det_insert(VarDesc, VarType, !VarTypes),
> + construct_functor(VarDesc, ConsId, [VarNameVar, VarPosVar],
> + ConstructVarGoal),
> +
> + Goals = [ConstructVarName, ConstructVarPos, ConstructVarGoal]
> + ).
> +
> %-----------------------------------------------------------------------------%
>
> Index: ssdb/ssdb.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
> retrieving revision 1.5
> diff -u -r1.5 ssdb.m
> --- ssdb/ssdb.m 9 Oct 2007 01:22:13 -0000 1.5
> +++ ssdb/ssdb.m 17 Oct 2007 03:38:52 -0000
> @@ -20,7 +20,7 @@
>
> :- module ssdb.
> :- interface.
> -
> +:- import_module list.
>
> :- type ssdb_proc_id
> ---> ssdb_proc_id(
> @@ -36,9 +36,33 @@
> .
>
> %
> + % Type use to contain all variable of a call
> + %
Reword this comment
The list of all variables in use in a procedure.
> +:- type list_var_value == list(var_value).
> +
> + %
> + % Type use to represent variables of the debugged predicate/function
> + %
Reword this as:
Record the instantiatedness and value of each variable used in a
procedure.
> +:- type var_value
> + ---> unbound_head_var(var_name, pos)
> + ; some [T] bound_head_var(var_name, pos, T)
> + ; some [T] bound_other_var(var_name, T).
> +
> + %
> + % Head variable name.
> + %
Delete the word Head, it's just a variable name.
> +:- type var_name == string.
> +
> + %
> + % This fields give the argument numbers of head variables.
> + %
Reword as
The argument position of the head variable.
Positions are numbered from 0.
> +:- type pos == int.
> +
> + %
> % This routine is called at each event that occurs.
> %
> -:- impure pred handle_event(ssdb_proc_id::in, ssdb_event_type::in) is det.
> +:- impure pred handle_event(ssdb_proc_id::in, ssdb_event_type::in,
> + list_var_value::in) is det.
>
> %----------------------------------------------------------------------------%
> %----------------------------------------------------------------------------%
> @@ -48,7 +72,6 @@
> :- import_module bool.
> :- import_module io.
> :- import_module int.
> -:- import_module list.
> :- import_module require.
> :- import_module set.
> :- import_module stack.
> @@ -74,7 +97,10 @@
> ssdb_stack :: stack(stack_elem),
>
> % The set of breakpoint added.
> - ssdb_breakpoints :: set(breakpoint)
> + ssdb_breakpoints :: set(breakpoint),
> +
> + % The list of the goal's argument.
> + ssdb_list_var_value :: list(var_value)
You indendation here looks wrong.
> ).
>
>
> %----------------------------------------------------------------------------%
> @@ -130,7 +156,9 @@
> NextStop = ns_step,
> Stack = stack.init,
> Breakpoints = set.init,
> - DbgState = state(EventNum, CSN, Depth, NextStop, Stack, Breakpoints).
> + ListVarValue = [],
> + DbgState = state(EventNum, CSN, Depth, NextStop, Stack, Breakpoints,
> + ListVarValue).
>
> :- mutable(debugger_state, debugger_state, init_debugger_state, ground,
> [untrailed, attach_to_io_state]).
> @@ -142,25 +170,31 @@
> % Write the event out and call the prompt.
> % XXX Not yet implemented : redo, fail.
> %
> -handle_event(ProcId, Event) :-
> +handle_event(ProcId, Event, ListVarValue) :-
> impure get_event_num_inc(EventNum),
> impure update_depth(Event, PrintDepth),
>
> (
> - Event = ssdb_call,
> + Event = ssdb_call,
> + % set the new CSN.
> impure get_csn_inc(_),
> + % set the list_var_value of the debugger state with the list received
> + impure set_list_var_value(ListVarValue),
>
Again you indentation looks wrong. You are using tabs.
Come and talk to me about how to fix this.
> + % Push the actual state on the stack of the debugger state
> 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)
> ;
> + % Just get the top frame, it will be pop at the end of the
> + % handle_event because we need some information
> + % Example : for printing variables at the exit point
> Event = ssdb_exit,
> + impure set_list_var_value_in_stack(ListVarValue),
> semipure get_debugger_state(InitialState),
> - stack.pop_det(InitialState ^ ssdb_stack, StackFrame, FinalStack),
> - StateEv = InitialState ^ ssdb_stack := FinalStack,
> - impure set_debugger_state(StateEv)
> + stack.top_det(InitialState ^ ssdb_stack, StackFrame)
> ;
> Event = ssdb_redo,
> error("ssdb_redo: not yet implemented")
> @@ -184,7 +218,7 @@
> NextStop0 = ns_continue,
> ( set.contains(State0 ^ ssdb_breakpoints,
> breakpoint(ProcId ^ module_name, ProcId ^ proc_name))
> - ->
> + ->
> Stop = yes
> ;
> Stop = no
> @@ -245,6 +279,25 @@
> )
> ;
> Stop = no
> + ),
> +
> + ( Event = ssdb_call
> +
> + ; Event = ssdb_exit,
> + % Pop the frame
> + semipure get_debugger_state(PopState),
> + stack.pop_det(PopState ^ ssdb_stack, _StackFrame1, FinalStack1),
> + StateEv1 = PopState ^ ssdb_stack := FinalStack1,
> + impure set_debugger_state(StateEv1)
> +
> + /* XXX currently commented out because above these two cases
> + ** throw an exception above and hence the compiler warns about
> + ** these two cases being redundant
> + ; Event = ssdb_redo
> +
> + ; Event = ssdb_fail
> + */
> +
> ).
>
> %
> @@ -334,6 +387,29 @@
> semipure get_debugger_state(State0),
> ShadowStack = State0 ^ ssdb_stack.
>
> +:- impure pred set_list_var_value(list(var_value)::in) is det.
> +
> +set_list_var_value(ListVarValue) :-
> + semipure get_debugger_state(State0),
> + State = State0 ^ ssdb_list_var_value := ListVarValue,
> + impure set_debugger_state(State).
> +
> +:- impure pred set_list_var_value_in_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).
> +
> +
> +
> +
> %----------------------------------------------------------------------------%
>
> %
> @@ -345,6 +421,10 @@
> % s | _ :: next step
> % c :: continue
> % b X Y :: breakpoint X = module_name Y = predicate_name
> + % p :: print
> + % pst :: print stack trace
> + % u :: up
> + % d :: down
> %
Again indentation.
>
> :- impure pred prompt(stack(stack_elem)::in, int::in, what_next::out,
> @@ -358,7 +438,7 @@
> Result = ok(String0),
> % String minus any single trailing newline character.
> String = string.chomp(String0),
> - Words = string.words(String),
> + Words = string.words(String),
>
> ( Words = ["h"] ->
> io.nl(!IO),
> @@ -370,13 +450,32 @@
> io.write_string(" X = module name", !IO),
> io.write_string(" and Y = predicate name", !IO),
> io.nl(!IO),
> - io.write_string("c :: next", !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("pst :: print stack trace", !IO),
> + io.nl(!IO),
> + io.write_string("u :: up", !IO),
> + io.nl(!IO),
> + io.write_string("d :: down", !IO),
> + io.nl(!IO),
> io.nl(!IO),
Again indentation.
> impure prompt(ShadowStack, Depth, WhatNext, !IO)
> -
> +
> + ; Words = ["p"] ->
> + CurrentFrame = stack.top_det(ShadowStack),
> + ListVarValue = CurrentFrame ^ se_initial_state ^
> + ssdb_list_var_value,
> + print_vars(ListVarValue, !IO),
> + impure prompt(ShadowStack, Depth, WhatNext, !IO)
> +
> + ; Words = ["pst"] ->
> + print_frames_list(ShadowStack, Depth, !IO),
> + impure prompt(ShadowStack, Depth, WhatNext, !IO)
> +
> ; Words = ["n"] ->
> WhatNext = wn_next
>
> @@ -407,6 +506,28 @@
> CSN = FrameStack ^ se_initial_state ^ ssdb_csn,
> WhatNext = wn_finish(CSN)
>
> + ; Words = ["d"] ->
> + (
> + Depth0 = Depth - 1,
> + Depth0 >= 0
> + ->
> + impure prompt(ShadowStack, Depth0, WhatNext, !IO)
> + ;
> + io.print("Impossible to go down\n", !IO),
> + impure prompt(ShadowStack, Depth, WhatNext, !IO)
> + )
> +
> + ; Words = ["u"] ->
> + (
> + Depth0 = Depth + 1,
> + Depth0 < stack.depth(ShadowStack)
> + ->
> + impure prompt(ShadowStack, Depth0, WhatNext, !IO)
> + ;
> + io.print("Impossible to go up\n", !IO),
> + impure prompt(ShadowStack, Depth, WhatNext, !IO)
> + )
> +
> ;
> io.write_string("huh?\n", !IO),
> impure prompt(ShadowStack, Depth, WhatNext, !IO)
> @@ -422,6 +543,93 @@
>
> %----------------------------------------------------------------------------%
>
> + %
> + % Print the Stack Trace (command 'pst')
> + %
> +:- pred print_frames_list(stack(stack_elem)::in, int::in,
> + io::di, io::uo) is det.
> +
> +print_frames_list(ShadowStack0, Depth, !IO) :-
> + ( if not stack.is_empty(ShadowStack0) then
> + stack.pop_det(ShadowStack0, PopFrame, ShadowStack),
> + (if Depth = 0 then
> + print_stack_frame(yes, PopFrame, !IO)
> + else
> + print_stack_frame(no, PopFrame, !IO)
> + ),
> + print_frames_list(ShadowStack, Depth - 1, !IO)
> + else
> + _N = 1
> + ).
> +
> +
> +:- pred print_stack_frame(bool::in, stack_elem::in, io::di, io::uo) is det.
> +
> +print_stack_frame(Starred, Frame, !IO) :-
> + Module = Frame ^ se_proc_id ^ module_name ,
> + Procedure = Frame ^ se_proc_id ^ proc_name ,
> +
> + (
> + Starred = yes,
> + io.write_char('*', !IO)
> + ;
> + Starred = no,
> + io.write_char(' ', !IO)
> + ),
> + io.format(" %s.%s(\n", [s(Module), s(Procedure)], !IO),
> + ListVarValue = Frame ^ se_initial_state ^ ssdb_list_var_value,
> + print_vars(ListVarValue, !IO),
> + io.write_string(")\n", !IO).
> +
> + %
> + % Print the Variables (command 'p').
> + %
> +:- pred print_vars(list(var_value)::in, io::di, io::uo) is det.
> +
> +print_vars(Vars, !IO) :-
> + list.foldl(print_var, Vars, !IO).
> +
> +:- pred print_var(var_value::in, io::di, io::uo) is det.
> +
> +print_var(unbound_head_var(Name, Pos), !IO) :-
> + io.write_char('\t', !IO),
> + io.write_string("unbound_head\t", !IO),
> + io.write_string(Name, !IO),
> + io.write_string(":\t", !IO),
> + io.write_int(Pos, !IO),
> + io.write_string("\t=\t", !IO),
> + io.write_string("_", !IO),
> + io.nl(!IO).
> +
> +print_var(bound_head_var(Name, Pos, T), !IO) :-
> + if not string.prefix(Name, "STATE_VARIABLE_IO") then
Add an XXX that we should treat the io.state better.
> + io.write_char('\t', !IO),
> + io.write_string("bound_head\t", !IO),
> + io.write_string(Name, !IO),
> + io.write_string(":\t", !IO),
> + io.write_int(Pos, !IO),
> + io.write_string("\t=\t", !IO),
> + io.print(T, !IO),
> + io.nl(!IO)
> + else
> + io.write_char('\t', !IO),
> + io.write_string("bound_head\t", !IO),
> + io.write_string(Name, !IO),
> + io.nl(!IO).
> +
> +print_var(bound_other_var(Name, T), !IO) :-
> + io.write_char('\t', !IO),
> + io.write_string("bound_other\t", !IO),
> + io.write_string(Name, !IO),
> + io.write_string(":\t_\t", !IO),
> + io.write_string("=\t", !IO),
> + io.print(T, !IO),
> + io.nl(!IO).
> +
> +
> +%----------------------------------------------------------------------------%
> +
> +
> :- impure pred invent_io(io::uo) is det.
>
> :- pragma foreign_proc("C",
> @@ -440,6 +648,7 @@
> invent_io(_IO::uo),
> [will_not_call_mercury, thread_safe], "").
>
> +
> :- impure pred consume_io(io::di) is det.
>
> :- pragma foreign_proc("C",
>
Otherwise this looks fine.
--------------------------------------------------------------------------
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