[m-rev.] diff: implement concat_string_list for .NET

[Fergus Henderson]

Even though this patch doesn't completely solve the problem,
I think it is a step on the way, so unless anyone has any
objections, I will go ahead and commit this.

On 18-Feb-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 18-Feb-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > I'm currently testing a patch which fixes both of these problems.
> 
> Unfortunately that still didn't do the trick -- loop hoisting still
> doesn't hoist the calls to string__length.  However, with the patch
> below, these calls are now present in the input to loop hoisting,
> so I think it ought to be able to optimize them.  I think the problem
> may perhaps be related to the fact that they occur at the start of the
> `then' part of an if-then-else, rather than before the `if'.
> 
> Ralph, would you mind having a look at this?
> How about modifying the loop_inv pass so that it treats goals at the start
> of an if-then-else condition up to and including the first can_fail goal
> the same way it treats goals in a conjunction?
> 
> ----------
> 
> Estimated hours taken: 1
> Branches: main
> 
> compiler/mercury_compile.m:
> compiler/notes/compiler_design.html:
> 	Perform loop invariant hoisting after inlining, since inlining
> 	can create opportunities for loop invariant hoisting.
> 
> library/string.m:
> 	Implement string__index in Mercury, in terms of string__length,
> 	string__unsafe_index, and a new procedure string__index_check,
> 	rather than implementing in C.  string__index_check contains
> 	just the index checking code from the old string__index implementation.
> 	Implementing string__index in Mercury like this should allow the
> 	Mercury compiler to do loop invariant hoisting on the calls to
> 	string__length.
> 
> 	Declare the output argument for string__unsafe_index
> 	and string__index_det with mode `uo', to match string__index.
> 	For unsafe__index, this change was needed now that string__index is
> 	implemented in terms of string__unsafe_index.
> 
> Workspace: /home/ceres/fjh/mercury
> Index: compiler/mercury_compile.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
> retrieving revision 1.274
> diff -u -d -r1.274 mercury_compile.m
> --- compiler/mercury_compile.m	16 Feb 2003 02:16:36 -0000	1.274
> +++ compiler/mercury_compile.m	18 Feb 2003 00:51:59 -0000
> @@ -10,6 +10,8 @@
>  % This is the top-level of the Mercury compiler.
>  
>  % This module invokes the different passes of the compiler as appropriate.
> +% The constraints on pass ordering are documented in
> +% compiler/notes/compiler_design.html.
>  
>  %-----------------------------------------------------------------------------%
>  
> @@ -53,13 +55,13 @@
>  :- import_module transform_hlds__lambda.
>  :- import_module backend_libs__type_ctor_info, transform_hlds__termination.
>  :- import_module transform_hlds__higher_order, transform_hlds__accumulator.
> -:- import_module transform_hlds__inlining, transform_hlds__deforest.
> +:- import_module transform_hlds__inlining, transform_hlds__loop_inv.
> +:- import_module transform_hlds__deforest.
>  :- import_module aditi_backend__dnf, aditi_backend__magic.
>  :- import_module transform_hlds__dead_proc_elim.
>  :- import_module transform_hlds__delay_construct, transform_hlds__unused_args.
>  :- import_module transform_hlds__unneeded_code, transform_hlds__lco.
>  :- import_module ll_backend__deep_profiling.
> -:- import_module transform_hlds__loop_inv.
>  
>  	% the LLDS back-end
>  :- import_module ll_backend__saved_vars, ll_backend__stack_opt.
> @@ -1924,14 +1926,14 @@
>  			Verbose, Stats, HLDS33),
>  	mercury_compile__maybe_dump_hlds(HLDS33, "33", "accum"),
>  
> -	% Hoisting loop invariants first invokes pass 34, "mark_static".
> +	mercury_compile__maybe_do_inlining(HLDS33, Verbose, Stats, HLDS34),
> +	mercury_compile__maybe_dump_hlds(HLDS34, "34", "inlining"),
> +
> +	% Hoisting loop invariants first invokes pass 35, "mark_static".
>  	% "mark_static" is also run at stage 60.
>  	%
> -	mercury_compile__maybe_loop_inv(HLDS33, Verbose, Stats, HLDS35),
> -	mercury_compile__maybe_dump_hlds(HLDS35, "35", "loop_inv"),
> -
> -	mercury_compile__maybe_do_inlining(HLDS35, Verbose, Stats, HLDS36),
> -	mercury_compile__maybe_dump_hlds(HLDS36, "36", "inlining"),
> +	mercury_compile__maybe_loop_inv(HLDS34, Verbose, Stats, HLDS36),
> +	mercury_compile__maybe_dump_hlds(HLDS36, "36", "loop_inv"),
>  
>  	mercury_compile__maybe_deforestation(HLDS36, Verbose, Stats, HLDS37),
>  	mercury_compile__maybe_dump_hlds(HLDS37, "37", "deforestation"),
> @@ -2902,7 +2904,7 @@
>  			%
>  		mercury_compile__maybe_mark_static_terms(HLDS0, Verbose, Stats,
>  			HLDS1),
> -		mercury_compile__maybe_dump_hlds(HLDS1, "34", "mark_static"),
> +		mercury_compile__maybe_dump_hlds(HLDS1, "35", "mark_static"),
>  
>  		maybe_write_string(Verbose,
>  			"% Hoisting loop invariants...\n"),
> Index: compiler/notes/compiler_design.html
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
> retrieving revision 1.81
> diff -u -d -r1.81 compiler_design.html
> --- compiler/notes/compiler_design.html	10 Jan 2003 10:45:02 -0000	1.81
> +++ compiler/notes/compiler_design.html	18 Feb 2003 00:50:15 -0000
> @@ -619,38 +619,30 @@
>  
>  <li> inlining (i.e. unfolding) of simple procedures (inlining.m)
>  
> -<li> deforestation and partial evaluation (deforest.m). This optimizes
> -  multiple traversals of data structures within a conjunction, and
> -  avoids creating intermediate data structures. It also performs
> -  loop unrolling where the clause used is known at compile time.
> -  deforest.m makes use of the following sub-modules
> -  (`pd_' stands for "partial deduction"):
> -  <ul>
> -  <li>
> -  constraint.m transforms goals so that goals which can fail
> -  are executed earlier.
> -  <li>
> -  pd_cost.m contains some predicates to estimate the improvement
> -  caused by deforest.m.
> -  <li>
> -  pd_debug.m produces debugging output.
> -  <li>
> -  pd_info.m contains a state type for deforestation.
> -  <li>
> -  pd_term.m contains predicates to check that the deforestation algorithm
> -  terminates.
> -  <li>
> -  pd_util.m contains various utility predicates.
> -  </ul>
> -
>  <li> loop_inv.m: loop invariant hoisting.  This transformation moves
>    computations within loops that are the same on every iteration to the outside
>    of the loop so that the invariant computations are only computed once.  The
>    transformation turns a single looping predicate containing invariant
>    computations into two: one that computes the invariants on the first
>    iteration and then loops by calling the second predicate with extra arguments
> -  for the invariant values.
> - 
> +  for the invariant values.  This pass should come after inlining, since
> +  inlining can expose important opportunities for loop invariant hoisting.
> +  Such opportunities might not be visible before inlining because only
> +  *part* of the body of a called procedure is loop-invariant.
> +
> +<li> deforestation and partial evaluation (deforest.m). This optimizes
> +  multiple traversals of data structures within a conjunction, and
> +  avoids creating intermediate data structures. It also performs
> +  loop unrolling where the clause used is known at compile time.
> +  deforest.m makes use of the following sub-modules (`pd_' stands for
> +  "partial deduction"): <ul> <li> constraint.m transforms goals so that
> +  goals which can fail are executed earlier.  <li> pd_cost.m contains
> +  some predicates to estimate the improvement caused by deforest.m.
> +  <li> pd_debug.m produces debugging output.  <li> pd_info.m contains
> +  a state type for deforestation.  <li> pd_term.m contains predicates
> +  to check that the deforestation algorithm terminates.  <li> pd_util.m
> +  contains various utility predicates.  </ul>
> +
>  <li> issue warnings about unused arguments from predicates, and create
>  specialized versions without them (unused_args.m); type_infos are often unused.
>  
> Index: library/string.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/string.m,v
> retrieving revision 1.193
> diff -u -d -r1.193 string.m
> --- library/string.m	13 Feb 2003 17:24:31 -0000	1.193
> +++ library/string.m	18 Feb 2003 01:55:01 -0000
> @@ -257,7 +257,7 @@
>  
>  :- func string__index_det(string, int) = char.
>  :- pred string__index_det(string, int, char).
> -:- mode string__index_det(in, in, out) is det.
> +:- mode string__index_det(in, in, uo) is det.
>  %	string__index_det(String, Index, Char):
>  %	`Char' is the (`Index' + 1)-th character of `String'.
>  %	Calls error/1 if `Index' is out of range (negative, or greater than or
> @@ -269,7 +269,7 @@
>  
>  :- func string__unsafe_index(string, int) = char.
>  :- pred string__unsafe_index(string, int, char).
> -:- mode string__unsafe_index(in, in, out) is det.
> +:- mode string__unsafe_index(in, in, uo) is det.
>  %	string__unsafe_index(String, Index, Char):
>  %	`Char' is the (`Index' + 1)-th character of `String'.
>  %	WARNING: behavior is UNDEFINED if `Index' is out of range
> @@ -693,8 +693,10 @@
>  	char__digit_to_int(Char, M),
>  	M < Base.
>  
> -
> -
> +% It's important to inline string__index and string__index_det.
> +% so that the compiler can do loop invariant hoisting
> +% on calls to string__length that occur in loops.
> +:- pragma inline(string__index_det/3).
>  string__index_det(String, Int, Char) :-
>  	( string__index(String, Int, Char0) ->
>  		Char = Char0
> @@ -3000,72 +3002,78 @@
>  		int::in, int::in) is semidet.
>  
>  string__contains_char(Str, Char, Index, Length) :-
> -	Index < Length,
> -	string__unsafe_index(Str, Index, IndexChar),
> -	( IndexChar = Char ->
> -		true
> +	( Index < Length ->
> +		string__unsafe_index(Str, Index, IndexChar),
> +		( IndexChar = Char ->
> +			true
> +		;
> +			string__contains_char(Str, Char, Index + 1, Length)
> +		)
>  	;
> -		string__contains_char(Str, Char, Index + 1, Length)
> +		fail
>  	).
>  
>  /*-----------------------------------------------------------------------*/
>  
> -/*
> -:- pred string__index(string, int, char).
> -:- mode string__index(in, in, out) is semidet.
> -*/
> -:- pragma foreign_proc("C", string__index(Str::in, Index::in, Ch::uo),
> -		[will_not_call_mercury, promise_pure, thread_safe], "
> -
> -                /*
> -		** We do not test for negative values of Index
> -                ** because (a) MR_Word is unsigned and hence a
> -                ** negative argument will appear as a very large
> -                ** positive one after the cast and (b) anybody
> -                ** dealing with the case where strlen(Str) > MAXINT
> -                ** is clearly barking mad (and one may well
> -                ** get an integer overflow error in this case).
> -                */
> +/* :- pred string__index(string, int, char). */
> +/* :- mode string__index(in, in, out) is semidet. */
> +% It's important to inline string__index and string__index_det.
> +% so that the compiler can do loop invariant hoisting
> +% on calls to string__length that occur in loops.
> +:- pragma inline(string__index/3).
> +string__index(Str, Index, Char) :-
> +	Len = string__length(Str),
> +	( string__index_check(Index, Len) ->
> +		string__unsafe_index(Str, Index, Char)
> +	;
> +		fail
> +	).
>  
> -	if ((MR_Unsigned) Index >= strlen(Str)) {
> -		SUCCESS_INDICATOR = MR_FALSE;
> -	} else {
> -		SUCCESS_INDICATOR = MR_TRUE;
> -		Ch = Str[Index];
> -	}
> +:- pred string__index_check(int, int).
> +:- mode string__index_check(in, in) is semidet.
> +:- pragma promise_pure(string__index_check/2).
> +/* We should consider making this routine a compiler built-in. */
> +:- pragma foreign_proc("C", string__index_check(Index::in, Length::in),
> +		[will_not_call_mercury, promise_pure, thread_safe],
> +"
> +	/*
> +	** We do not test for negative values of Index
> +	** because (a) MR_Unsigned is unsigned and hence a
> +	** negative argument will appear as a very large
> +	** positive one after the cast and (b) anybody
> +	** dealing with the case where strlen(Str) > MAXINT
> +	** is clearly barking mad (and one may well
> +	** get an integer overflow error in this case).
> +	*/
> +	SUCCESS_INDICATOR = ((MR_Unsigned) Index < (MR_Unsigned) Length);
>  ").
> -:- pragma foreign_proc("MC++", string__index(Str::in, Index::in, Ch::uo),
> +:- pragma foreign_proc("MC++", string__index_check(Index::in, Length::in),
>  		[will_not_call_mercury, promise_pure, thread_safe], "
> -	if (Index < 0 || Index >= Str->get_Length()) {
> -		SUCCESS_INDICATOR = MR_FALSE;
> -	} else {
> -		SUCCESS_INDICATOR = MR_TRUE;
> -		Ch = Str->get_Chars(Index);
> -	}
> +	SUCCESS_INDICATOR = ((MR_Unsigned) Index < (MR_Unsigned) Length);
>  ").
> -string__index(Str, Index, Char) :-
> -	string__first_char(Str, First, Rest),
> -	( Index = 0 ->
> -		Char = First
> -	;
> -		string__index(Rest, Index - 1, Char)
> -	).
> +string__index_check(Index, Length) :-
> +	Index >= 0,
> +	Index < Length.
>  
>  /*-----------------------------------------------------------------------*/
>  
>  :- pragma foreign_proc("C", 
> -	string__unsafe_index(Str::in, Index::in, Ch::out),
> +	string__unsafe_index(Str::in, Index::in, Ch::uo),
>  		[will_not_call_mercury, promise_pure, thread_safe], "
>  	Ch = Str[Index];
>  ").
>  :- pragma foreign_proc("MC++", 
> -	string__unsafe_index(Str::in, Index::in, Ch::out),
> +	string__unsafe_index(Str::in, Index::in, Ch::uo),
>  		[will_not_call_mercury, promise_pure, thread_safe], "
>  	Ch = Str->get_Chars(Index);
>  ").
>  string__unsafe_index(Str, Index, Char) :-
> -	( string__index(Str, Index, IndexChar) ->
> -		Char = IndexChar
> +	( string__first_char(Str, First, Rest) ->
> +		( Index = 0 ->
> +			Char = First
> +		;
> +			string__unsafe_index(Rest, Index - 1, Char)
> +		)
>  	;
>  		error("string__unsafe_index: out of bounds")
>  	).

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------