[m-rev.] for review: Disallow closures with partially instantiated direct arg arguments.

[Peter Wang]

We previously discovered a problem with the direct_arg_in_out.m pass.
When a closure is constructed from a procedure that would be cloned and
transformed, the clone procedure gains additional arguments but the type
and inst of the closure variable would still match the arguments of the
original procedure. This led to an abort in the float registers pass.

I looked into fixing the inconsistencies but it would involve far too
much work for such a rare case; see the discussion on mercury-reviews
starting from Message-ID: <20210125172531.GH1330 at lucy.localdomain>

compiler/direct_arg_in_out.m:
    Abort if we would construct a closure from a daio-cloned procedure.

tests/hard_coded/gh72.exp:
tests/hard_coded/gh72.m:
    Delete higher order tests.

diff --git a/compiler/direct_arg_in_out.m b/compiler/direct_arg_in_out.m
index a5ea1dd2c..04d16c61a 100644
--- a/compiler/direct_arg_in_out.m
+++ b/compiler/direct_arg_in_out.m
@@ -1,7 +1,7 @@
 %---------------------------------------------------------------------------%
 % vim: ft=mercury ts=4 sw=4 et
 %---------------------------------------------------------------------------%
-% Copyright (C) 2020 The Mercury team.
+% Copyright (C) 2020-2021 The Mercury team.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %---------------------------------------------------------------------------%
@@ -142,13 +142,8 @@
 % (using the same predicate, find_and_record_any_direct_arg_in_out_posns)
 % on the procedures it creates.
 %
-% This optimization is one reason why mercury_compile_middle_passes.m invokes
-% this module after the lambda expansion transformation. Another reason is that
-% it allows us to transform higher order calls the same way as we do plain
-% calls, provided we transform every reference to a daio procedure in
-% unifications that create closures to the clone of that daio procedure.
-% (The arguments that we put inside closures cannot be daio arguments,
-% since such arguments must be ground.)
+% This optimization is why mercury_compile_middle_passes.m invokes
+% this module after the lambda expansion transformation.
 %
 %---------------------------------------------------------------------------%
 
@@ -1196,33 +1191,25 @@ expand_daio_in_goal(Goal0, Goal, InstMap0, !VarMap, !Info) :-
                 GoalExpr0, GoalExpr)
         )
     ;
-        GoalExpr0 = unify(LHSVar, RHS0, UnifyMode, Unification0, UnifyContext),
+        GoalExpr0 = unify(_, _, _, Unification, _),
         ( if
-            Unification0 = construct(_, ConsId0, _, _, _, _, _),
-            ConsId0 = closure_cons(ShroudedPredProcId0, EvalMethod),
-            ClosurePredProcId0 = unshroud_pred_proc_id(ShroudedPredProcId0),
+            Unification = construct(_, ConsId, _, _, _, _, _),
+            ConsId = closure_cons(ShroudedPredProcId, _EvalMethod),
+            ClosurePredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
             ProcMap = !.Info ^ daio_proc_map,
-            map.search(ProcMap, ClosurePredProcId0, CloneProc)
+            map.contains(ProcMap, ClosurePredProcId)
         then
-            CloneProc = direct_arg_proc_in_out(ClonePredProcId, _OoMInOutArgs),
-            ShroudedPredProcId = shroud_pred_proc_id(ClonePredProcId),
-            ConsId = closure_cons(ShroudedPredProcId, EvalMethod),
-            Unification = Unification0 ^ construct_cons_id := ConsId,
-            (
-                RHS0 = rhs_functor(RHSConsId0, MaybeExistConstr0, ArgVars0),
-                expect(unify(RHSConsId0, ConsId0), $pred,
-                    "closure construct cons_id mismatch"),
-                expect(unify(MaybeExistConstr0, is_not_exist_constr), $pred,
-                    "closure construct is_exist_constr"),
-                RHS = rhs_functor(ConsId, MaybeExistConstr0, ArgVars0)
-            ;
-                ( RHS0 = rhs_var(_)
-                ; RHS0 = rhs_lambda_goal(_, _, _, _, _, _, _, _, _)
-                ),
-                unexpected($pred, "closure construct is not rhs_functor")
-            ),
-            GoalExpr1 = unify(LHSVar, RHS, UnifyMode, Unification,
-                UnifyContext)
+            % We did allow a closure to be constructed from a clone procedure,
+            % but that leaves the HLDS in an inconsistent state, e.g. the type
+            % and inst of the closure variable needs to be updated for the
+            % extra arguments, and it gets a lot more complicated than that.
+            % While the float registers pass is the only part of the compiler
+            % known to break on the inconsistency, that may only be due to the
+            % the rarity of higher order terms with daio arguments. Leaving the
+            % HLDS in an inconsistent state is a bad idea anyway.
+            sorry($pred,
+                "cannot construct closure with partially-instantiated " ++
+                "direct_arg arguments")
         else
             GoalExpr1 = GoalExpr0
         ),
