[m-rev.] for review: fix missed tail call optimisations in java grade

[Peter Wang]

Branches: main

Fix a problem in MLDS grades using --det-copy-out (java, il) where dummy
arguments in predicates would prevent tail calls being marked as such.

Also make a few predicates tail recursive.

compiler/ml_code_gen.m:
        With the --det-copy-out option, don't list dummy output variables as
        copy out variables.  This led to `return' statements containing dummy
        output variables, but a call prior to a `return' statement wouldn't
        have dummy outputs, so ml_tailcall.m wouldn't recognise the call as a
        tail call.

compiler/mlds_to_java.m:
        Delete a hack that drops dummy variables in return statements.

compiler/mercury_compile.m:
        Make backend_pass_by_preds_2 tail recursive.  Otherwise a compiler
        built in the java grade runs out of stack space compiling some
        larger modules.

library/bag.m:
        Make tail recursion more obvious in a few predicates.

diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m
index 99f5ed5..a5f603a 100644
--- a/compiler/mercury_compile.m
+++ b/compiler/mercury_compile.m
@@ -2930,17 +2930,19 @@ backend_pass_by_preds(!HLDS, !GlobalData, LLDS, !IO) :-
         MaybeDupProcMap = yes(map.init)
     ),
     backend_pass_by_preds_2(OrderedPredIds, !HLDS, !GlobalData,
-        MaybeDupProcMap, LLDS, !IO).
+        MaybeDupProcMap, [], RevCodes, !IO),
+    list.reverse(RevCodes, Codes),
+    list.condense(Codes, LLDS).

 :- pred backend_pass_by_preds_2(list(pred_id)::in,
     module_info::in, module_info::out, global_data::in, global_data::out,
-    maybe(map(mdbcomp.prim_data.proc_label,
-        mdbcomp.prim_data.proc_label))::in,
-    list(c_procedure)::out, io::di, io::uo) is det.
+    maybe(map(mdbcomp.prim_data.proc_label, mdbcomp.prim_data.proc_label))::in,
+    list(list(c_procedure))::in, list(list(c_procedure))::out, io::di, io::uo)
+    is det.

-backend_pass_by_preds_2([], !HLDS, !GlobalData, _, [], !IO).
+backend_pass_by_preds_2([], !HLDS, !GlobalData, _, !RevCodes, !IO).
 backend_pass_by_preds_2([PredId | PredIds], !HLDS,
-        !GlobalData, !.MaybeDupProcMap, Code, !IO) :-
+        !GlobalData, !.MaybeDupProcMap, !RevCodes, !IO) :-
     module_info_preds(!.HLDS, PredTable),
     map.lookup(PredTable, PredId, PredInfo),
     ProcIds = pred_info_non_imported_procids(PredInfo),
@@ -2995,9 +2997,9 @@ backend_pass_by_preds_2([PredId | PredIds], !HLDS,
             !:MaybeDupProcMap = yes(DupProcMap)
         )
     ),
