[m-rev.] For review: Annotate the HLDS with regions

Quan Phan Quan.Phan at cs.kuleuven.be
Fri Jun 29 14:31:04 AEST 2007


Hi Julien,

This is the reply for your second review of my code about annotating HLDS.

Please find my answer in the text below. I will post the diff in another email.

Thanks and regards,
Quan

Quoting Julien Fischer <juliensf at csse.unimelb.edu.au>:

> 
> > Index: interval.m
> > ===================================================================
> > RCS file: /home/mercury/mercury1/repository/mercury/compiler/interval.m,v
> > retrieving revision 1.29
...
> > +                HowToConstruct = construct_in_region(_),
> > +                unexpected(this_file,
> > +                    "build_interval_info_in_goal: contruct in region")
> 
> s/contruct/construct/
> 

Corrected.

> > +            ;
> >                 ( HowToConstruct = construct_statically(_)
...
> 
> > Index: rbmm.condition_renaming.m
> > ===================================================================
> > RCS file:
> >
> /home/mercury/mercury1/repository/mercury/compiler/rbmm.condition_renaming.m,v
> > retrieving revision 1.2
> > diff -u -u -r1.2 rbmm.condition_renaming.m
> > --- rbmm.condition_renaming.m	15 Jun 2007 11:46:11 -0000	1.2
> > +++ rbmm.condition_renaming.m	18 Jun 2007 07:46:31 -0000
> > @@ -16,6 +16,17 @@
> > % program point so that the binding of non-local regions in the condition
> > % goal of an if-then-else is resolved.
> > %
> > +% When reasoning about the renaming and reverse renaming needed for
> 
>  	... for an if-then-else we take into account ...

I changed as suggested.


> 
> > +% if-then-else here we take into account the changes to regions caused by
> the
> > +% renaming and renaming annotations needed for region resurrection.
> > +% This can be viewed as if the program is transformed by the renaming
> > +% and reverse renaming for region surrection first. This is to solve the
> 
> s/surrection/ressurrection/

Corrected.

> 
> > +% problem with region resurrection. Then that transformed program is
> > +% transformed again to solve the problem with if-then-else. Note that the
> > +% first transformation may add to the problem with if-then-else, e.g.,
> > +% when it introduces reverse renaming to a non-local variable inside the
> > +% condition goal of an if-then-else.
> > +%
> 
> ...
> 
> > Index: rbmm.m
> > ===================================================================
> > RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.m,v
> > retrieving revision 1.4
> > diff -u -u -r1.4 rbmm.m
> > --- rbmm.m	15 Jun 2007 11:46:11 -0000	1.4
> > +++ rbmm.m	18 Jun 2007 07:32:48 -0000
> > @@ -28,6 +28,7 @@
> > :- include_module region_instruction.
> > :- include_module region_liveness_info.
> > :- include_module region_resurrection_renaming.
> > +:- include_module region_transformation.
> >
> > :- import_module hlds.
> > :- import_module hlds.hlds_module.
> > @@ -52,6 +53,10 @@
> > :- import_module transform_hlds.rbmm.points_to_analysis.
> > :- import_module transform_hlds.rbmm.region_instruction.
> > :- import_module transform_hlds.rbmm.region_resurrection_renaming.
> > +:- import_module transform_hlds.rbmm.region_transformation.
> > +
> > +:- import_module map.
> > +:- import_module hlds.hlds_out.
> 
> Please check the coding standard regarding module imports.  In particular
> compiler imports should be in one block, followed by library imports in
> another.
> 

Corrected.

> ...
> 
> > Index: rbmm.region_resurrection_renaming.m
> > ===================================================================
> > RCS file:
> >
>
/home/mercury/mercury1/repository/mercury/compiler/rbmm.region_resurrection_renaming.m,v
> > retrieving revision 1.2
> > diff -u -u -r1.2 rbmm.region_resurrection_renaming.m
> > --- rbmm.region_resurrection_renaming.m	15 Jun 2007 11:46:12 -0000	1.2
> > +++ rbmm.region_resurrection_renaming.m	18 Jun 2007 07:49:45 -0000
> > @@ -56,19 +56,49 @@
> > :- type join_point_region_name_table ==
> >     map(pred_proc_id, map(program_point, string)).
> >
> > +    % This predicate traveses execution paths and computes 2 pieces of
> 
> s/2/two/
> 

Changed.

> 
> > +:- pred collect_join_points_path(list(list(program_point))::in,
> > +    list(program_point)::in, int::in, int::out, set(program_point)::in,
> > +    set(program_point)::out, map(program_point, string)::in,
> > +    map(program_point, string)::out) is det.
> > +
> > +collect_join_points_path(Paths, Path, !Counter, !JoinPoints,
> > +        !JoinPointProc) :-
> > +    list.delete_all(Paths, Path, TheOtherPaths),
> > +    % We ignore the first program point in each path because
> > +    % it cannot be a join point.
> > +    ( if    Path = [PrevPoint, ProgPoint | ProgPoints]
> > +      then
> > +            ( if    is_join_point(ProgPoint, PrevPoint, TheOtherPaths)
> > +              then
> > +                    svmap.set(ProgPoint,
> > +                        "_jp_" ++ string.int_to_string(!.Counter),
> > +                        !JoinPointProc),
> > +                    svset.insert(ProgPoint, !JoinPoints),
> > +                    !:Counter = !.Counter + 1
> > +              else
> > +                    true
> > +            ),
> > +            collect_join_points_path(Paths,
> > +                [ProgPoint | ProgPoints], !Counter, !JoinPoints,
> > +                !JoinPointProc)
> > +      else
> > +            true
> > +    ).
> 
> Rather than using an `int' as the counter here you should use the `counter'
> type from the standard library (defined in thecounter module).
> 

I changed as suggested.

> ...
> 
> > Index: rbmm.region_transformation.m
> > ===================================================================
> > RCS file: rbmm.region_transformation.m
> > diff -N rbmm.region_transformation.m
> > --- /dev/null	1 Jan 1970 00:00:00 -0000
> > +++ rbmm.region_transformation.m	18 Jun 2007 06:46:46 -0000
> > @@ -0,0 +1,944 @@
> >
> +%-----------------------------------------------------------------------------%
> > +% vim: ft=mercury ts=4 sw=4
> >
> +%-----------------------------------------------------------------------------%
> > +% Copyright (C) 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: rbmm.region_transformation.m
> > +% Main author: quan.
> > +%
...
> > +:- pred generate_list_of_region_type(int::in, mer_type::in,
> > +	list(mer_type)::out) is det.
> > +
> > +generate_list_of_region_type(N, RegType, RegTypes) :-
> > +	( if	N = 0
> > +	  then
> > +	  	    RegTypes = []
> > +	  else
> > +			generate_list_of_region_type(N - 1, RegType, RegTypes0),
> > +			RegTypes = [RegType | RegTypes0]
> > +	).
> 
> 
> You can use the library function list.duplicate/2 to do that.
> 

I changed as suggested.

> ...
> 
> > +:- pred region_transform_proc(rpta_info_table::in,
> proc_region_set_table::in,
> > +	proc_region_set_table::in, proc_region_set_table::in,
> > +	proc_pp_region_list_table::in,
> > +	renaming_table::in, renaming_table::in, annotation_table::in,
> > +	renaming_annotation_table::in, renaming_annotation_table::in,
> > +	pred_id::in, proc_id::in, name_to_prog_var_table::in,
> > +	name_to_prog_var_table::out, module_info::in, module_info::out) is det.
> > +
> > +region_transform_proc(RptaInfoTable, ConstantRTable, DeadRTable,
> BornRTable,
> > +		ActualRegionArgTable, ResurRenamingTable, IteRenamingTable,
> > +		AnnotationTable, ResurRenamingAnnoTable, IteRenamingAnnoTable,
> > +		PredId, ProcId, !NameToVarTable, !ModuleInfo) :-
> > +    PPId = proc(PredId, ProcId),
> > +	module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo0),
> > +	fill_goal_path_slots(!.ModuleInfo, ProcInfo0, ProcInfo1),
> > +	proc_info_get_varset(ProcInfo1, VarSet0),
> > +	proc_info_get_vartypes(ProcInfo1, VarTypes0),
> > +	proc_info_get_headvars(ProcInfo1, HeadVars0),
> > +	proc_info_get_argmodes(ProcInfo1, ActualArgModes0),
> > +	proc_info_get_goal(ProcInfo1, Goal0),
> > +	map.lookup(RptaInfoTable, PPId, rpta_info(Graph, _)),
> > +	map.lookup(ConstantRTable, PPId, ConstantR),
> > +	map.lookup(DeadRTable, PPId, DeadR),
> > +	map.lookup(BornRTable, PPId, BornR),
> > +	map.lookup(ActualRegionArgTable, PPId, ActualRegionArgProc),
> > +	( if	map.search(ResurRenamingTable, PPId, ResurRenamingProc0)
> > +	  then
> > +			ResurRenamingProc = ResurRenamingProc0,
> > +			map.lookup(ResurRenamingAnnoTable, PPId,
> > +				ResurRenamingAnnoProc)
> > +	  else
> > +			ResurRenamingProc = map.init,
> > +			ResurRenamingAnnoProc = map.init
> > +	),
> > +	( if	map.search(IteRenamingTable, PPId, IteRenamingProc0)
> > +	  then
> > +			IteRenamingProc = IteRenamingProc0,
> > +			map.lookup(IteRenamingAnnoTable, PPId,
> > +				IteRenamingAnnoProc)
> > +	  else
> > +			IteRenamingProc = map.init,
> > +			IteRenamingAnnoProc = map.init
> > +	),
> > +	map.lookup(AnnotationTable, PPId, AnnotationProc),
> > +

