[m-rev.] diff: fix tail call optimisation bug in MLDS backend

[Julien Fischer]

Estimated hours taken: 8
Branches: main

Fix a bug reported by Michael Day.

compiler/ml_call_gen.m:
 	Do not introduce assignment statements that perform casts to (un)box
 	arguments of array types when the types of the LHS and RHS of such
 	assignments would be the same.  This avoids situations where
 	tail call optimisation cannot be applied to procedures with array
 	arguments because the introduced assignments are added after the
 	recursive call(s).

tests/hard_coded/.cvsignore:
tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/big_array_from_list.{m,exp}:
 	Test case for the above bug.

Julien.

Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.78
diff -u -r1.78 ml_call_gen.m
--- compiler/ml_call_gen.m	21 Aug 2007 15:50:39 -0000	1.78
+++ compiler/ml_call_gen.m	28 Aug 2007 17:43:21 -0000
@@ -779,7 +779,10 @@
          ;
              type_ctor_is_array(DestTypeCtor),
              DestTypeArgs = [type_variable(_, _)]
-        )
+        ),
+        % Don't insert redundant casts if the types are the same, since
+        % the extra assignments introduced can inhibit tail call optimisation.
+        SourceType \= DestType
      ->
          ml_gen_type(!.Info, DestType, MLDS_DestType),
          ArgRval = unop(cast(MLDS_DestType), VarRval)
Index: tests/hard_coded/.cvsignore
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/.cvsignore,v
retrieving revision 1.30
diff -u -r1.30 .cvsignore
--- tests/hard_coded/.cvsignore	20 Aug 2007 03:36:17 -0000	1.30
+++ tests/hard_coded/.cvsignore	28 Aug 2007 17:43:21 -0000
@@ -19,6 +19,7 @@
  address_of_builtins
  agg
  bidirectional
+big_array_from_list
  bigtest
  boyer
  c_write_string
Index: tests/hard_coded/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mercury.options,v
retrieving revision 1.27
diff -u -r1.27 Mercury.options
--- tests/hard_coded/Mercury.options	20 Aug 2007 03:36:17 -0000	1.27
+++ tests/hard_coded/Mercury.options	28 Aug 2007 17:43:21 -0000
@@ -2,6 +2,7 @@
  MCFLAGS-any_call_hoist_bug = --loop-invariants
  MCFLAGS-checked_nondet_tailcall	= --checked-nondet-tailcalls
  MCFLAGS-checked_nondet_tailcall_noinline = --checked-nondet-tailcalls --no-inlining
+MCFLAGS-big_array_from_list =   --optimize-tailcalls
  MCFLAGS-bigtest		=	--intermodule-optimization -O3
  MCFLAGS-cc_and_non_cc_test = 	--no-inlining
  MCFLAGS-constraint	=	--constraint-propagation --enable-termination
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.331
diff -u -r1.331 Mmakefile
--- tests/hard_coded/Mmakefile	24 Aug 2007 07:56:27 -0000	1.331
+++ tests/hard_coded/Mmakefile	28 Aug 2007 17:43:21 -0000
@@ -13,6 +13,7 @@
  	array_test \
  	backquoted_qualified_ops \
  	bag_various \
+	big_array_from_list \
  	bidirectional \
  	boyer \
  	brace \
Index: tests/hard_coded/big_array_from_list.exp
===================================================================
RCS file: tests/hard_coded/big_array_from_list.exp
diff -N tests/hard_coded/big_array_from_list.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/big_array_from_list.exp	28 Aug 2007 17:43:21 -0000
@@ -0,0 +1 @@
+NumElems = 600001
Index: tests/hard_coded/big_array_from_list.m
===================================================================
RCS file: tests/hard_coded/big_array_from_list.m
diff -N tests/hard_coded/big_array_from_list.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/big_array_from_list.m	28 Aug 2007 17:43:21 -0000
@@ -0,0 +1,51 @@
+% Test case for a bug in the MLDS backend in rotd-2007-08-28 and before.
+% The ml code generator was incorrectly inserting assignment statements to
+% do casts even when the types on the lhs and rhs were identical.  This
+% was inhibiting tail call optimisation in code that used arrays.
+% (The code marked XXX below is one such example.).
+%
+:- module big_array_from_list.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module array.
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+    List = 0 .. 600000,
+    array_from_list(List, Array),
+    NumElems = array.foldl(count, Array, 0),
+    io.format("NumElems = %d\n", [i(NumElems)], !IO).
+
+:- pred array_from_list(list(T), array(T)).
+:- mode array_from_list(in, array_uo) is det.
+
+array_from_list([], Array) :-
+    array.make_empty_array(Array).
+array_from_list(List, Array) :-
+    List = [Head | Tail],
+    list.length(List, Len),
+    array.init(Len, Head, Array0),
+    array_insert_items(Tail, 1, Array0, Array).
+
+% XXX Tail call optimisation was not being performed on this
+% predicate in hl* grades.
+:- pred array_insert_items(list(T)::in, int::in,
+    array(T)::array_di, array(T)::array_uo) is det.
+
+array_insert_items([], _N, Array, Array).
+array_insert_items([Head | Tail], N, Array0, Array) :-
+    array.set(Array0, N, Head, Array1),
+    N1 = N + 1,
+    array_insert_items(Tail, N1, Array1, Array).
+
+:- func count(int, int) = int.
+
+count(_, X) = X + 1.

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