[m-rev.] for review: procedure-local closure analysis
Julien Fischer
juliensf at cs.mu.OZ.AU
Thu Jun 9 13:36:29 AEST 2005
For review by anyone.
Estimated hours taken: 30
Branches: main
Implement a procedure-local closure analysis that tracks the possible
values of higher-order valued variables within a procedure. We will
eventually replace this with more sophisticated analysis that tracks
these values across procedure and module boundaries but we something of
this capability now in order to continue development of the termination
and exception analyses.
This analysis is similar to that carried out by higher-order
specialization except here we do keep track of higher-order variables
that have multiple possible values.
compiler/closure_analysis.m:
Keep track of the possible values of higher-order variables
within a procedure. Annotate goals in the HLDS with this
information where it might prove useful.
compiler/hlds_goal.m:
Add an extra field to the goal_info that is designed
to hold the results of optional analysis passes. At
the moment this is only used to hold the results of
closure analysis.
compiler/options.m:
compiler/mercury_compile.m:
Add code to invoke the new analysis. Closure analysis
is stage 117, directly before exception analysis.
compiler/passes_aux.m:
Add a version of write_proc_progress_message, that does
not require the caller to deconstruct a pred_proc_id.
compiler/prog_type.m:
Add a predicate type_is_higher_order/1 that is similar
type_is_higher_order/5 except that it doesn't have any
outputs.
compiler/transform_hlds.m:
Include the new module.
doc/user_guide.texi:
Document the '--analyse-closures' and '--debug-closures'
options. The documentation is currently commented out until
closure analysis is useful for something.
doc/reference_manual.texi:
s/must have give a definition/must give a definition/
*/.cvsignore:
Have CVS ignore the various *_FLAGS files generated
by the configure script.
Julien.
Index: analysis/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/analysis/.cvsignore,v
retrieving revision 1.5
diff -u -r1.5 .cvsignore
--- analysis/.cvsignore 26 Apr 2005 08:12:20 -0000 1.5
+++ analysis/.cvsignore 10 May 2005 05:00:43 -0000
@@ -30,3 +30,4 @@
libmer_analysis.lib
libmer_analysis.dylib
Mercury.modules
+ANALYSIS_FLAGS
Index: browser/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/.cvsignore,v
retrieving revision 1.23
diff -u -r1.23 .cvsignore
--- browser/.cvsignore 26 Apr 2005 08:12:20 -0000 1.23
+++ browser/.cvsignore 10 May 2005 05:00:21 -0000
@@ -43,3 +43,4 @@
*.*_date
Mercury.modules
browse_test
+MDB_FLAGS
Index: compiler/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/.cvsignore,v
retrieving revision 1.24
diff -u -r1.24 .cvsignore
--- compiler/.cvsignore 22 Jul 2004 14:41:07 -0000 1.24
+++ compiler/.cvsignore 10 May 2005 04:59:53 -0000
@@ -38,3 +38,4 @@
*.optdate
*.trans_opt
*.trans_opt_date
+COMP_FLAGS
Index: compiler/closure_analysis.m
===================================================================
RCS file: compiler/closure_analysis.m
diff -N compiler/closure_analysis.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/closure_analysis.m 9 Jun 2005 02:48:40 -0000
@@ -0,0 +1,497 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2005 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: closure_analysis.m
+% main author: juliensf
+
+% Perform local closure analysis on procedures. This involves tracking
+% the possible values that a higher-order variable can take within a
+% procedure. We attach this information to places where knowing the
+% possible values of a higher-order call may be useful.
+
+% This is similar to the analysis done by higher-order specialization, except
+% that here, we do care if a higher-order variable can take multiple values.
+
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.closure_analysis.
+
+:- interface.
+
+:- import_module hlds.hlds_module.
+:- import_module io.
+
+:- pred process_module(module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- 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 parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_out.
+:- import_module parse_tree.prog_type.
+:- import_module transform_hlds.dependency_graph.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module counter.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module set.
+:- import_module std_util.
+:- import_module string.
+:- import_module svmap.
+:- import_module svset.
+:- import_module varset.
+
+%----------------------------------------------------------------------------%
+
+process_module(!ModuleInfo, !IO) :-
+ %
+ % XXX At the moment it is not necessary to do this on a per-SCC basis,
+ % since the analysis is only procedure-local, but we would eventually
+ % like to extend it.
+ %
+ globals.io_lookup_bool_option(debug_closure, Debug, !IO),
+ module_info_ensure_dependency_info(!ModuleInfo),
+ module_info_dependency_info(!.ModuleInfo, DepInfo),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+ list.foldl2(process_scc(Debug), SCCs, !ModuleInfo, !IO).
+
+%----------------------------------------------------------------------------%
+%
+% Perform closure analysis on a SCC
+%
+
+:- pred process_scc(bool::in, list(pred_proc_id)::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+process_scc(Debug, SCC, !ModuleInfo, !IO) :-
+ list.foldl2(process_proc(Debug), SCC, !ModuleInfo, !IO).
+
+%----------------------------------------------------------------------------%
+
+ % This type represents the possible values of a higher-order valued
+ % variable.
+ %
+:- type closure_values
+ ---> unknown
+ % The higher-order variable may be bound to something
+ % but we don't know what it is.
+
+ ; partial(set(pred_proc_id))
+ % The higher-order variable may be bound to these
+ % values, or it may be bound to something else we don't
+ % know about. (This is intended to be useful in producing
+ % error messages for the termination analysis; if one
+ % of the higher-order values is definitely non-terminating
+ % we can certainly let the user know about it.)
+
+ ; exclusive(set(pred_proc_id)).
+ % The higher-order variable will be exclusively bound
+ % to this set of values.
+
+ % We attach a closure_info to each goal where it may be of interest;
+ % at the moment calls and generic_calls.
+ %
+:- type closure_info == map(prog_var, closure_values).
+
+%----------------------------------------------------------------------------%
+
+:- func closure_info_init(module_info, vartypes, prog_vars, list(mode))
+ = closure_info.
+
+closure_info_init(ModuleInfo, VarTypes, HeadVars, ArgModes) = ClosureInfo :-
+ partition_arguments(ModuleInfo, VarTypes, HeadVars, ArgModes,
+ set.init, Inputs0, set.init, _Outputs),
+ Inputs = set.filter(var_has_ho_type(VarTypes), Inputs0),
+ set.fold(insert_unknown, Inputs, map.init, ClosureInfo).
+
+ % Succeeds iff the given variable has a higher-order type.
+ %
+:- pred var_has_ho_type(vartypes::in, prog_var::in) is semidet.
+
+var_has_ho_type(VarTypes, Var) :-
+ Type = map.lookup(VarTypes, Var),
+ type_is_higher_order(Type).
+
+ % Insert the given prog_var into the closure_info and set the
+ % possible values to unknown.
+ %
+:- pred insert_unknown(prog_var::in, closure_info::in, closure_info::out)
+ is det.
+
+insert_unknown(Var, !ClosureInfo) :-
+ svmap.det_insert(Var, unknown, !ClosureInfo).
+
+%----------------------------------------------------------------------------%
+%
+% Perform local closure analysis on a procedure
+%
+
+:- pred process_proc(bool::in, pred_proc_id::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+process_proc(Debug, PPId, !ModuleInfo, !IO) :-
+ module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
+ proc_info_headvars(ProcInfo0, HeadVars),
+ proc_info_vartypes(ProcInfo0, VarTypes),
+ proc_info_argmodes(ProcInfo0, ArgModes),
+ ClosureInfo0 = closure_info_init(!.ModuleInfo, VarTypes, HeadVars,
+ ArgModes),
+ write_proc_progress_message("Analysing closures in ", PPId, !.ModuleInfo,
+ !IO),
+ proc_info_goal(ProcInfo0, Body0),
+ process_goal(VarTypes, !.ModuleInfo, Body0, Body,
+ ClosureInfo0, _ClosureInfo),
+ (
+ Debug = yes,
+ proc_info_varset(ProcInfo, Varset),
+ dump_closure_info(Varset, Body, !IO),
+ io.flush_output(!IO)
+ ;
+ Debug = no
+ ),
+ proc_info_set_goal(Body, ProcInfo0, ProcInfo),
+ module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+%
+% Track higher-order values through goals
+%
+
+:- pred process_goal(vartypes::in, module_info::in,
+ hlds_goal::in, hlds_goal::out, closure_info::in, closure_info::out) is det.
+
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = conj(Goals0) - GoalInfo,
+ list.map_foldl(process_goal(VarTypes, ModuleInfo), Goals0, Goals,
+ !ClosureInfo),
+ Goal = conj(Goals) - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = GoalExpr - GoalInfo0,
+ GoalExpr = call(CallPredId, CallProcId, CallArgs, _, _, _),
+ %
+ % Look for any higher-order arguments and divide them
+ % into sets of input and output arguments.
+ %
+ module_info_pred_proc_info(ModuleInfo, CallPredId, CallProcId,
+ _CallPredInfo, CallProcInfo),
+ proc_info_argmodes(CallProcInfo, CallArgModes),
+ %
+ % NOTE: we construct sets of arguments, rather than lists,
+ % in case there are duplicate arguments.
+ %
+ partition_arguments(ModuleInfo, VarTypes, CallArgs, CallArgModes,
+ set.init, InputArgs, set.init, OutputArgs),
+ %
+ % Update the goal_info to include any information about the
+ % values of higher-order valued variables.
+ %
+ AddValues = (pred(Var::in, !.ValueMap::in, !:ValueMap::out) is det :-
+ %
+ % The closure_info won't yet contain any information about
+ % higher-order outputs from this call.
+ %
+ ( map.search(!.ClosureInfo, Var, PossibleValues) ->
+ (
+ PossibleValues = unknown
+ ;
+ PossibleValues = partial(_)
+ ;
+ PossibleValues = exclusive(KnownValues),
+ svmap.det_insert(Var, KnownValues, !ValueMap)
+ )
+ ;
+ true
+ )
+ ),
+ set.fold(AddValues, InputArgs, map.init, Values),
+ goal_info_set_ho_values(Values, GoalInfo0, GoalInfo),
+ %
+ % Insert any information about higher-order
+ % outputs from this call into the closure_info.
+ %
+ set.fold(insert_unknown, OutputArgs, !ClosureInfo),
+ Goal = GoalExpr - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = GoalExpr - GoalInfo0,
+ %
+ % XXX We should probably just ignore Aditi stuff and unsafe_casts
+ % but annotating them with closure_infos won't hurt.
+ %
+ GoalExpr = generic_call(_Details, GCallArgs, GCallModes, _),
+ partition_arguments(ModuleInfo, VarTypes, GCallArgs, GCallModes,
+ set.init, InputArgs, set.init, OutputArgs),
+ AddValues = (pred(Var::in, !.ValueMap::in, !:ValueMap::out) is det :-
+ %
+ % The closure_info won't yet contain any information about
+ % higher-order outputs from this call.
+ %
+ ( map.search(!.ClosureInfo, Var, PossibleValues) ->
+ (
+ PossibleValues = unknown
+ ;
+ PossibleValues = partial(_)
+ ;
+ PossibleValues = exclusive(KnownValues),
+ svmap.det_insert(Var, KnownValues, !ValueMap)
+ )
+ ;
+ true
+ )
+ ),
+ set.fold(AddValues, InputArgs, map.init, Values),
+ goal_info_set_ho_values(Values, GoalInfo0, GoalInfo),
+ %
+ % Insert any information about higher-order
+ % outputs from this call into the closure_info.
+ %
+ set.fold(insert_unknown, OutputArgs, !ClosureInfo),
+ Goal = GoalExpr - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = switch(SwitchVar, SwitchCanFail, Cases0) - GoalInfo,
+ ProcessCase = (func(Case0) = Case - CaseInfo :-
+ Case0 = case(ConsId, CaseGoal0),
+ process_goal(VarTypes, ModuleInfo, CaseGoal0, CaseGoal,
+ !.ClosureInfo, CaseInfo),
+ Case = case(ConsId, CaseGoal)
+ ),
+ CasesAndInfos = list.map(ProcessCase, Cases0),
+ assoc_list.keys_and_values(CasesAndInfos, Cases, CasesInfo),
+ list.foldl(merge_closure_infos, CasesInfo, map.init, !:ClosureInfo),
+ Goal = switch(SwitchVar, SwitchCanFail, Cases) - GoalInfo.
+process_goal(VarTypes, _, Goal, Goal, !ClosureInfo) :-
+ Goal = unify(_, _, _, Unification, _) - _,
+ (
+ Unification = construct(LHS, RHS, _, _, _, _, _),
+ (
+ % NOTE: we don't bother worrying about features
+ % that relate to Aditi.
+ RHS = pred_const(ShroudedPPId, EvalMethod),
+ EvalMethod = normal
+ ->
+ PPId = unshroud_pred_proc_id(ShroudedPPId),
+ HO_Value = set.make_singleton_set(PPId),
+ svmap.det_insert(LHS, exclusive(HO_Value), !ClosureInfo)
+ ;
+ true
+ )
+ ;
+ Unification = deconstruct(_, _, Args, _, _, _),
+ %
+ % XXX We don't currently support tracking the values of
+ % closures that are stored in data structures.
+ %
+ HO_Args = list.filter(var_has_ho_type(VarTypes), Args),
+ list.foldl(insert_unknown, HO_Args, !ClosureInfo)
+ ;
+ Unification = assign(LHS, RHS),
+ ( var_has_ho_type(VarTypes, LHS) ->
+ %
+ % Sanity check: make sure the rhs is also a higher-order variable.
+ %
+ ( not var_has_ho_type(VarTypes, RHS) ->
+ unexpected(this_file,
+ "not a higher-order var in process_goal_2")
+ ;
+ true
+ ),
+ Values = map.lookup(!.ClosureInfo, RHS),
+ svmap.det_insert(LHS, Values, !ClosureInfo)
+ ;
+ true
+ )
+ ;
+ Unification = simple_test(_, _)
+ ;
+ Unification = complicated_unify(_, _, _)
+ ).
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = disj(Goals0) - GoalInfo,
+ ProcessDisjunct = (func(Disjunct0) = DisjunctResult :-
+ process_goal(VarTypes, ModuleInfo, Disjunct0, Disjunct,
+ !.ClosureInfo, ClosureInfoForDisjunct),
+ DisjunctResult = Disjunct - ClosureInfoForDisjunct
+ ),
+ DisjunctsAndInfos = list.map(ProcessDisjunct, Goals0),
+ assoc_list.keys_and_values(DisjunctsAndInfos, Goals, DisjunctsInfo),
+ list.foldl(merge_closure_infos, DisjunctsInfo, map.init, !:ClosureInfo),
+ Goal = disj(Goals) - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = not(NegatedGoal0) - GoalInfo,
+ process_goal(VarTypes, ModuleInfo, NegatedGoal0, NegatedGoal,
+ !.ClosureInfo, _),
+ Goal = not(NegatedGoal) - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = scope(Reason, ScopedGoal0) - GoalInfo,
+ process_goal(VarTypes, ModuleInfo, ScopedGoal0, ScopedGoal, !ClosureInfo),
+ Goal = scope(Reason, ScopedGoal) - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = if_then_else(ExistQVars, If0, Then0, Else0) - GoalInfo,
+ process_goal(VarTypes, ModuleInfo, If0, If, !.ClosureInfo, IfInfo),
+ process_goal(VarTypes, ModuleInfo, Then0, Then, IfInfo, IfThenInfo),
+ process_goal(VarTypes, ModuleInfo, Else0, Else, !.ClosureInfo, ElseInfo),
+ map.union(merge_closure_values, IfThenInfo, ElseInfo, !:ClosureInfo),
+ Goal = if_then_else(ExistQVars, If, Then, Else) - GoalInfo.
+process_goal(_, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ %
+ % XXX 'ExtraArgs' should probably be ignored here since it is only
+ % used by the tabling transformation.
+ %
+ % XXX We may eventually want to annotate foreign_procs with
+ % clousure_infos as well. It isn't useful at the moment however.
+ %
+ Goal0 = GoalExpr - GoalInfo,
+ GoalExpr = foreign_proc(_, _, _, Args, _ExtraArgs, _),
+ ForeignHOArgs = (pred(Arg::in, Out::out) is semidet :-
+ Arg = foreign_arg(Var, NameMode, Type),
+ %
+ % A 'no' here means that the foreign argument is unused.
+ %
+ NameMode = yes(_ - Mode),
+ mode_util.mode_is_output(ModuleInfo, Mode),
+ type_is_higher_order(Type),
+ Out = Var - unknown
+ ),
+ list.filter_map(ForeignHOArgs, Args, OutputForeignHOArgs),
+ svmap.det_insert_from_assoc_list(OutputForeignHOArgs, !ClosureInfo),
+ Goal = GoalExpr - GoalInfo.
+process_goal(VarTypes, ModuleInfo, Goal0, Goal, !ClosureInfo) :-
+ Goal0 = par_conj(Goals0) - GoalInfo,
+ list.map_foldl(process_goal(VarTypes, ModuleInfo), Goals0, Goals,
+ !ClosureInfo),
+ Goal = par_conj(Goals) - GoalInfo.
+process_goal(_, _, shorthand(_) - _, _, _, _) :-
+ unexpected(this_file, "shorthand/1 goal during closure analysis.").
+
+%----------------------------------------------------------------------------%
+
+:- pred partition_arguments(module_info::in, vartypes::in,
+ prog_vars::in, list(mode)::in,
+ set(prog_var)::in, set(prog_var)::out,
+ set(prog_var)::in, set(prog_var)::out) is det.
+
+partition_arguments(_, _, [], [], !Inputs, !Outputs).
+partition_arguments(_, _, [_|_], [], _, _, _, _) :-
+ unexpected(this_file, "partition_arguments/7 unequal length lists.").
+partition_arguments(_, _, [], [_|_], _, _, _, _) :-
+ unexpected(this_file, "partition_arguments/7 unequal length lists.").
+partition_arguments(ModuleInfo, VarTypes, [ Var | Vars ], [ Mode | Modes ],
+ !Inputs, !Outputs) :-
+ ( var_has_ho_type(VarTypes, Var) ->
+ ( mode_is_input(ModuleInfo, Mode) ->
+ svset.insert(Var, !Inputs)
+ ; mode_is_output(ModuleInfo, Mode) ->
+ svset.insert(Var, !Outputs)
+ ;
+ true
+ )
+ ;
+ true
+ ),
+ partition_arguments(ModuleInfo, VarTypes, Vars, Modes, !Inputs, !Outputs).
+
+:- pred merge_closure_infos(closure_info::in, closure_info::in,
+ closure_info::out) is det.
+
+merge_closure_infos(A, B, C) :-
+ map.union(merge_closure_values, A, B, C).
+
+:- pred merge_closure_values(closure_values::in, closure_values::in,
+ closure_values::out) is det.
+
+merge_closure_values(unknown, unknown, unknown).
+merge_closure_values(unknown, partial(A), partial(A)).
+merge_closure_values(unknown, exclusive(A), partial(A)).
+merge_closure_values(partial(A), unknown, partial(A)).
+merge_closure_values(partial(A), partial(B), partial(A `set.union` B)).
+merge_closure_values(partial(A), exclusive(B), partial(A `set.union` B)).
+merge_closure_values(exclusive(A), unknown, partial(A)).
+merge_closure_values(exclusive(A), partial(B), partial(A `set.union` B)).
+merge_closure_values(exclusive(A), exclusive(B), exclusive(A `set.union` B)).
+
+%----------------------------------------------------------------------------%
+%
+% Debugging code (used by '--debug-closure' option)
+%
+
+:- pred dump_closure_info(prog_varset::in, hlds_goal::in,
+ io::di, io::uo) is det.
+
+dump_closure_info(Varset, conj(Goals) - _, !IO) :-
+ list.foldl(dump_closure_info(Varset), Goals, !IO).
+dump_closure_info(Varset, par_conj(Goals) - _, !IO) :-
+ list.foldl(dump_closure_info(Varset), Goals, !IO).
+dump_closure_info(Varset, call(_,_,_,_,_,_) - GoalInfo, !IO) :-
+ dump_ho_values(GoalInfo, Varset, !IO).
+dump_closure_info(Varset, generic_call(_,_,_,_) - GoalInfo, !IO) :-
+ dump_ho_values(GoalInfo, Varset, !IO).
+dump_closure_info(Varset, scope(_, Goal) - _, !IO) :-
+ dump_closure_info(Varset, Goal, !IO).
+dump_closure_info(Varset, switch(_, _, Cases) - _, !IO) :-
+ CaseToGoal = (func(case(_, Goal)) = Goal),
+ Goals = list.map(CaseToGoal, Cases),
+ list.foldl(dump_closure_info(Varset), Goals, !IO).
+dump_closure_info(Varset, if_then_else(_, If, Then, Else) - _, !IO) :-
+ list.foldl(dump_closure_info(Varset), [If, Then, Else], !IO).
+dump_closure_info(_, unify(_,_,_,_,_) - _, !IO).
+dump_closure_info(Varset, not(Goal) - _, !IO) :-
+ dump_closure_info(Varset, Goal, !IO).
+dump_closure_info(_, foreign_proc(_,_,_,_,_,_) - _, !IO).
+dump_closure_info(Varset, disj(Goals) - _, !IO) :-
+ list.foldl(dump_closure_info(Varset), Goals, !IO).
+dump_closure_info(_, shorthand(_) - _, _, _) :-
+ unexpected(this_file, "shorthand goal encountered.\n").
+
+:- pred dump_ho_values(hlds_goal_info::in, prog_varset::in,
+ io::di, io::uo) is det.
+
+dump_ho_values(GoalInfo, Varset, !IO) :-
+ HO_Values = goal_info_get_ho_values(GoalInfo),
+ ( not map.is_empty(HO_Values) ->
+ goal_info_get_context(GoalInfo, Context),
+ prog_out.write_context(Context, !IO),
+ io.nl(!IO),
+ map.foldl(dump_ho_value(Varset), HO_Values, !IO)
+ ;
+ true
+ ).
+
+:- pred dump_ho_value(prog_varset::in, prog_var::in, set(pred_proc_id)::in,
+ io::di, io::uo) is det.
+
+dump_ho_value(Varset, ProgVar, Values, !IO) :-
+ VarName = varset.lookup_name(Varset, ProgVar),
+ io.format("%s =\n", [s(VarName)], !IO),
+ WritePPIds = (pred(PPId::in, !.IO::di, !:IO::uo) is det :-
+ io.write_string("\t", !IO),
+ io.write(PPId, !IO),
+ io.nl(!IO)
+ ),
+ set.fold(WritePPIds, Values, !IO).
+
+%----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "closure_analysis.m".
+
+%----------------------------------------------------------------------------%
+:- end_module closure_analysis.
+%----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.131
diff -u -r1.131 hlds_goal.m
--- compiler/hlds_goal.m 31 May 2005 06:55:28 -0000 1.131
+++ compiler/hlds_goal.m 31 May 2005 08:49:15 -0000
@@ -24,6 +24,7 @@
:- import_module bool.
:- import_module char.
:- import_module list.
+:- import_module map.
:- import_module set.
:- import_module std_util.
@@ -744,6 +745,7 @@
:- type hlds_goal_info.
:- type hlds_goal_code_gen_info.
+:- type hlds_goal_extra_info.
:- pred goal_info_init(hlds_goal_info::out) is det.
:- pred goal_info_init(prog_context::in, hlds_goal_info::out) is det.
@@ -773,6 +775,7 @@
:- pred goal_info_get_goal_path(hlds_goal_info::in, goal_path::out) is det.
:- pred goal_info_get_code_gen_info(hlds_goal_info::in,
hlds_goal_code_gen_info::out) is det.
+:- func goal_info_get_extra_info(hlds_goal_info) = hlds_goal_extra_info.
:- pred goal_info_set_determinism(hlds_goal_info::in, determinism::in,
hlds_goal_info::out) is det.
@@ -790,6 +793,8 @@
hlds_goal_info::out) is det.
:- pred goal_info_set_code_gen_info(hlds_goal_info::in,
hlds_goal_code_gen_info::in, hlds_goal_info::out) is det.
+:- pred goal_info_set_extra_info(hlds_goal_extra_info::in, hlds_goal_info::in,
+ hlds_goal_info::out) is det.
:- pred goal_info_get_occurring_vars(hlds_goal_info::in, set(prog_var)::out)
is det.
@@ -1000,6 +1005,16 @@
%-----------------------------------------------------------------------------%
%
+% get/set predicates for the extra_goal_info strucutre.
+%
+
+:- func goal_info_get_ho_values(hlds_goal_info) = ho_values.
+
+:- pred goal_info_set_ho_values(ho_values::in,
+ hlds_goal_info::in, hlds_goal_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
% Miscellaneous utility procedures for dealing with HLDS goals
%
@@ -1072,6 +1087,7 @@
:- pred goal_is_atomic(hlds_goal_expr::in) is semidet.
% Return the HLDS equivalent of `true'.
+ %
:- pred true_goal(hlds_goal::out) is det.
:- pred true_goal(prog_context::in, hlds_goal::out) is det.
@@ -1285,6 +1301,19 @@
; llds_code_gen_info(llds_code_gen :: llds_code_gen_details).
%-----------------------------------------------------------------------------%
+%
+% Stuff specific to the auxiliary analysis passes of the compiler.
+%
+% At the moment only closure analysis annotates the HLDS at a per-goal level.
+
+ % This type stores the possible values of a higher order variable
+ % (at a particular point) as determined by the closure analysis
+ % (see closure_analysis.m.) If a variable does not have an entry
+ % in the map then it may take any (valid) value.
+ %
+:- type ho_values == map(prog_var, set(pred_proc_id)).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1434,7 +1463,12 @@
maybe_mode_constraint_info :: maybe(mode_constraint_goal_info),
- code_gen_info :: hlds_goal_code_gen_info
+ code_gen_info :: hlds_goal_code_gen_info,
+
+ extra_goal_info :: hlds_goal_extra_info
+ % Extra information about that goal that may
+ % be attached by various optional analysis
+ % passes, e.g closure analysis.
).
:- type mode_constraint_goal_info --->
@@ -1465,7 +1499,8 @@
term__context_init(Context),
set__init(Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- Features, [], no, no_code_gen_info).
+ Features, [], no, no_code_gen_info,
+ hlds_goal_extra_info_init).
:- pragma inline(goal_info_init/2).
goal_info_init(Context, GoalInfo) :-
@@ -1474,18 +1509,21 @@
set__init(NonLocals),
set__init(Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- Features, [], no, no_code_gen_info).
+ Features, [], no, no_code_gen_info,
+ hlds_goal_extra_info_init).
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, GoalInfo) :-
term__context_init(Context),
purity_features(Purity, _, Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- list_to_set(Features), [], no, no_code_gen_info).
+ list_to_set(Features), [], no, no_code_gen_info,
+ hlds_goal_extra_info_init).
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context, GoalInfo) :-
purity_features(Purity, _, Features),
GoalInfo = goal_info(Detism, InstMapDelta, Context, NonLocals,
- list_to_set(Features), [], no, no_code_gen_info).
+ list_to_set(Features), [], no, no_code_gen_info,
+ hlds_goal_extra_info_init).
goal_info_get_determinism(GoalInfo, GoalInfo ^ determinism).
goal_info_get_instmap_delta(GoalInfo, GoalInfo ^ instmap_delta).
@@ -1494,6 +1532,7 @@
goal_info_get_features(GoalInfo, GoalInfo ^ features).
goal_info_get_goal_path(GoalInfo, GoalInfo ^ goal_path).
goal_info_get_code_gen_info(GoalInfo, GoalInfo ^ code_gen_info).
+goal_info_get_extra_info(GoalInfo) = GoalInfo ^ extra_goal_info.
goal_info_get_occurring_vars(GoalInfo, OccurringVars) :-
( GoalInfo ^ maybe_mode_constraint_info = yes(MCI) ->
@@ -1542,6 +1581,8 @@
GoalInfo0 ^ goal_path := GoalPath).
goal_info_set_code_gen_info(GoalInfo0, CodeGenInfo,
GoalInfo0 ^ code_gen_info := CodeGenInfo).
+goal_info_set_extra_info(ExtraInfo, GoalInfo,
+ GoalInfo ^ extra_goal_info := ExtraInfo).
% The code-gen non-locals are always the same as the
% non-locals when structure reuse is not being performed.
@@ -2217,6 +2258,29 @@
MaybeName = no
),
get_pragma_foreign_var_names_2(MaybeNames, !Names).
+
+%-----------------------------------------------------------------------------%
+%
+% Extra goal info.
+%
+
+:- type hlds_goal_extra_info
+ ---> extra_info(
+ extra_info_ho_vals :: ho_values
+ ).
+
+:- func hlds_goal_extra_info_init = hlds_goal_extra_info.
+
+hlds_goal_extra_info_init = ExtraInfo :-
+ HO_Values = map.init,
+ ExtraInfo = extra_info(HO_Values).
+
+goal_info_get_ho_values(GoalInfo) =
+ GoalInfo ^ extra_goal_info ^ extra_info_ho_vals.
+
+goal_info_set_ho_values(Values, !GoalInfo) :-
+ !:GoalInfo = !.GoalInfo ^ extra_goal_info
+ ^ extra_info_ho_vals:= Values.
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.333
diff -u -r1.333 mercury_compile.m
--- compiler/mercury_compile.m 23 May 2005 02:16:44 -0000 1.333
+++ compiler/mercury_compile.m 24 May 2005 04:16:44 -0000
@@ -71,6 +71,7 @@
:- import_module transform_hlds__table_gen.
:- import_module transform_hlds__complexity.
:- import_module transform_hlds__lambda.
+:- import_module transform_hlds__closure_analysis.
:- import_module backend_libs__type_ctor_info.
:- import_module transform_hlds__termination.
:- import_module transform_hlds__term_constr_main.
@@ -2064,6 +2065,8 @@
globals__lookup_bool_option(Globals, termination2, Termination2),
globals__lookup_bool_option(Globals, analyse_exceptions,
ExceptionAnalysis),
+ globals__lookup_bool_option(Globals, analyse_closures,
+ ClosureAnalysis),
(
MakeOptInt = yes,
intermod__write_optfile(!HLDS, !IO),
@@ -2082,6 +2085,17 @@
mercury_compile__frontend_pass_by_phases(!HLDS, FoundModeError,
!IO),
( FoundModeError = no ->
+ %
+ % NOTE: We should run closure analysis
+ % if we are performing termination or exception
+ % analysis.
+ %
+ ( ClosureAnalysis = yes ->
+ mercury_compile.maybe_closure_analysis(
+ Verbose, Stats, !HLDS, !IO)
+ ;
+ true
+ ),
(
ExceptionAnalysis = yes,
mercury_compile__maybe_exception_analysis(Verbose, Stats,
@@ -2248,6 +2262,9 @@
mercury_compile__expand_equiv_types_hlds(Verbose, Stats, !HLDS, !IO),
mercury_compile__maybe_dump_hlds(!.HLDS, 115, "equiv_types", !IO),
+
+ mercury_compile__maybe_closure_analysis(Verbose, Stats, !HLDS, !IO),
+ mercury_compile__maybe_dump_hlds(!.HLDS, 117, "closure_analysis", !IO),
%
% Uncomment the following code to check that unique mode analysis
@@ -2799,6 +2816,22 @@
maybe_write_string(Verbose, "% Program is determinism-correct.\n", !IO)
),
maybe_report_stats(Stats, !IO).
+
+:- pred mercury_compile.maybe_closure_analysis(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+mercury_compile.maybe_closure_analysis(Verbose, Stats, !HLDS, !IO) :-
+ globals.io_lookup_bool_option(analyse_closures, ClosureAnalysis,
+ !IO),
+ (
+ ClosureAnalysis = yes,
+ maybe_write_string(Verbose, "% Analysing closures...\n", !IO),
+ closure_analysis.process_module(!HLDS, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ClosureAnalysis = no
+ ).
:- pred mercury_compile.maybe_exception_analysis(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.459
diff -u -r1.459 options.m
--- compiler/options.m 17 May 2005 04:37:57 -0000 1.459
+++ compiler/options.m 9 Jun 2005 02:51:08 -0000
@@ -127,6 +127,7 @@
; debug_liveness
; debug_stack_opt
; debug_make
+ ; debug_closure
% Output options
; make_short_interface
; make_interface
@@ -521,6 +522,7 @@
; propagate_failure_constrs
; term2_maximum_matrix_size
; analyse_exceptions
+ ; analyse_closures
; untuple
; tuple
; tuple_trace_counts_file
@@ -854,7 +856,8 @@
debug_il_asm - bool(no),
debug_liveness - int(-1),
debug_stack_opt - int(-1),
- debug_make - bool(no)
+ debug_make - bool(no),
+ debug_closure - bool(no)
]).
option_defaults_2(output_option, [
% Output Options (mutually exclusive)
@@ -1118,7 +1121,8 @@
% XXX This is just a guess - I'm not sure what sensible
% value for this is.
term2_maximum_matrix_size - int(70),
- analyse_exceptions - bool(no)
+ analyse_exceptions - bool(no),
+ analyse_closures - bool(no)
]).
option_defaults_2(optimization_option, [
% Optimization options
@@ -1528,6 +1532,7 @@
long_option("debug-liveness", debug_liveness).
long_option("debug-stack-opt", debug_stack_opt).
long_option("debug-make", debug_make).
+long_option("debug-closure", debug_closure).
% output options (mutually exclusive)
long_option("generate-source-file-mapping",
@@ -1894,6 +1899,8 @@
long_option("termination2-maximum-matrix-size", term2_maximum_matrix_size).
long_option("term2-max-matrix-size", term2_maximum_matrix_size).
long_option("analyse-exceptions", analyse_exceptions).
+long_option("analyse-closures", analyse_closures).
+long_option("analyse-local-closures", analyse_closures).
long_option("untuple", untuple).
long_option("tuple", tuple).
long_option("tuple-trace-counts-file", tuple_trace_counts_file).
@@ -2841,6 +2848,10 @@
"\tof the predicate with the given predicate id.",
"--debug-make",
"\tOutput detailed debugging traces of the `--make' option."
+% This can be uncommented when the '--analyse-closures' option is uncommented.
+% (See below.)
+% "--debug-closure",
+% "\tOutput detailed debugging traces of the closure analysis."
]).
:- pred options_help_output(io::di, io::uo) is det.
@@ -3898,6 +3909,13 @@
"\tEnable exception analysis. Identify those",
"\tprocedures that will not throw an exception.",
"\tSome optimizations can make use of this information."
+% XXX The options controlling closure analysis are currently
+% commented out because it isn't useful. It can be uncommented when
+% we actually have something that uses it.
+% "--analyse-closures",
+% "\tEnable closure analysis. Try to identify the possible",
+% "\tvalues that higher-order valued variables can take.",
+% "\tSome optimizations can make use of this information.",
% ,
% "--untuple",
% "\tExpand out procedure arguments when the argument type",
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.68
diff -u -r1.68 passes_aux.m
--- compiler/passes_aux.m 24 Mar 2005 05:34:11 -0000 1.68
+++ compiler/passes_aux.m 19 May 2005 07:23:58 -0000
@@ -131,6 +131,9 @@
:- pred write_pred_progress_message(string::in, pred_id::in, module_info::in,
io::di, io::uo) is det.
+:- pred write_proc_progress_message(string::in, pred_proc_id::in,
+ module_info::in, io::di, io::uo) is det.
+
:- pred write_proc_progress_message(string::in, pred_id::in, proc_id::in,
module_info::in, io::di, io::uo) is det.
@@ -394,6 +397,9 @@
;
VeryVerbose = no
).
+
+write_proc_progress_message(Message, proc(PredId, ProcId), ModuleInfo, !IO) :-
+ write_proc_progress_message(Message, PredId, ProcId, ModuleInfo, !IO).
write_proc_progress_message(Message, PredId, ProcId, ModuleInfo, !IO) :-
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.6
diff -u -r1.6 prog_type.m
--- compiler/prog_type.m 7 May 2005 15:49:24 -0000 1.6
+++ compiler/prog_type.m 31 May 2005 12:41:04 -0000
@@ -23,6 +23,11 @@
%-----------------------------------------------------------------------------%
+ % Succeeds iff the given type is a higher-order predicate or function
+ % type.
+ %
+:- pred type_is_higher_order((type)::in) is semidet.
+
% type_is_higher_order(Type, Purity, PredOrFunc, ArgTypes, EvalMeth):
% succeeds iff Type is a higher-order predicate or function type with
% the specified argument types (for functions, the return type is
@@ -31,7 +36,7 @@
%
:- pred type_is_higher_order((type)::in, purity::out, pred_or_func::out,
lambda_eval_method::out, list(type)::out) is semidet.
-
+
% Succeed if the given type is a tuple type, returning
% the argument types.
%
@@ -157,6 +162,8 @@
%-----------------------------------------------------------------------------%
+type_is_higher_order(Type) :- type_is_higher_order(Type, _, _, _, _).
+
type_is_higher_order(Type, Purity, PredOrFunc, EvalMethod, PredArgTypes) :-
(
Type = term.functor(term.atom(PurityName), [BaseType], _),
@@ -318,6 +325,7 @@
EvalMethod = normal,
Purity = (pure)
).
+
type_is_tuple(Type, ArgTypes) :-
type_to_ctor_and_args(Type, TypeCtor, ArgTypes),
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.18
diff -u -r1.18 transform_hlds.m
--- compiler/transform_hlds.m 19 Apr 2005 02:47:15 -0000 1.18
+++ compiler/transform_hlds.m 10 May 2005 05:05:43 -0000
@@ -31,6 +31,8 @@
:- include_module (lambda).
+:- include_module closure_analysis.
+
:- include_module termination.
:- include_module term_pass1.
:- include_module term_pass2.
Index: deep_profiler/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/.cvsignore,v
retrieving revision 1.7
diff -u -r1.7 .cvsignore
--- deep_profiler/.cvsignore 26 Apr 2005 08:12:21 -0000 1.7
+++ deep_profiler/.cvsignore 10 May 2005 05:01:24 -0000
@@ -22,3 +22,4 @@
mdprof_server
Mercury
.deep.tags
+DEEP_FLAGS
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.317
diff -u -r1.317 reference_manual.texi
--- doc/reference_manual.texi 7 Jun 2005 02:59:59 -0000 1.317
+++ doc/reference_manual.texi 9 Jun 2005 02:12:48 -0000
@@ -1800,7 +1800,7 @@
This means that the type names will be exported,
but the constructors (functors) for these types will not be exported.
The implementation section of a module
-must have give the definition of all the abstract types
+must give a definition for all of the abstract types
named in the interface section of the module.
Abstract types may be defined as either discriminated union types
or as equivalence types.
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.437
diff -u -r1.437 user_guide.texi
--- doc/user_guide.texi 20 May 2005 05:40:18 -0000 1.437
+++ doc/user_guide.texi 9 Jun 2005 03:03:54 -0000
@@ -5280,6 +5280,14 @@
@findex --make
Output detailed debugging traces of the `--make' option.
+ at c XXX This can be uncommented when the documentation for
+ at c `--analyse-closures' is uncommented.
+
+ at c @sp 1
+ at c @item --debug-closures
+ at c @findex --debug-closures
+ at c Output detailed debugging traces of the `--analyse-closures' option.
+
@end table
@node Output options
@@ -6993,6 +7001,16 @@
Try to identify those procedures that cannot throw an
exception. This information can be used by some
optimization passes.
+
+ at c XXX The documentation `--analyse-closures' can be uncommented
+ at c when we actually have something that makes use of it.
+
+ at c @sp1
+ at c @item --analyse-closures
+ at c @findex --analyse-closures
+ at c Enable closure analysis. Try to identify the possible
+ at c values that higher-order valued variables can take.
+ at c Some optimizations can make use of this information.
@c @sp 1
@c @item --untuple
Index: library/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/library/.cvsignore,v
retrieving revision 1.27
diff -u -r1.27 .cvsignore
--- library/.cvsignore 26 Apr 2005 08:12:21 -0000 1.27
+++ library/.cvsignore 10 May 2005 05:00:09 -0000
@@ -39,3 +39,4 @@
*.java
*.class
*.jar
+LIB_FLAGS
Index: mdbcomp/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/mdbcomp/.cvsignore,v
retrieving revision 1.2
diff -u -r1.2 .cvsignore
--- mdbcomp/.cvsignore 26 Apr 2005 08:12:21 -0000 1.2
+++ mdbcomp/.cvsignore 10 May 2005 05:02:16 -0000
@@ -20,3 +20,4 @@
mer_mdbcomp.dep
Mercury
Mercury.modules
+MDBCOMP_FLAGS
Index: profiler/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/.cvsignore,v
retrieving revision 1.13
diff -u -r1.13 .cvsignore
--- profiler/.cvsignore 22 Jul 2004 14:41:07 -0000 1.13
+++ profiler/.cvsignore 10 May 2005 05:01:34 -0000
@@ -22,3 +22,4 @@
mercury_profile.dep
mercury_profile.dv
Mercury
+PROF_FLAGS
Index: slice/.cvsignore
===================================================================
RCS file: /home/mercury1/repository/mercury/slice/.cvsignore,v
retrieving revision 1.1
diff -u -r1.1 .cvsignore
--- slice/.cvsignore 29 Apr 2005 06:39:33 -0000 1.1
+++ slice/.cvsignore 10 May 2005 04:59:39 -0000
@@ -8,3 +8,4 @@
*.err
*.mh
*.mih
+SLICE_FLAGS
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list