+    !:RevCodes = [ProcList | !.RevCodes],
     backend_pass_by_preds_2(PredIds, !HLDS, !GlobalData, !.MaybeDupProcMap,
-        TailPredsCode, !IO),
-    list.append(ProcList, TailPredsCode, Code).
+        !RevCodes, !IO).

 :- pred backend_pass_by_preds_3(list(proc_id)::in, pred_id::in, pred_info::in,
     module_info::in, module_info::out, global_data::in, global_data::out,
diff --git a/compiler/ml_code_gen.m b/compiler/ml_code_gen.m
index dd57ad4..801349a 100644
--- a/compiler/ml_code_gen.m
+++ b/compiler/ml_code_gen.m
@@ -1442,11 +1442,13 @@ ml_det_copy_out_vars(ModuleInfo,
CopiedOutputVars, !Info) :-
     module_info_get_globals(ModuleInfo, Globals),
     globals.lookup_bool_option(Globals, det_copy_out, DetCopyOut),
     (
-        % If --det-copy-out is enabled, all output variables are returned
-        % by value, rather than passing them by reference.
+        % If --det-copy-out is enabled, all non-dummy output variables are
+        % returned by value, rather than passing them by reference.
         DetCopyOut = yes,
         ByRefOutputVars = [],
-        CopiedOutputVars = OutputVars
+        ml_gen_info_get_var_types(!.Info, VarTypes),
+        list.filter(var_is_of_dummy_type(ModuleInfo, VarTypes), OutputVars,
+            _, CopiedOutputVars)
     ;
         DetCopyOut = no,
         (
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 0d39cdb..b7857de 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -2706,20 +2706,8 @@ output_stmt(Indent, ModuleInfo, CallerFuncInfo,
Call, Context, ExitMethods,
     io.write_string("}\n", !IO),
     ExitMethods = set.make_singleton_set(can_fall_through).

-output_stmt(Indent, ModuleInfo, FuncInfo, ml_stmt_return(Results0), _,
+output_stmt(Indent, ModuleInfo, FuncInfo, ml_stmt_return(Results), _,
         ExitMethods, !IO) :-
-    %
-    % XXX It's not right to just remove the dummy variables like this, but
-    % currently they do not seem to be included in the ReturnTypes of
-    % func_params by the MLDS, so the easiest thing to do here is just remove
-    % them.
-    %
-    % When this is resolved, the right way to handle it would be to check for
-    % `dummy_var' in the `var' clause for output_lval, and output a reference
-    % to a static variable `dummy_var' defined in a fixed class (e.g. some
-    % class in the mercury/java directory, or mercury.private_builtin).
-    %
-    Results = remove_dummy_vars(ModuleInfo, Results0),
     (
         Results = [],
         indent_line(Indent, !IO),
@@ -2861,22 +2849,6 @@ output_boxed_args(ModuleInfo, [CallArg | CallArgs],
         output_boxed_args(ModuleInfo, CallArgs, CallArgTypes, ModuleName, !IO)
     ).

-:- func remove_dummy_vars(module_info, list(mlds_rval)) = list(mlds_rval).
-
-remove_dummy_vars(_, []) = [].
-remove_dummy_vars(ModuleInfo, [Var | Vars0]) = VarList :-
-    Vars = remove_dummy_vars(ModuleInfo, Vars0),
-    (
-        Var = ml_lval(Lval),
-        Lval = ml_var(_VarName, VarType),
-        VarType = mercury_type(ProgDataType, _, _),
-        check_dummy_type(ModuleInfo, ProgDataType) = is_dummy_type
-    ->
-        VarList = Vars
-    ;
-        VarList = [Var | Vars]
-    ).
-
 %-----------------------------------------------------------------------------%
 %
 % Code for handling multiple return values.
diff --git a/library/bag.m b/library/bag.m
index 226462d..0d8a752 100644
--- a/library/bag.m
+++ b/library/bag.m
@@ -420,7 +420,7 @@ bag.count_value(bag(Bag), Item, Count) :-

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

-bag.subtract(bag(Bag0), bag(SubBag), bag(Bag)) :-
+bag.subtract(bag(Bag0), bag(SubBag), Bag) :-
     ( map.remove_smallest(SubBag, SubKey, SubVal, SubBag0) ->
         ( map.search(Bag0, SubKey, Val) ->
             NewVal = Val - SubVal,
@@ -432,12 +432,12 @@ bag.subtract(bag(Bag0), bag(SubBag), bag(Bag)) :-
         ;
             Bag1 = Bag0
         ),
-        bag.subtract(bag(Bag1), bag(SubBag0), bag(Bag))
+        bag.subtract(bag(Bag1), bag(SubBag0), Bag)
     ;
-        Bag = Bag0
+        Bag = bag(Bag0)
     ).

-bag.union(bag(A), bag(B), bag(Out)) :-
+bag.union(bag(A), bag(B), Out) :-
     ( map.remove_smallest(B, Key, BVal, B0) ->
         ( map.search(A, Key, AVal) ->
             NewVal = AVal + BVal,
@@ -445,9 +445,9 @@ bag.union(bag(A), bag(B), bag(Out)) :-
         ;
             map.det_insert(A, Key, BVal, A0)
         ),
-        bag.union(bag(A0), bag(B0), bag(Out))
+        bag.union(bag(A0), bag(B0), Out)
     ;
-        Out = A
+        Out = bag(A)
     ).

 bag.intersect(A, B, Out) :-
@@ -457,7 +457,7 @@ bag.intersect(A, B, Out) :-
 :- pred bag.intersect_2(bag(T)::in, bag(T)::in, bag(T)::in, bag(T)::out)
     is det.

-bag.intersect_2(bag(A), bag(B), bag(Out0), bag(Out)) :-
+bag.intersect_2(bag(A), bag(B), bag(Out0), Out) :-
     ( map.remove_smallest(A, Key, AVal,A0) ->
         ( map.search(B, Key, BVal) ->
             int.min(AVal, BVal, Val),
@@ -465,9 +465,9 @@ bag.intersect_2(bag(A), bag(B), bag(Out0), bag(Out)) :-
         ;
             Out1 = Out0
         ),
-        bag.intersect_2(bag(A0), bag(B), bag(Out1), bag(Out))
+        bag.intersect_2(bag(A0), bag(B), bag(Out1), Out)
     ;
-        Out = Out0
+        Out = bag(Out0)
     ).

 bag.intersect(bag(A), bag(B)) :-
@@ -478,7 +478,7 @@ bag.intersect(bag(A), bag(B)) :-
         bag.intersect(bag(A0), bag(B))
     ).

-bag.least_upper_bound(bag(A), bag(B), bag(Out)) :-
+bag.least_upper_bound(bag(A), bag(B), Out) :-
     ( map.remove_smallest(B, Key, BVal, B0) ->
         ( map.search(A, Key, AVal) ->
             int.max(AVal, BVal, NewVal),
@@ -486,9 +486,9 @@ bag.least_upper_bound(bag(A), bag(B), bag(Out)) :-
         ;
             map.det_insert(A, Key, BVal, A0)
         ),
-        bag.least_upper_bound(bag(A0), bag(B0), bag(Out))
+        bag.least_upper_bound(bag(A0), bag(B0), Out)
     ;
-        Out = A
+        Out = bag(A)
     ).

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