> > +	NameToVar0 = map.init,
> > +	annotate_proc(!.ModuleInfo, PredInfo, Graph, ConstantR, DeadR, BornR,
> > +		ActualRegionArgProc, ResurRenamingProc, IteRenamingProc,
> > +		AnnotationProc, ResurRenamingAnnoProc, IteRenamingAnnoProc,
> > +		VarSet0, _, VarTypes0, _, HeadVars0, _, ActualArgModes0, _,
> > +		Goal0, _, NameToVar0, NameToVar, ProcInfo1, ProcInfo),
> 
> 
> You will need to recompute the instmap deltas for the procedure at this
> point,
> e.g. something like
> 
>  	RecomputeAtomic = yes,
>  	recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo2, ProcInfo,
> !ModuleInfo),
> 
> (where ProcInfo2 is the output of annotate_proc/26)
> 
> You may also need to recompute the purity at this point as well, i.e. call
> repurity_check_proc/4.
> 

What I actually did is call requantify_proc at the place. I recompute instmap
delta and repurity check only after all the procedures have been transformed
because those two actions consult other transformed procedures. 



> 
> > +
> > +	module_info_set_pred_proc_info(PPId, PredInfo, ProcInfo, !ModuleInfo),
> > +	% Basically, we will turn this atomic goal and all the region
> > +	% annotations attached to (before and after) it into a
> > +	% conjunction (even when there is no annotation). If the
> 
> Why don't you just leave them alone if there is no annotation?
> 