diff --git a/tests/hard_coded/gh72.exp b/tests/hard_coded/gh72.exp
index 57fc2ed06..eaca19db8 100644
--- a/tests/hard_coded/gh72.exp
+++ b/tests/hard_coded/gh72.exp
@@ -81,24 +81,6 @@ ite_test_init(13, f2)
 ite_test_init(13, f3)
 end
 
-higher order test A abc
-f1(package(fill1, abc))
-f2(package(testA2, testA2))
-f3(package(testA3, testA3))
-f4(package(testA4, testA4))
-
-higher order test B xyz
-f1(package(fill1, xyz))
-f2(package(testB2, testB2))
-f3(package(testB3, testB3))
-f4(package(testB4, testB4))
-
-higher order test C 42
-f1(package(fill1, 42))
-f2(package(testC2, testC2))
-f3(package(testC3, testC3))
-f4(package(testC4, testC4))
-
 method test string
 p1 f1(package(fill1, hij))
 p2 f2(package(test2, test2))
diff --git a/tests/hard_coded/gh72.m b/tests/hard_coded/gh72.m
index 6906cb6b2..0329070ee 100644
--- a/tests/hard_coded/gh72.m
+++ b/tests/hard_coded/gh72.m
@@ -37,8 +37,6 @@ main(!IO) :-
     ite_test_init(12, !IO), 
     ite_test_init(13, !IO), 
 
-    higher_order_tests("abc", "xyz", "42", !IO),
-
     method_tests("string", "hij", !IO),
     method_tests("int", 53, !IO).
 
@@ -288,42 +286,6 @@ ite_init(N, T, StrA ++ " | " ++ StrB) :-
 
 %-----------------------------------------------------------------------------%
 
-:- pred higher_order_tests(string::in, string::in, string::in,
-    io::di, io::uo) is det.
-
-higher_order_tests(StrA, StrB, StrC, !IO) :-
-    ClosureA = fill1(StrA),
-    ClosureB = fill1(StrB),
-    ClosureC = fill1(StrC),
-
-    io.format("\nhigher order test A %s\n", [s(StrA)], !IO),
-    higher_order_test(ClosureA, f1(_), !IO),
-    higher_order_test(ClosureA, f2(package("testA2", "testA2")), !IO),
-    higher_order_test(ClosureA, f3(package("testA3", "testA3")), !IO),
-    higher_order_test(ClosureA, f4(package("testA4", "testA4")), !IO),
-
-    io.format("\nhigher order test B %s\n", [s(StrB)], !IO),
-    higher_order_test(ClosureB, f1(_), !IO),
-    higher_order_test(ClosureB, f2(package("testB2", "testB2")), !IO),
-    higher_order_test(ClosureB, f3(package("testB3", "testB3")), !IO),
-    higher_order_test(ClosureB, f4(package("testB4", "testB4")), !IO),
-
-    io.format("\nhigher order test C %s\n", [s(StrC)], !IO),
-    higher_order_test(ClosureC, f1(_), !IO),
-    higher_order_test(ClosureC, f2(package("testC2", "testC2")), !IO),
-    higher_order_test(ClosureC, f3(package("testC3", "testC3")), !IO),
-    higher_order_test(ClosureC, f4(package("testC4", "testC4")), !IO).
-
-:- pred higher_order_test((pred(t)), t, io, io).
-:- mode higher_order_test((pred(t234 >> ground) is det), t234 >> ground,
-    di, uo) is det.
-
-higher_order_test(Closure, T, !IO) :-
-    Closure(T),
-    io.write_string(dump_t_nl(T), !IO).
-
-%-----------------------------------------------------------------------------%
-
 :- pred method_tests(string::in, S::in, io::di, io::uo) is det <= fxc(S).
 
 method_tests(Msg, S, !IO) :-
-- 
2.30.0