[m-rev.] already reviewed: build procedure id and pass it to handle_event in ssdb

[Peter Ross]

Hi,

I've already reviewed this code of oannet.

===================================================================


Estimated hours taken: 2
Branches: main

Pass to handle_event a ssdb_proc_id.

The ssdb_proc_id is a type which is used to identify the current
procedure.

compiler/ssdebug.m:
	Construct the ssdb_proc_id and pass it to handle event.
	
ssdb/ssdb.m:
	Define the type ssdb_proc_id.
	Currently it just contains the procedure name.
	Add the ssdb_proc_id argument to handle_event and use
	it to print out the procedure name.

Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.1
diff -u -r1.1 ssdebug.m
--- compiler/ssdebug.m	3 Oct 2007 23:48:16 -0000	1.1
+++ compiler/ssdebug.m	4 Oct 2007 00:45:26 -0000
@@ -56,12 +56,19 @@
 
 %-----------------------------------------------------------------------------%
 
-process_proc(_PredId, _ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+process_proc(PredId, _ProcId, !ProcInfo, !ModuleInfo, !IO) :-
     proc_info_get_goal(!.ProcInfo, Goal0),
 
     some [!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
@@ -76,7 +83,8 @@
         InstMapSrc = [],
         Context = term.context_init,
         goal_util.generate_simple_call(SSDBModule, "handle_event",		
-            pf_predicate, only_mode, detism_det, purity_impure, [CallVar],
+            pf_predicate, only_mode, detism_det, purity_impure,
+            [ProcIdVar, CallVar],
             Features, InstMapSrc, !.ModuleInfo, Context, HandleCallEventGoal),		
             %
             % Build the following two goals
@@ -87,13 +95,14 @@
             ExitConstructor, ExitVar, !Varset, !Vartypes),
 
         goal_util.generate_simple_call(SSDBModule, "handle_event",		
-            pf_predicate, only_mode, detism_det, purity_impure, [ExitVar],
+            pf_predicate, only_mode, detism_det, purity_impure,
+            [ProcIdVar, ExitVar],
             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 = [CallConstructor, HandleCallEventGoal,
+        ConjGoals = ProcIdGoals ++ [CallConstructor, HandleCallEventGoal,
             Goal0, ExitConstructor, HandleExitEventGoal],
 
         goal_info_init(GoalInfo),
@@ -111,6 +120,40 @@
 %-----------------------------------------------------------------------------%
 
     %
+    % make_proc_id_construction(PredInfo, ProcInfo,
+    %   Goals, Var, !Varset, !Vartypes)
+    %
+    % returns a set of goals, Goals, which build the ssdb_proc_id structure
+    % for the given pred and proc infos.  The var returned holds the
+    % ssdb_proc_id.
+    %
+:- pred make_proc_id_construction(pred_info::in, proc_info::in,
+    hlds_goals::out, prog_var::out,
+    prog_varset::in, prog_varset::out,
+    vartypes::in, vartypes::out) is det.
+
+make_proc_id_construction(PredInfo,
+        _ProcInfo, Goals, ProcIdVar, !Varset, !Vartypes) :-
+    Name = pred_info_name(PredInfo),
+
+	make_string_const_construction_alloc(Name, yes("Name"),
+	    ConstructPredName, PredNameVar, !Varset, !Vartypes),
+
+    SSDBModule = mercury_ssdb_builtin_module,
+    TypeCtor = type_ctor(qualified(SSDBModule, "ssdb_proc_id"), 0),
+
+    svvarset.new_named_var("ProcId", ProcIdVar, !Varset), 
+    ConsId = cons(qualified(SSDBModule, "ssdb_proc_id"), 1),
+    construct_type(TypeCtor, [], ProcIdType),	
+    svmap.det_insert(ProcIdVar, ProcIdType, !Vartypes),
+    construct_functor(ProcIdVar, ConsId, [PredNameVar], ConstructProcIdGoal),
+
+    Goals = [ConstructPredName, ConstructProcIdGoal].
+    
+    
+%-----------------------------------------------------------------------------%
+
+    %
     % make_ssdb_event_type_construction(EventType,
     %   Goal, Var, !Varset, !Vartypes)
     % 
Index: ssdb/ssdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
retrieving revision 1.1
diff -u -r1.1 ssdb.m
--- ssdb/ssdb.m	3 Oct 2007 12:11:58 -0000	1.1
+++ ssdb/ssdb.m	4 Oct 2007 00:45:27 -0000
@@ -22,6 +22,11 @@
 :- interface.
 
 
+:- type ssdb_proc_id
+    --->    ssdb_proc_id(
+                proc_name   :: string
+            ).
+
 :- type ssdb_event_type
     --->    ssdb_call
     ;       ssdb_exit
@@ -32,7 +37,7 @@
     %
     % This routine is called at each event that occurs
     %
-:- impure pred handle_event(ssdb_event_type::in) is det.
+:- impure pred handle_event(ssdb_proc_id::in, ssdb_event_type::in) is det.
 
 %----------------------------------------------------------------------------%
 %----------------------------------------------------------------------------%
@@ -52,10 +57,12 @@
     % For the moment we just write the event out.
     % Later this will be extended.
     %
-handle_event(Event) :-
+handle_event(ProcId, Event) :-
     promise_impure (
     trace [io(!IO)] (
         io.write(Event, !IO),
+        io.write_string(" ", !IO),
+        io.write_string(ProcId ^ proc_name, !IO),
         io.nl(!IO)
     )
     ).

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