They are left alone now.

> ...
> 
> > +	%
> > +	% Note: When both renamings (for resurrection and if-then-else) of a
> > +	% region exist at a program point, we will apply the resurrection one.
> > +	% This is due to the fact that when reasonning about what renaming is
> 
> s/reasonning/reasoning/
> 

Corrected.

> > +	% needed for if-then-else we have taken into account the changes
> > +	% caused by renaming and annotations needed for resurrection problem.
> > +	%
> 
>  	... for the ressurrection problem.

I think you meant to add a "the" and "resurrection" is correct :).

> 
> > +:- pred region_transform_goal(module_info::in, rpt_graph::in,
> > +
> > +annotate_constructions_unification(_, _, _, !Unification, !VarSet,
> > +		!VarTypes, !NameToVar) :-
> > +	(
> > +		( !.Unification = deconstruct(_, _, _, _, _, _)
> > +		; !.Unification = assign(_, _)
> > +		; !.Unification = simple_test(_, _)
> > +		),
> > +		true
> 
> Delete 'true'.

Deleted.

> 
> > +	;
> > +		!.Unification = complicated_unify(_, _, _),
> > +		unexpected(this_file, "annotate_construction_unification: "
> > +			++ "encounter complicated unify")
> > +
> > +:- pred node_to_reg_var(rpt_graph::in, rptg_node::in,
> > +	prog_var::out, name_to_prog_var::in, name_to_prog_var::out,
> > +	prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
> 
> Add a comment describing what this predicate does.

Comments added for this predicate and also for its related ones.

> 
> > +
> > +node_to_reg_var(Graph, Node, RegVar, !NameToVar, !VarSet,
> 
> > +:- pred region_instruction_to_conj(module_info::in, term.context::in,
> > +	renaming::in, renaming::in, string::in,
> > +	name_to_prog_var::in, name_to_prog_var::out,
> > +	prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
> > +	hlds_goals::in, hlds_goals::out) is det.
> > +
> > +	% Instruction is of the form: "Tx: xxxxxx R..."
> > +	% The first x is the number of the rule, which is not important here.
> > +	% The next 6 x is either "remove" or "create", the last part is the
> > +	% region name. This region name will be subjected to renaming due to
> > +	% if-then-else and region resurrection.
> > +	% This predicate turns such an instruction into a call to a suitable
> > +	% region builtin.
> > +	%
> 
> Move this comment above the predicate declaration.

I did and also added the XXX comment that using "string" is not good.

> 
> > Index: structure_reuse.indirect.m
> > ===================================================================
> > RCS file:
> >
> /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
> > retrieving revision 1.10
> > diff -u -u -r1.10 structure_reuse.indirect.m
> > --- structure_reuse.indirect.m	12 Jun 2007 07:21:26 -0000	1.10
> > +++ structure_reuse.indirect.m	18 Jun 2007 12:50:00 -0000
> > @@ -302,6 +302,8 @@
> >             ;
> >                 ( HowToConstruct = construct_dynamically
> >                 ; HowToConstruct = reuse_cell(_)
> > +                % XXX Temporary for the time being.
> > +                ; HowToConstruct = construct_in_region(_)
> >                 )
> 
> The above code is used to record variables that contain statically
> allocated data; the above XXX is unnecessary since all other sorts
> of construction unification should be handled the same way at that
> point.

The comment is removed.


--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list