[m-rev.] ssdb goal's argument generation at call and exit point

Olivier Annet oan at missioncriticalit.com
Wed Oct 17 14:16:12 AEST 2007


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.

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


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
 % 
 %    :- 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.
+        %
+        proc_info_get_headvars(!.ProcInfo, HeadVars),
+        proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
+
+        %
+        % Make the list of argument at call point
+        %
+        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.
+    %
+:- 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].
+
+
+    %
+    % 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.
+            %
+            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
+    %
+:- type list_var_value == list(var_value).
+
+    %
+    % Type use to represent variables of the debugged predicate/function
+    %
+:- 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.
+    %
+:- type var_name == string.
+    
+    %
+    % This fields give the argument numbers of head variables.
+    %
+:- 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)
             ).
 
 
 %----------------------------------------------------------------------------%
@@ -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),
 
+	% 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
     %
 
 :- 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),
             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
+        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",

--------------------------------------------------------------------------
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