Files
mercury/compiler/structure_reuse.direct.m
Julien Fischer 2409fc18e5 Merge the common parts of the CTGC and RBMM systems.
Estimated hours taken: 1.5
Branches: main

Merge the common parts of the CTGC and RBMM systems.

The main changes are:
(1) change CTGC to use the definition of program point in smm_common
(2) change RBMM to use the CTGC version of the fixpoint_table (which
    is more recent than the one that it currently uses.)

compiler/structure_reuse.direct.m:
	Delete the definition of the program_point and utility predicates
	from here.

compiler/smm_common.m:
	Move them here.

compiler/smm_fixpoint_table.m:
	Delete the contents of this file, they are provided by
	ctgc.fixpoint_table.  I haven't deleted the file (yet) as we may
	want to further rearrange some of the common code between
	the CTGC and RBMM systems.

compiler/Mercury.options:
	Ignore the fact that smm_fixpoint_table does not export anything.

compiler/rbmm.m.
compiler/rbmm.execution_path.m:
compiler/rbmm.live_variable_analysis.m:
compiler/rbmm.points_to_analysis.m:
compiler/rbmm.points_to_info.m:
	Conform to the above changes.

	Various minor changes to conform to our usual coding conventions.

Julien.

Index: compiler/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mercury.options,v
retrieving revision 1.28
diff -u -r1.28 Mercury.options
--- compiler/Mercury.options	15 May 2007 02:38:20 -0000	1.28
+++ compiler/Mercury.options	23 May 2007 09:39:18 -0000
@@ -43,6 +43,9 @@
 MCFLAGS-transform_hlds.ctgc.structure_reuse = --no-warn-unused-imports
 MCFLAGS-transform_hlds.ctgc.structure_sharing = --no-warn-unused-imports

+# This module is currently empty but may become used again in the future.
+MCFLAGS-transform_hlds.smm_fixpoint_table = --no-warn-nothing-exported
+
 # Bug workarounds

 # This is the same bug as tests/valid/ho_and_type_spec_bug.
Index: compiler/rbmm.execution_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.execution_path.m,v
retrieving revision 1.1
diff -u -r1.1 rbmm.execution_path.m
--- compiler/rbmm.execution_path.m	23 May 2007 00:17:19 -0000	1.1
+++ compiler/rbmm.execution_path.m	23 May 2007 09:39:18 -0000
@@ -46,7 +46,6 @@
 :- import_module list.
 :- import_module map.

-
 %-----------------------------------------------------------------------------%
 %
 % Execution path analysis
@@ -113,7 +112,7 @@
 			)
 		->
             % Retrieve the program point of this goal.
-			program_point_init(Info, ProgPoint),
+			ProgPoint = program_point_init(Info),
 			append_to_each_execution_path(!.ExecPaths,
                 [[pair(ProgPoint, Goal)]], !:ExecPaths)
 		;
@@ -220,7 +219,7 @@
         !ExecPaths) :-
 	Case = case(ConsId, CaseGoal),
 	Switch = hlds_goal(_SwitchExpr, Info),
-	program_point_init(Info, ProgPoint),
+	ProgPoint = program_point_init(Info),

     % Handle the unification on the switch var if it has been removed.
     % We add a dummy program point for this unification.
Index: compiler/rbmm.live_variable_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.live_variable_analysis.m,v
retrieving revision 1.1
diff -u -r1.1 rbmm.live_variable_analysis.m
--- compiler/rbmm.live_variable_analysis.m	23 May 2007 00:17:20 -0000	1.1
+++ compiler/rbmm.live_variable_analysis.m	23 May 2007 09:39:18 -0000
@@ -91,31 +91,28 @@
         live_variable_analysis_proc(ModuleInfo, ExecPathTable, PredId),
 		ProcIds, !LVBeforeTable, !LVAfterTable, !VoidVarTable).

-:- pred live_variable_analysis_proc(module_info::in, execution_path_table::in,
-    pred_id::in, proc_id::in, proc_pp_varset_table::in,
-    proc_pp_varset_table::out, proc_pp_varset_table::in,
-    proc_pp_varset_table::out, proc_pp_varset_table::in,
-    proc_pp_varset_table::out) is det.
+:- pred live_variable_analysis_proc(module_info::in,
+    execution_path_table::in, pred_id::in, proc_id::in,
+    proc_pp_varset_table::in, proc_pp_varset_table::out,
+    proc_pp_varset_table::in, proc_pp_varset_table::out,
+    proc_pp_varset_table::in, proc_pp_varset_table::out) is det.

 live_variable_analysis_proc(ModuleInfo, ExecPathTable, PredId, ProcId,
         !LVBeforeTable, !LVAfterTable, !VoidVarTable) :-
 	PPId = proc(PredId, ProcId),
-	( if
-		some_are_special_preds([PPId], ModuleInfo)
-	  then
-        true
+	( if    some_are_special_preds([PPId], ModuleInfo)
+	  then  true
 	  else
-		module_info_proc_info(ModuleInfo, PPId, ProcInfo),
-		find_input_output_args(ModuleInfo, ProcInfo, Inputs, Outputs),
-		map.lookup(ExecPathTable, PPId, ExecPaths),
-		live_variable_analysis_exec_paths(ExecPaths, Inputs, Outputs,
-            ModuleInfo, ProcInfo, map.init, ProcLVBefore,
-            map.init, ProcLVAfter,
-            map.init, ProcVoidVar),
-
-		svmap.set(PPId, ProcLVBefore, !LVBeforeTable),
-		svmap.set(PPId, ProcLVAfter, !LVAfterTable),
-		svmap.set(PPId, ProcVoidVar, !VoidVarTable)
+		    module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+		    find_input_output_args(ModuleInfo, ProcInfo, Inputs, Outputs),
+		    map.lookup(ExecPathTable, PPId, ExecPaths),
+		    live_variable_analysis_exec_paths(ExecPaths, Inputs, Outputs,
+                ModuleInfo, ProcInfo, map.init, ProcLVBefore,
+                map.init, ProcLVAfter, map.init, ProcVoidVar),
+
+            svmap.set(PPId, ProcLVBefore, !LVBeforeTable),
+		    svmap.set(PPId, ProcLVAfter, !LVAfterTable),
+		    svmap.set(PPId, ProcVoidVar, !VoidVarTable)
 	).

 :- pred live_variable_analysis_exec_paths(list(execution_path)::in,
@@ -133,8 +130,7 @@
 live_variable_analysis_exec_paths([ExecPath0 | ExecPaths], Inputs, Outputs,
         ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter, !ProcVoidVar) :-
 	list.reverse(ExecPath0, ExecPath),
-	( if
-        list.length(ExecPath) = 1
+	( if list.length(ExecPath) = 1
 	  then
         live_variable_analysis_singleton_exec_path(ExecPath, Inputs, Outputs,
             ModuleInfo, ProcInfo, !ProcLVBefore, !ProcLVAfter, !ProcVoidVar)
@@ -150,8 +146,8 @@
 :- pred live_variable_analysis_exec_path(execution_path::in,
     list(prog_var)::in, list(prog_var)::in, module_info::in, proc_info::in,
     bool::in, set(prog_var)::in, pp_varset_table::in, pp_varset_table::out,
-    pp_varset_table::in, pp_varset_table::out, pp_varset_table::in,
-    pp_varset_table::out) is det.
+    pp_varset_table::in, pp_varset_table::out,
+    pp_varset_table::in, pp_varset_table::out) is det.

 live_variable_analysis_exec_path([], _, _, _, _,_, _, !ProcLVBefore,
         !ProcLVAfter, !ProcVoidVar).
@@ -162,13 +158,11 @@
 live_variable_analysis_exec_path([(LastProgPoint - Goal) | ProgPointGoals],
         Inputs, Outputs, ModuleInfo, ProcInfo, yes, _LVBeforeNext,
         !ProcLVBefore, !ProcLVAfter, !ProcVoidVar) :-
-	( if
-		map.search(!.ProcLVAfter, LastProgPoint, LVAfterLast0)
-	  then
-		LVAfterLast = LVAfterLast0
+	( if    map.search(!.ProcLVAfter, LastProgPoint, LVAfterLast0)
+	  then  LVAfterLast = LVAfterLast0
 	  else
-		LVAfterLast = set.list_to_set(Outputs),
-		svmap.set(LastProgPoint, LVAfterLast, !ProcLVAfter)
+		    LVAfterLast = set.list_to_set(Outputs),
+		    svmap.set(LastProgPoint, LVAfterLast, !ProcLVAfter)
 	),

     % Compute live variable before this last program point.
@@ -266,12 +260,9 @@
     pp_varset_table::in, pp_varset_table::out) is det.

 record_live_vars_at_prog_point(ProgPoint, LV, !ProcLV) :-
-	( if
-		map.search(!.ProcLV, ProgPoint, ExistingLV)
-	  then
-		svmap.set(ProgPoint, set.union(ExistingLV, LV), !ProcLV)
-	  else
-		svmap.set(ProgPoint, LV, !ProcLV)
+	( if    map.search(!.ProcLV, ProgPoint, ExistingLV)
+	  then  svmap.set(ProgPoint, set.union(ExistingLV, LV), !ProcLV)
+	  else  svmap.set(ProgPoint, LV, !ProcLV)
 	).

     % Compute used and produced variables in an atomic goal, which
@@ -304,7 +295,9 @@
 			get_inputs_outputs_unification(Unification, Useds,
                 Produceds)
 		;
-			(Expr = conj(_, []) ; Expr = disj([]))
+			( Expr = conj(_, [])
+            ; Expr = disj([])
+            )
 		->
 			Useds = [],
 			Produceds = []
@@ -393,6 +386,7 @@
     %
 :- pred collect_void_vars(program_point::in, variable_set::in, proc_info::in,
     pp_varset_table::in, pp_varset_table::out) is det.
+
 collect_void_vars(ProgPoint, ProducedSet, ProcInfo, !ProcVoidVar) :-
 	( if
 		map.search(!.ProcVoidVar, ProgPoint, _DeadVars)
@@ -407,17 +401,15 @@
     % To be used with the fold above: if Var is a void variable,
     % add it to VoidVars set.
     %
-:- pred void_var(prog_varset::in, prog_var::in, variable_set::in,
-    variable_set::out) is det.
+:- pred void_var(prog_varset::in, prog_var::in,
+    variable_set::in, variable_set::out) is det.
+
 void_var(Varset, Var, !VoidVars) :-
 	mercury_var_to_string(Varset, no, Var) = VarName,
 	string.substring(VarName, 0, 1, FirstChar),
-	( if
-		FirstChar = "_"
-	  then
-		set.insert(!.VoidVars, Var, !:VoidVars)
-	  else
-        true
+	( if    FirstChar = "_"
+	  then  set.insert(!.VoidVars, Var, !:VoidVars)
+	  else  true
 	).

 %----------------------------------------------------------------------------%
Index: compiler/rbmm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.m,v
retrieving revision 1.1
diff -u -r1.1 rbmm.m
--- compiler/rbmm.m	23 May 2007 00:17:20 -0000	1.1
+++ compiler/rbmm.m	23 May 2007 09:39:18 -0000
@@ -28,8 +28,14 @@

 :- import_module hlds.
 :- import_module hlds.hlds_module.
+
+%-----------------------------------------------------------------------------%
+
 :- pred do_region_analysis(module_info::in, module_info::out) is det.

+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- implementation.

 :- import_module transform_hlds.rbmm.execution_path.
@@ -39,6 +45,8 @@
 :- import_module transform_hlds.rbmm.points_to_analysis.
 :- import_module transform_hlds.rbmm.region_instruction.

+%-----------------------------------------------------------------------------%
+
 do_region_analysis(!ModuleInfo) :-
     region_points_to_analysis(RptaInfoTable, !ModuleInfo),
     execution_path_analysis(!.ModuleInfo, ExecPathTable),
@@ -61,4 +69,6 @@
         LRBeforeTable, LRAfterTable, VoidVarRegionTable, BornRTable,
 	DeadRTable, LocalRTable, _AnnotationTable).

+%-----------------------------------------------------------------------------%
 :- end_module transform_hlds.rbmm.
+%-----------------------------------------------------------------------------%
Index: compiler/rbmm.points_to_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.points_to_analysis.m,v
retrieving revision 1.1
diff -u -r1.1 rbmm.points_to_analysis.m
--- compiler/rbmm.points_to_analysis.m	23 May 2007 00:17:20 -0000	1.1
+++ compiler/rbmm.points_to_analysis.m	23 May 2007 09:39:18 -0000
@@ -28,6 +28,7 @@
 % Currently the analysis ONLY collects the information, do NOT record it into
 % the HLDS.
 %
+%-----------------------------------------------------------------------------%

 :- module transform_hlds.rbmm.points_to_analysis.
 :- interface.
@@ -36,8 +37,10 @@
 :- import_module hlds.hlds_module.
 :- import_module transform_hlds.rbmm.points_to_info.

-:- pred region_points_to_analysis(rpta_info_table::out, module_info::in,
-    module_info::out) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred region_points_to_analysis(rpta_info_table::out,
+    module_info::in, module_info::out) is det.

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -55,17 +58,20 @@
 :- import_module transform_hlds.dependency_graph.
 :- import_module transform_hlds.rbmm.points_to_graph.
 :- import_module transform_hlds.smm_common.
-:- import_module transform_hlds.smm_fixpoint_table.
+:- import_module transform_hlds.ctgc.
+:- import_module transform_hlds.ctgc.fixpoint_table.

 :- import_module bool.
 :- import_module int.
 :- import_module list.
 :- import_module map.
+:- import_module maybe.
 :- import_module set.
 :- import_module string.
-:- import_module term.
 :- import_module svmap.
-:- import_module maybe.
+:- import_module term.
+
+%-----------------------------------------------------------------------------%

 region_points_to_analysis(InfoTable, !ModuleInfo) :-
     rpta_info_table_init = InfoTable0,
@@ -77,8 +83,8 @@
 % Intraprocedural region points-to analysis.
 %

-:- pred intra_proc_rpta(module_info::in, rpta_info_table::in,
-    rpta_info_table::out) is det.
+:- pred intra_proc_rpta(module_info::in,
+    rpta_info_table::in, rpta_info_table::out) is det.

 intra_proc_rpta(ModuleInfo, !InfoTable) :-
     module_info_predids(PredIds, ModuleInfo, _),
@@ -89,9 +95,8 @@

 intra_proc_rpta_pred(ModuleInfo, PredId, !InfoTable) :-
     module_info_pred_info(ModuleInfo, PredId, PredInfo),
-    pred_info_non_imported_procids(PredInfo) = ProcIds,
-    list.foldl(intra_proc_rpta_proc(ModuleInfo, PredId), ProcIds,
-        !InfoTable).
+    ProcIds = pred_info_non_imported_procids(PredInfo),
+    list.foldl(intra_proc_rpta_proc(ModuleInfo, PredId), ProcIds, !InfoTable).

 :- pred intra_proc_rpta_proc(module_info::in, pred_id::in, proc_id::in,
     rpta_info_table::in, rpta_info_table::out) is det.
@@ -104,16 +109,14 @@
     rpta_info_table::in, rpta_info_table::out) is det.

 intra_analyse_pred_proc(ModuleInfo, PPId, !InfoTable) :-
-    ( if
-        some_are_special_preds([PPId], ModuleInfo)
-      then
-        true
+    ( if    some_are_special_preds([PPId], ModuleInfo)
+      then  true
       else
-        module_info_proc_info(ModuleInfo, PPId, ProcInfo),
-        rpta_info_init(ProcInfo, RptaInfo0),
-        proc_info_get_goal(ProcInfo, Goal),
-        intra_analyse_goal(Goal, RptaInfo0, RptaInfo),
-        rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable)
+            module_info_proc_info(ModuleInfo, PPId, ProcInfo),
+            RptaInfo0 = rpta_info_init(ProcInfo),
+            proc_info_get_goal(ProcInfo, Goal),
+            intra_analyse_goal(Goal, RptaInfo0, RptaInfo),
+            rpta_info_table_set_rpta_info(PPId, RptaInfo, !InfoTable)
     ).

 :- pred intra_analyse_goal(hlds_goal::in,
@@ -134,7 +137,7 @@
 intra_analyse_goal_expr(plain_call(_, _, _, _, _, _), !RptaInfo).

 intra_analyse_goal_expr(generic_call(_,_,_,_), !RptaInfo) :-
-    unexpected(this_file,
+    sorry(this_file,
         "intra_analyse_goal_expr: generic_call not handled").

 intra_analyse_goal_expr(switch(_, _, Cases), !RptaInfo) :-
@@ -185,14 +188,14 @@

 intra_analyse_goal_expr(GoalExpr, !RptaInfo) :-
     GoalExpr = call_foreign_proc(_, _, _, _, _, _, _),
-    unexpected(this_file, "intra_analyse_goal_expr: call_foreign_proc"
-        ++ " not handled").
+    unexpected(this_file,
+        "intra_analyse_goal_expr: call_foreign_proc not handled").

 intra_analyse_goal_expr(shorthand(_), !RptaInfo) :-
     unexpected(this_file, "intra_analyse_goal_expr: shorthand not handled").

-:- pred process_unification(unification::in, rpta_info::in,
-    rpta_info::out) is det.
+:- pred process_unification(unification::in,
+    rpta_info::in, rpta_info::out) is det.

     % For construction and deconstruction, add edges from LVar to
     % each of RVars.
@@ -236,7 +239,7 @@
     ),
     !:Component = !.Component + 1.

-    % Unification is an assigment: merge the corresponding nodes of ToVar
+    % Unification is an assignment: merge the corresponding nodes of ToVar
     % and FromVar.
     %
 process_unification(assign(ToVar, FromVar), !RptaInfo) :-
@@ -409,7 +412,7 @@
         IsInit = bool.yes
     ;
         IsInit = bool.no,
-        program_point_init(GoalInfo, CallSite),
+        CallSite = program_point_init(GoalInfo),
         CalleeRptaInfo = rpta_info(CalleeGraph, _),

         % Collect alpha mapping at this call site.
@@ -1062,16 +1065,15 @@
 % Fixpoint table used in region points-to analysis.
 %

-:- type rpta_info_fixpoint_table ==
-		fixpoint_table(pred_proc_id, rpta_info).
+:- type rpta_info_fixpoint_table == fixpoint_table(pred_proc_id, rpta_info).

-	% Initialise the fixpoint table for the given set of pred_proc_id's.
+	% Initialise the fixpoint table for the given set of pred_proc_ids.
     %
 :- pred rpta_info_fixpoint_table_init(list(pred_proc_id)::in,
     rpta_info_table::in, rpta_info_fixpoint_table::out) is det.

 rpta_info_fixpoint_table_init(Keys, InfoTable, Table):-
-	fp_init(wrapped_init(InfoTable), Keys, Table).
+    Table = init_fixpoint_table(wrapped_init(InfoTable), Keys).

 	% Add the results of a new analysis pass to the already existing
 	% fixpoint table.
@@ -1079,17 +1081,15 @@
 :- pred rpta_info_fixpoint_table_new_run(rpta_info_fixpoint_table::in,
     rpta_info_fixpoint_table::out) is det.

-rpta_info_fixpoint_table_new_run(Tin, Tout) :-
-	fp_new_run(Tin,Tout).
+rpta_info_fixpoint_table_new_run(!Table) :-
+	new_run(!Table).

 	% The fixpoint table keeps track of the number of analysis passes. This
 	% predicate returns this number.
     %
-:- pred rpta_info_fixpoint_table_which_run(rpta_info_fixpoint_table::in,
-    int::out) is det.
+:- func rpta_info_fixpoint_table_which_run(rpta_info_fixpoint_table) = int.

-rpta_info_fixpoint_table_which_run(Tin, Run) :-
-	Run = fp_which_run(Tin).
+rpta_info_fixpoint_table_which_run(Table) = which_run(Table).

 	% A fixpoint is reached if all entries in the table are stable,
 	% i.e. haven't been modified by the last analysis pass.
@@ -1098,7 +1098,7 @@
     is semidet.

 rpta_info_fixpoint_table_all_stable(Table) :-
-	fp_stable(Table).
+	fixpoint_reached(Table).

 	% Enter the newly computed region points-to information for a given
     % procedure.
@@ -1107,17 +1107,15 @@
 	% "unstable".
 	% Aborts if the procedure is not already in the fixpoint table.
     %
-:- pred rpta_info_fixpoint_table_new_rpta_info(pred_proc_id::in,
-    rpta_info::in, rpta_info_fixpoint_table::in,
-    rpta_info_fixpoint_table::out) is det.
-
-rpta_info_fixpoint_table_new_rpta_info(PredProcId, RptaInfo, Tin, Tout) :-
-	fp_add(
-		pred(TabledElem::in, Elem::in) is semidet :-
-		(
-			rpta_info_equal(Elem, TabledElem)
-		),
-		PredProcId, RptaInfo, Tin, Tout).
+:- pred rpta_info_fixpoint_table_new_rpta_info(
+    pred_proc_id::in, rpta_info::in,
+    rpta_info_fixpoint_table::in, rpta_info_fixpoint_table::out) is det.
+
+rpta_info_fixpoint_table_new_rpta_info(PPId, RptaInfo, !Table) :-
+	EqualityTest = (pred(TabledElem::in, Elem::in) is semidet :-
+        rpta_info_equal(Elem, TabledElem)
+    ),
+    add_to_fixpoint_table(EqualityTest, PPId, RptaInfo, !Table).

 	% Retrieve the rpta_info of a given pred_proc_id. If this information
     % is not available, this means that the set of pred_proc_id's to which
@@ -1125,12 +1123,12 @@
     % is characterised as recursive.
 	% Fails if the procedure is not in the table.
     %
-:- pred rpta_info_fixpoint_table_get_rpta_info(pred_proc_id::in,
-    rpta_info::out, rpta_info_fixpoint_table::in,
-    rpta_info_fixpoint_table::out) is semidet.
+:- pred rpta_info_fixpoint_table_get_rpta_info(
+    pred_proc_id::in, rpta_info::out,
+    rpta_info_fixpoint_table::in, rpta_info_fixpoint_table::out) is semidet.

-rpta_info_fixpoint_table_get_rpta_info(PredProcId, RptaInfo, Tin, Tout) :-
-	fp_get(PredProcId, RptaInfo, Tin, Tout).
+rpta_info_fixpoint_table_get_rpta_info(PPId, RptaInfo, !Table) :-
+    get_from_fixpoint_table(PPId, RptaInfo, !Table).

 	% Retreive rpta_info, without changing the table. To be used after
     % fixpoint has been reached. Aborts if the procedure is not in the table.
@@ -1138,21 +1136,18 @@
 :- pred rpta_info_fixpoint_table_get_final_rpta_info(pred_proc_id::in,
     rpta_info::out, rpta_info_fixpoint_table::in) is det.

-rpta_info_fixpoint_table_get_final_rpta_info(PredProcId, RptaInfo, T):-
-	fp_get_final(PredProcId, RptaInfo, T).
+rpta_info_fixpoint_table_get_final_rpta_info(PPId, RptaInfo, Table):-
+	RptaInfo = get_from_fixpoint_table_final(PPId, Table).

-:- pred wrapped_init(rpta_info_table::in, pred_proc_id::in, rpta_info::out)
-    is det.
+:- func wrapped_init(rpta_info_table, pred_proc_id) = rpta_info.

-wrapped_init(InfoTable, PredProcId, E) :-
-	( if
-		rpta_info_table_search_rpta_info(PredProcId, InfoTable) = Entry
-	  then
-		E = Entry
+wrapped_init(InfoTable, PPId) = Entry :-
+	( if    Entry0 = rpta_info_table_search_rpta_info(PPId, InfoTable)
+	  then  Entry = Entry0
 	  else
-        % The information we are looking for should be there after the
-        % intraprocedural analysis.
-		unexpected(this_file, "wrapper_init: rpta_info should exist.")
+            % The information we are looking for should be there after the
+            % intraprocedural analysis.
+		    unexpected(this_file, "wrapper_init: rpta_info should exist.")
 	).

 %-----------------------------------------------------------------------------%
@@ -1161,4 +1156,6 @@

 this_file = "rbmm.points_to_analysis.m".

+%-----------------------------------------------------------------------------%
+:- end_module rbmm.points_to_analysis.
 %-----------------------------------------------------------------------------%
Index: compiler/rbmm.points_to_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.points_to_info.m,v
retrieving revision 1.1
diff -u -r1.1 rbmm.points_to_info.m
--- compiler/rbmm.points_to_info.m	23 May 2007 00:17:21 -0000	1.1
+++ compiler/rbmm.points_to_info.m	23 May 2007 09:39:18 -0000
@@ -12,6 +12,8 @@
 % This module defines the "rpta_info" and "rpta_info_table" types.
 % rpta_info_table maps a procedure to its corresponding rpt information
 % (i.e., the rpt graph and the alpha mappings (at the call sites in it)).
+%
+%-----------------------------------------------------------------------------%

 :- module transform_hlds.rbmm.points_to_info.
 :- interface.
@@ -23,12 +25,15 @@

 :- import_module map.

+%-----------------------------------------------------------------------------%
+
 :- type rpta_info_table == map(pred_proc_id, rpta_info).

 :- func rpta_info_table_init = rpta_info_table.

 :- func rpta_info_table_search_rpta_info(pred_proc_id, rpta_info_table)
     = rpta_info is semidet.
+
 :- pred rpta_info_table_set_rpta_info(pred_proc_id::in, rpta_info::in,
     rpta_info_table::in, rpta_info_table::out) is det.

@@ -41,19 +46,13 @@
     % the alpha mapping is empty and the rpt graph contains all the nodes
     % corresponding to all the variables appear in the procedure.
     %
-:- pred rpta_info_init(proc_info::in, rpta_info::out) is det.
 :- func rpta_info_init(proc_info) = rpta_info.

 :- pred rpta_info_equal(rpta_info::in, rpta_info::in) is semidet.

 %-----------------------------------------------------------------------------%

-:- type rpt_alpha_mapping ==
-    map(
-        program_point,
-        map(rptg_node, rptg_node)
-    ).
-
+:- type rpt_alpha_mapping == map(program_point, map(rptg_node, rptg_node)).

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -74,6 +73,8 @@
 :- import_module string.
 :- import_module varset.

+%-----------------------------------------------------------------------------%
+
 rpta_info_table_init = map.init.
 rpta_info_table_search_rpta_info(PredProcId, Table) = RptaInfo :-
     Table^elem(PredProcId) = RptaInfo.
@@ -84,15 +85,13 @@
     % the alpha mapping is empty and the rpt graph contains all the nodes
     % corresponding to all the variables appear in the procedure.
     %
-rpta_info_init(ProcInfo, RptaInfo) :-
+rpta_info_init(ProcInfo) = RptaInfo :-
     proc_info_get_vartypes(ProcInfo, VarTypes),
     map.keys(VarTypes, Vars),
     list.foldl2(add_node_from_var(VarTypes), Vars, 1, _Reg,
         rpt_graph_init, Graph),
     map.init(AlphaMapping),
     RptaInfo = rpta_info(Graph, AlphaMapping).
-rpta_info_init(ProcInfo) = RptaInfo :-
-    rpta_info_init(ProcInfo, RptaInfo).

 :- pred add_node_from_var(map(prog_var, mer_type)::in, prog_var::in, int::in,
     int::out, rpt_graph::in, rpt_graph::out) is det.
@@ -114,7 +113,7 @@

 %-----------------------------------------------------------------------------%
 %
-% Alpha mapping at call sites.
+% Alpha mapping at call sites
 %

 :- pred rpt_alpha_mapping_equal(rpt_alpha_mapping::in,
@@ -124,7 +123,6 @@
     map.count(AlphaMapping1, C1),
     map.count(AlphaMapping2, C2),
     C1 = C2,
-
     map.keys(AlphaMapping1, CallSites1),
     rpt_alpha_mapping_equal_2(CallSites1, AlphaMapping1, AlphaMapping2).

@@ -135,7 +133,6 @@
 rpt_alpha_mapping_equal_2([CallSite1 | CallSite1s],
         AlphaMapping1, AlphaMapping2) :-
     map.search(AlphaMapping2, CallSite1, AlphaMappingAtCallSite2),
-
     map.lookup(AlphaMapping1, CallSite1, AlphaMappingAtCallSite1),
     rpt_alpha_mapping_at_call_site_equal(
         AlphaMappingAtCallSite1,AlphaMappingAtCallSite2),
@@ -148,7 +145,6 @@
     map.count(AMAtCallSite1, C1),
     map.count(AMAtCallSite2, C2),
     C1 = C2,
-
     map.keys(AMAtCallSite1, Nodes1),
     rpt_alpha_mapping_at_call_site_equal_2(Nodes1, AMAtCallSite1,
         AMAtCallSite2).
@@ -160,9 +156,10 @@
 rpt_alpha_mapping_at_call_site_equal_2([N | Ns], AMAtCallSite1,
         AMAtCallSite2) :-
     map.search(AMAtCallSite2, N, NPrime2),
-
     map.lookup(AMAtCallSite1, N, NPrime1),
     NPrime1 = NPrime2,
     rpt_alpha_mapping_at_call_site_equal_2(Ns, AMAtCallSite1, AMAtCallSite2).
-

+%-----------------------------------------------------------------------------%
+:- end_module rbmm.points_to_info.
+%-----------------------------------------------------------------------------%
Index: compiler/smm_common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/smm_common.m,v
retrieving revision 1.1
diff -u -r1.1 smm_common.m
--- compiler/smm_common.m	23 May 2007 00:17:22 -0000	1.1
+++ compiler/smm_common.m	23 May 2007 09:39:18 -0000
@@ -5,12 +5,14 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
-
+%
 % File smm_common.m.
 % Main author: Quan Phan.
 %
-% This module implements some common utilities and types for static memory
-% management analyses, e.g. CTGC, RBMM.
+% This module contains defines types and procedures that are common to
+% various static memory mangement analyses, e.g. CTGC, RBMM.
+%
+%-----------------------------------------------------------------------------%

 :- module transform_hlds.smm_common.
 :- interface.
@@ -24,9 +26,12 @@
 :- import_module parse_tree.
 :- import_module parse_tree.prog_data.

+:- import_module io.
 :- import_module list.
 :- import_module term.

+%-----------------------------------------------------------------------------%
+
     % Succeeds if the selector selects the type node of the input type.
     %
 :- pred check_type_of_node(module_info::in, mer_type::in, selector::in)
@@ -37,14 +42,27 @@
 :- pred some_are_special_preds(list(pred_proc_id)::in, module_info::in)
     is semidet.

+%-----------------------------------------------------------------------------%
+%
+% Definition of a program point
+%
+
+    % A program point records the place at which a data structure possibly
+    % becomes garbage.
+    %
 :- type program_point
     ---> 	pp(
                 pp_context	:: term.context,
                 pp_path		:: goal_path
             ).
-
-:- pred program_point_init(hlds_goal_info, program_point).
-:- mode program_point_init(in, out) is det.
+
+    % Compute the program point from the given goal_info.
+    %
+:- func program_point_init(hlds_goal_info) = program_point.
+
+    % Dump the information contained in a program point.
+    %
+:- pred dump_program_point(program_point::in, io::di, io::uo) is det.

 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -55,11 +73,14 @@
 :- import_module check_hlds.type_util.
 :- import_module ll_backend.
 :- import_module ll_backend.liveness.
+:- import_module parse_tree.prog_out.

 :- import_module bool.
 :- import_module int.
 :- import_module map.

+%-----------------------------------------------------------------------------%
+
 	% Check if the selector is valid w.r.t the type.
     %
 check_type_of_node(ModuleInfo, StartType, Selector) :-
@@ -67,8 +88,7 @@
 		Selector = [Sel | Sels],
 		(
 			Sel = termsel(Cons_id, Choice),
-			select_subtype(ModuleInfo, StartType, Cons_id, Choice,
-                SubType)
+			select_subtype(ModuleInfo, StartType, Cons_id, Choice, SubType)
 		;
 			Sel = typesel(SubType)
 		),
@@ -84,9 +104,8 @@
 :- pred select_subtype(module_info::in, mer_type::in, cons_id::in, int::in,
     mer_type::out) is semidet.

-select_subtype(ModuleInfo, Type, ConsID, Choice, SubType) :-
-	get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsID,
-        ArgTypes),
+select_subtype(ModuleInfo, Type, ConsId, Choice, SubType) :-
+	get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsId, ArgTypes),
 	list.index1(ArgTypes, Choice, SubType).

     % Special predicates are either compiler-generated ones, such as
@@ -119,8 +138,44 @@
 	% Note: for a meaningful use of this predicate the goal needs to be
     % filled with path information, i.e. call to fill_goal_path_slots(...).
     %
-program_point_init(GoalInfo, ProgPoint) :-
+program_point_init(GoalInfo) = ProgPoint :-
 	goal_info_get_context(GoalInfo, Context),
 	goal_info_get_goal_path(GoalInfo, GoalPath),
 	ProgPoint = pp(Context, GoalPath).
+
+dump_program_point(pp(Context, GoalPath), !IO):-
+    % context
+    prog_out.write_context(Context, !IO),
+    io.write_string("--", !IO),
+    % goal path
+    list.foldl(dump_goal_path_step, GoalPath, !IO).
+
+:- pred dump_goal_path_step(goal_path_step::in, io::di, io::uo) is det.
+
+dump_goal_path_step(step_conj(N)) -->
+    io.write_char('c'),
+    io.write_int(N).
+dump_goal_path_step(step_disj(N)) -->
+    io.write_char('d'),
+    io.write_int(N).
+dump_goal_path_step(step_switch(N, _)) -->
+    io.write_char('s'),
+    io.write_int(N).
+dump_goal_path_step(step_ite_cond) -->
+    io.write_char('c').
+dump_goal_path_step(step_ite_then) -->
+    io.write_char('t').
+dump_goal_path_step(step_ite_else) -->
+    io.write_char('e').
+dump_goal_path_step(step_neg) -->
+    io.write_char('n').
+dump_goal_path_step(step_scope(_)) -->
+    io.write_char('q').
+dump_goal_path_step(step_first) -->
+    io.write_char('f').
+dump_goal_path_step(step_later) -->
+    io.write_char('l').

+%-----------------------------------------------------------------------------%
+:- end_module smm_common.
+%-----------------------------------------------------------------------------%
Index: compiler/smm_fixpoint_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/smm_fixpoint_table.m,v
retrieving revision 1.1
diff -u -r1.1 smm_fixpoint_table.m
--- compiler/smm_fixpoint_table.m	23 May 2007 00:17:22 -0000	1.1
+++ compiler/smm_fixpoint_table.m	23 May 2007 09:39:18 -0000
@@ -5,213 +5,12 @@
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
+%
 % File: smm_fixpoint_table.m
-% Main author: nancy.
 %
-% This modules defines a generic table to be used for fixpoint computations.
-% For each key (usually pred_proc_id), it will map a given abstract
-% substitution. Here the notion of abstract substitution is abstracted
-% away as a typeclass which required only two operations: equal and init.
+% This is currently provided by ctgc.fixpoint_table.
 %
 %-----------------------------------------------------------------------------%

 :- module transform_hlds.smm_fixpoint_table.
 :- interface.
-
-:- import_module list.
-
-:- type fixpoint_table(K, E).
-
-	% Initialise the table.
-	% The first parameter is a list of keys which will be allowed in
-	% the table.
-	% fp_init(Initializer, Keys, Table).
-    %
-:- pred fp_init(pred(K, E), list(K), fixpoint_table(K, E)).
-:- mode fp_init(pred(in, out) is det, in, out) is det.
-
-	% Inform the table that a new run has begun.
-    %
-:- pred fp_new_run(fixpoint_table(K, E)::in, fixpoint_table(K, E)::out)
-        is det.
-
-	% Which run of the fix point are we up to?
-    %
-:- func fp_which_run(fixpoint_table(K, E)) = int.
-
-	% Check whether a fixpoint has been reached.
-    %
-:- pred fp_stable(fixpoint_table(K, E)::in) is semidet.
-
-	% Check whether the entries are recursive.
-    %
-:- pred fp_is_recursive(fixpoint_table(K,E)::in) is semidet.
-
-	% Add a new element (E) associated with key (K) to the table.
-	%   - if an element is already recorded with that key,
-	%      * and if both elements are equal, then a fixpoint is obtained
-	%        as far as this key is concerned
-	%      * if the elements are different, fixpoint is not reached yet,
-	%	 and the new information is simply kept
-	%   - if the element was not yet present in the table, add it
-	%     to the table (which does not change the stability of the
-	%     table)
-	% fp_add( EqualityTest, Key, Element, TableIn, TableOut).
-    %
-:- pred fp_add(pred(E, E), K, E, fixpoint_table(K, E), fixpoint_table(K, E)).
-:- mode fp_add(pred(in, in) is semidet, in, in, in, out) is det.
-
-	% Retrieve an element (E) associated with key (K) from the table.
-	% This operation will change the state of the table if the
-	% element _is_ present in the table. This means we're facing
-	% a recursive calltree. If the key is not an element of the
-	% allowed keys, then the procedure will fail.
-    %
-:- pred fp_get(K::in, E::out, fixpoint_table(K, E)::in,
-        fixpoint_table(K, E)::out) is semidet.
-
-	% Retrieve an element (E) associated with key (K) from the table.
-	% The operation reports an error when the element is not present.
-    %
-:- pred fp_get_final(K::in, E::out, fixpoint_table(K,E)::in) is det.
-
-	% Same as fp_get_final, but the predicate fails instead
-	% of aborting when the element is not present.
-    %
-:- pred fp_get_final_semidet(K::in, E::out, fixpoint_table(K,E)::in)
-        is semidet.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module libs.
-:- import_module libs.compiler_util.
-
-:- import_module bool.
-:- import_module int.
-:- import_module map.
-:- import_module string.
-
-:- type fixpoint_table(K, E)
-	--->	ft(
-                keys	:: list(K),	% list of allowed keys
-                run	:: int,		% number of runs
-                recursive	:: bool,	% is recursive or not
-                mapping 	:: map(K, fp_entry(E))
-            ).
-
-:- type fp_entry(E)
-	--->	entry(
-                bool, 	% stability: yes = stable, no = unstable
-                E
-            ).
-
-:- func fp_entry_init(E) = fp_entry(E).
-
-fp_entry_init(Elem) = entry(no, Elem).
-
-:- func fp_entry_stability(fp_entry(E)) = bool.
-
-fp_entry_stability(entry(S, _)) = S.
-
-:- func fp_entry_elem(fp_entry(E)) = E.
-
-fp_entry_elem(entry(_, Elem)) = Elem.
-
-:- func fp_entry_init(bool, E) = fp_entry(E).
-
-fp_entry_init(Bool, Elem) = entry(Bool, Elem).
-
-fp_init(Init, Ks, ft(Ks, Run, IsRecursive, Map)) :-
-	Run = 0,
-	IsRecursive = no,
-	map.init(Map0),
-	list.foldl(
-		(pred(K::in, M0::in, M::out) is det :-
-			Init(K, E),
-			map.det_insert(M0, K, fp_entry_init(E), M)
-		), Ks, Map0, Map).
-
-fp_new_run(T0, T0 ^ run := T0 ^ run + 1).
-
-fp_which_run(T0) = T0 ^ run.
-
-fp_is_recursive(T) :- T ^ recursive = yes.
-
-fp_stable(T) :-
-	(
-		T ^ recursive = yes
-	->
-		map.foldl(
-			pred(_K::in, Entry::in, S0::in, S::out) is det :-
-			(
-				( S0 = no ->
-					S = no
-				;
-					S = fp_entry_stability(Entry)
-				)
-			), T ^ mapping, yes, yes)
-	;
-		true
-	).
-
-fp_add(Equal, Index, Elem, Tin, Tout) :-
-	Map = Tin ^ mapping,
-	(
-		map.search(Map, Index, Entry),
-		TabledElem = fp_entry_elem(Entry)
-	->
-		( Equal(TabledElem, Elem) ->
-			S = yes
-		;
-			S = no
-		),
-        % whether or not the tabled element is equal to
-        % the new element, the final tabled element will
-        % always be set to the new one. This is handy
-        % for performing the following trick: equality
-        % can be checked on some partial piece of the
-        % elements (for deciding stability), but some other
-        % part might have changed, a change that should
-        % become visible in the table too.
-        % (in fact this is necessary for the reuse-fixpoint
-        % table where not only the reuses are kept (the
-        % abstract substitution), but also the goal that
-        % might have changed.
-		FinalTabledElem = fp_entry_init(S, Elem),
-		map.det_update(Map, Index, FinalTabledElem, MapOut)
-	;
-		% should not occur!
-		map.det_insert(Map, Index, fp_entry_init(Elem), MapOut)
-	),
-	Tout = (Tin ^ mapping := MapOut).
-
-fp_get(Index, Elem, Tin, Tout) :-
-	List = Tin ^ keys,
-	list.member(Index, List), % can fail
-	Mapin = Tin ^ mapping,
-	(
-		map.search(Mapin, Index, Entry),
-		TabledElem = fp_entry_elem(Entry)
-	->
-		Elem = TabledElem,
-		Mapout = Mapin
-	;
-		unexpected(this_file, "fp_get: key not in map")
-	),
-	Tout = (Tin ^ mapping := Mapout) ^ recursive := yes.
-
-fp_get_final(Index, Elem, T) :-
-	( fp_get_final_semidet(Index, TabledElem, T) ->
-		Elem = TabledElem
-	;
-		unexpected(this_file, "fp_get_final: final element not found")
-	).
-
-fp_get_final_semidet(Index, Elem, T):-
-	map.search(T^mapping, Index, Entry),
-	Elem = fp_entry_elem(Entry).
-
-:- func this_file = string.
-this_file = "smm_fixpoint_table.m".
Index: compiler/structure_reuse.direct.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.m,v
retrieving revision 1.7
diff -u -r1.7 structure_reuse.direct.m
--- compiler/structure_reuse.direct.m	19 Jan 2007 07:04:31 -0000	1.7
+++ compiler/structure_reuse.direct.m	23 May 2007 09:39:18 -0000
@@ -53,6 +53,7 @@
 :- import_module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
 :- import_module transform_hlds.ctgc.structure_reuse.direct.detect_garbage.
 :- import_module transform_hlds.ctgc.util.
+:- import_module transform_hlds.smm_common.

 :- import_module bool.
 :- import_module list.
@@ -174,34 +175,15 @@
     proc_info_set_goal(Goal, !ProcInfo),
     maybe_write_string(VeryVerbose, "% reuse analysis done.\n", !IO).

-
 %-----------------------------------------------------------------------------%
 % We use the type dead_cell_table to collect all deconstructions that possibly
 % leave garbage behind.
 %
 %
-    % To record the place at which a data structure possible becomes garbage,
-    % we use the notion of a program point. A program point is unique using
-    % its goal_path. The context of the goal is used for debugging traces.
-    %
-:- type program_point
-    --->    pp(
-                pp_context  ::  term.context,
-                pp_path     ::  goal_path
-            ).

     % A dead_cell_table maps program points onto reuse conditions.
     %
 :- type dead_cell_table == map(program_point, reuse_condition).
-
-
-    % Compute the program point of a given goal.
-    %
-:- func program_point_init(hlds_goal_info) = program_point.
-
-    % Dump the information contained in a program point.
-    %
-:- pred dump_program_point(program_point::in, io::di, io::uo) is det.

     % Initialise a dead_cell_table.
     %
@@ -237,44 +219,6 @@
     %
 :- pred dead_cell_table_maybe_dump(bool::in, dead_cell_table::in,
     io::di, io::uo) is det.
-
-program_point_init(Info) = PP :-
-    goal_info_get_context(Info, Context),
-    goal_info_get_goal_path(Info, GoalPath),
-    PP = pp(Context, GoalPath).
-
-dump_program_point(pp(Context, GoalPath), !IO):-
-    % context
-    prog_out.write_context(Context, !IO),
-    io.write_string("--", !IO),
-    % goal path
-    list.foldl(dump_goal_path_step, GoalPath, !IO).
-
-:- pred dump_goal_path_step(goal_path_step::in, io::di, io::uo) is det.
-
-dump_goal_path_step(step_conj(N)) -->
-    io.write_char('c'),
-    io.write_int(N).
-dump_goal_path_step(step_disj(N)) -->
-    io.write_char('d'),
-    io.write_int(N).
-dump_goal_path_step(step_switch(N, _)) -->
-    io.write_char('s'),
-    io.write_int(N).
-dump_goal_path_step(step_ite_cond) -->
-    io.write_char('c').
-dump_goal_path_step(step_ite_then) -->
-    io.write_char('t').
-dump_goal_path_step(step_ite_else) -->
-    io.write_char('e').
-dump_goal_path_step(step_neg) -->
-    io.write_char('n').
-dump_goal_path_step(step_scope(_)) -->
-    io.write_char('q').
-dump_goal_path_step(step_first) -->
-    io.write_char('f').
-dump_goal_path_step(step_later) -->
-    io.write_char('l').

 dead_cell_table_init = map.init.
2007-05-23 09:41:49 +00:00

285 lines
10 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006-2007 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: structure_reuse.direct.m.
% Main authors: nancy.
%
% This module efined procedure and type related to the dectection of so called
% direct reuses within the CTGC system. A "direct reuse" is a combination of
% the location of a deconstruction unification (where a datastructure may
% become garbage under certain conditions) and a set of locations of
% construction unifications where the garbage datastructure can be reused
% locally.
%
% Direct reuse analysis requires two steps:
% - Detecting where datastructures may become garbage.
% - Finding where these garbage datastructures can be reused.
%
%-----------------------------------------------------------------------------%
:- module transform_hlds.ctgc.structure_reuse.direct.
:- interface.
:- import_module hlds.hlds_module.
:- import_module transform_hlds.ctgc.structure_reuse.domain.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module io.
%-----------------------------------------------------------------------------%
:- pred direct_reuse_pass(sharing_as_table::in, module_info::in,
module_info::out, reuse_as_table::in, reuse_as_table::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.passes_aux.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.program_representation.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_out.
:- import_module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
:- import_module transform_hlds.ctgc.structure_reuse.direct.detect_garbage.
:- import_module transform_hlds.ctgc.util.
:- import_module transform_hlds.smm_common.
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module svmap.
:- import_module term.
:- include_module transform_hlds.ctgc.structure_reuse.direct.detect_garbage.
:- include_module transform_hlds.ctgc.structure_reuse.direct.choose_reuse.
%-----------------------------------------------------------------------------%
% The strategy for determining the reuse possibilities, i.e., either
% reuse is only allowed between terms that have exactly the same cons_id,
% or reuse is also allowed between terms that have different cons_id, yet
% where the difference in arity is not bigger than a given threshold.
%
:- type reuse_strategy
---> same_cons_id
; within_n_cells_difference(int).
% Determine the strategy that was set by the user.
%
:- pred get_strategy(reuse_strategy::out, module_info::in, module_info::out,
io::di, io::uo) is det.
get_strategy(Strategy, !ModuleInfo, !IO):-
io_lookup_string_option(structure_reuse_constraint, ConstraintStr, !IO),
(
ConstraintStr = "same_cons_id"
->
Strategy = same_cons_id
;
ConstraintStr = "within_n_cells_difference"
->
io_lookup_int_option(structure_reuse_constraint_arg, NCells, !IO),
Strategy = within_n_cells_difference(NCells)
;
Strategy = same_cons_id,
Pieces = [words("error: Invalid argument to "),
words("`--structure-reuse-constraint.'")],
write_error_pieces_plain(Pieces, !IO),
module_info_incr_errors(!ModuleInfo)
).
direct_reuse_pass(SharingTable, !ModuleInfo, !ReuseTable, !IO):-
% Determine the reuse strategy:
get_strategy(Strategy, !ModuleInfo, !IO),
% Gather the pred-ids of the preds that need to be analysed.
module_info_predids(AllPredIds, !ModuleInfo),
list.filter(pred_requires_analysis(!.ModuleInfo), AllPredIds,
ToBeAnalysedPredIds),
% Analyse and annotate each of the predicates.
list.foldl3(direct_reuse_process_pred(Strategy, SharingTable),
ToBeAnalysedPredIds, !ModuleInfo, !ReuseTable, !IO).
:- pred direct_reuse_process_pred(reuse_strategy::in, sharing_as_table::in,
pred_id::in, module_info::in, module_info::out, reuse_as_table::in,
reuse_as_table::out, io::di, io::uo) is det.
direct_reuse_process_pred(Strategy, SharingTable, PredId, !ModuleInfo,
!ReuseTable, !IO):-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
list.foldl3(direct_reuse_process_proc(Strategy, SharingTable, PredId),
pred_info_non_imported_procids(PredInfo0), !ModuleInfo,
!ReuseTable, !IO).
:- pred direct_reuse_process_proc(reuse_strategy::in, sharing_as_table::in,
pred_id::in, proc_id::in, module_info::in, module_info::out,
reuse_as_table::in, reuse_as_table::out, io::di, io::uo) is det.
direct_reuse_process_proc(Strategy, SharingTable, PredId, ProcId,
!ModuleInfo, !ReuseTable, !IO) :-
module_info_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, Pred0),
pred_info_get_procedures(Pred0, Procs0),
map.lookup(Procs0, ProcId, Proc0),
direct_reuse_process_procedure(Strategy, SharingTable, PredId, ProcId,
!.ModuleInfo, Pred0, Proc0, Proc, ReuseAs, !IO),
reuse_as_table_set(proc(PredId, ProcId), ReuseAs, !ReuseTable),
map.det_update(Procs0, ProcId, Proc, Procs),
pred_info_set_procedures(Procs, Pred0, Pred),
map.det_update(Preds0, PredId, Pred, Preds),
module_info_set_preds(Preds, !ModuleInfo).
% Process one individual procedure.
%
:- pred direct_reuse_process_procedure(reuse_strategy::in,
sharing_as_table::in, pred_id::in, proc_id::in, module_info::in,
pred_info::in, proc_info::in, proc_info::out, reuse_as::out,
io::di, io::uo) is det.
direct_reuse_process_procedure(Strategy, SharingTable, PredId, ProcId,
ModuleInfo, PredInfo, !ProcInfo, ReuseAs, !IO):-
io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
write_proc_progress_message("% Direct reuse analysis of ",
PredId, ProcId, ModuleInfo, !IO),
proc_info_get_goal(!.ProcInfo, Goal0),
% Determine the deconstructions in which data may potentially become
% garbage.
%
determine_dead_deconstructions(ModuleInfo, PredInfo, !.ProcInfo,
SharingTable, Goal0, DeadCellTable),
dead_cell_table_maybe_dump(VeryVerbose, DeadCellTable, !IO),
% Determine how the detected dead datastructures can be reused.
% This annotates the goal with potential reuses.
%
determine_reuse(Strategy, ModuleInfo, !.ProcInfo, DeadCellTable,
Goal0, Goal, ReuseAs, !IO),
proc_info_set_goal(Goal, !ProcInfo),
maybe_write_string(VeryVerbose, "% reuse analysis done.\n", !IO).
%-----------------------------------------------------------------------------%
% We use the type dead_cell_table to collect all deconstructions that possibly
% leave garbage behind.
%
%
% A dead_cell_table maps program points onto reuse conditions.
%
:- type dead_cell_table == map(program_point, reuse_condition).
% Initialise a dead_cell_table.
%
:- func dead_cell_table_init = dead_cell_table.
% Check whether the table is empty.
%
:- pred dead_cell_table_is_empty(dead_cell_table::in) is semidet.
% Succeeds if the given program point is listed in the table. Return
% the associated reuse_condition.
%
:- func dead_cell_table_search(program_point, dead_cell_table)
= reuse_condition is semidet.
% Add a program point and its associated reuse_condition to the table.
%
:- pred dead_cell_table_set(program_point::in, reuse_condition::in,
dead_cell_table::in, dead_cell_table::out) is det.
% Remove a program point from the table.
%
:- pred dead_cell_table_remove(program_point::in,
dead_cell_table::in, dead_cell_table::out) is det.
% Remove all program points from the table for which the reuse_conditions
% are "conditional".
%
:- pred dead_cell_table_remove_conditionals(dead_cell_table::in,
dead_cell_table::out) is det.
% Dump the contents of the table.
%
:- pred dead_cell_table_maybe_dump(bool::in, dead_cell_table::in,
io::di, io::uo) is det.
dead_cell_table_init = map.init.
dead_cell_table_is_empty(Table) :-
map.is_empty(Table).
dead_cell_table_search(PP, Table) = Table ^ elem(PP).
dead_cell_table_set(PP, RC, !Table) :-
svmap.set(PP, RC, !Table).
dead_cell_table_remove(PP, !Table) :-
svmap.det_remove(PP, _, !Table).
dead_cell_table_remove_conditionals(!Table) :-
map.foldl(dead_cell_table_add_unconditional, !.Table,
dead_cell_table_init, !:Table).
:- pred dead_cell_table_add_unconditional(program_point::in,
reuse_condition::in, dead_cell_table::in, dead_cell_table::out) is det.
dead_cell_table_add_unconditional(PP, C, !Table) :-
(
reuse_condition_is_conditional(C)
->
true
;
dead_cell_table_set(PP, C, !Table)
).
dead_cell_table_maybe_dump(MaybeDump, Table, !IO) :-
(
MaybeDump = no
;
MaybeDump = yes,
io.write_string("\t\t|--------|\n", !IO),
map.foldl(dead_cell_entry_dump, Table, !IO),
io.write_string("\t\t|--------|\n", !IO)
).
:- pred dead_cell_entry_dump(program_point::in, reuse_condition::in,
io::di, io::uo) is det.
dead_cell_entry_dump(PP, Cond, !IO) :-
(
reuse_condition_is_conditional(Cond)
->
io.write_string("\t\t| cond |\t", !IO)
;
io.write_string("\t\t| always |\t", !IO)
),
dump_program_point(PP, !IO),
io.write_string("\n", !IO).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "structure_sharing.direct.m".
%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.structure_reuse.direct.
%-----------------------------------------------------------------------------%