[m-rev.] for review: Fix abort in float_regs pass (bug #409).

[Peter Wang]

The float_regs pass did not consider this possibility: a term being
deconstructed can have a ground inst with no higher-order inst
information, but higher-order inst information is still available for
the sub-unifications of the term's arguments. This is possible with the
introduction of the "combined higher-order types and insts" feature.
Losing the higher-order inst information led to an exception:

    Unexpected: no higher order inst

compiler/float_regs.m:
    Handle the case above in unify_mode_set_rhs_final_inst.

    Minor improvements in comments.

tests/hard_coded/Mmakefile:
tests/hard_coded/functor_ho_inst_float_reg.exp:
tests/hard_coded/functor_ho_inst_float_reg.m:
    Add test case.
---
 compiler/float_regs.m                          | 34 +++++++++++++-----
 tests/hard_coded/Mmakefile                     |  1 +
 tests/hard_coded/functor_ho_inst_float_reg.exp |  2 ++
 tests/hard_coded/functor_ho_inst_float_reg.m   | 49 ++++++++++++++++++++++++++
 4 files changed, 77 insertions(+), 9 deletions(-)
 create mode 100644 tests/hard_coded/functor_ho_inst_float_reg.exp
 create mode 100644 tests/hard_coded/functor_ho_inst_float_reg.m

diff --git a/compiler/float_regs.m b/compiler/float_regs.m
index 00f316b3e..4f55da795 100644
--- a/compiler/float_regs.m
+++ b/compiler/float_regs.m
@@ -2,7 +2,7 @@
 % vim: ft=mercury ts=4 sw=4 et
 %---------------------------------------------------------------------------%
 % Copyright (C) 2012 The University of Melbourne.
-% Copyright (C) 2015 The Mercury team.
+% Copyright (C) 2015, 2018 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.
 %---------------------------------------------------------------------------%
@@ -38,7 +38,7 @@
 %       pred(in, out, out) is det /* arg regs: [reg_r, reg_r, reg_f] */
 %
 % indicates that the first and second arguments must be passed via regular
-% registers. The third argument must be passed via a float register.
+% registers, and the third argument must be passed via a float register.
 %
 %---------------------------------------------------------------------------%
 %
@@ -52,9 +52,10 @@
 %       get_q(Q),
 %       call(Q, 1.0, X).
 %
-% Q has type `pred(float, float)' and we would be misled to pass the float
-% arguments in the higher-order call via the float registers. The inst
-% contains the information to correct the higher-order call.
+% Q has type `pred(float, float)'. Without other information, we would
+% incorrectly assume that the call to Q should pass the float arguments in via
+% the float registers. Information about the required register class for each
+% call argument can be added to the higher-order inst.
 %
 %   :- pred get_q(pred(T, T)).
 %   :- mode get_q(out(pred(in, out) is det /* arg regs: [reg_r, reg_r] */))
@@ -67,6 +68,9 @@
 %       call(Q, 1.0, X).
 %       % arg regs: [reg_r, reg_r]
 %
+% The higher-order inst will force the call to Q to pass float arguments via
+% regular registers instead of float registers.
+%
 % EXAMPLE 2
 % ---------
 %
@@ -190,7 +194,7 @@ insert_reg_wrappers(!ModuleInfo, Specs) :-
     % In the second phase, go over every procedure goal, update instmap deltas
     % to include the information from pred_inst_infos. When a higher-order
     % variable has an inst that indicates it uses a different calling
-    % convention than is required in a given context, replace that variable
+    % convention from that required in a given context, replace that variable
     % with a wrapper closure which has the expected calling convention.
     list.foldl2(insert_reg_wrappers_pred, PredIds, !ModuleInfo, [], Specs),
     module_info_clobber_dependency_info(!ModuleInfo).
@@ -1037,9 +1041,21 @@ unify_mode_set_rhs_final_inst(ModuleInfo, ArgInst, UnifyMode0, UnifyMode) :-
         inst_is_free(ModuleInfo, RI),
         inst_is_bound(ModuleInfo, RF)
     then
-        UnifyMode = unify_modes_lhs_rhs(
-            from_to_insts(LI, LF),
-            from_to_insts(RI, ArgInst))
+        % Due to combined higher-order types and insts, RF may contain
+        % higher-order inst information that is not in ArgInst.
+        % In that case, do not lose the higher-order inst information.
+        % XXX We may need to generalise this once we have some other test
+        % cases.
+        ( if
+            ArgInst = ground(Uniq, none_or_default_func),
+            RF = ground(Uniq, higher_order(_))
+        then
+            UnifyMode = UnifyMode0
+        else
+            UnifyMode = unify_modes_lhs_rhs(
+                from_to_insts(LI, LF),
+                from_to_insts(RI, ArgInst))
+        )
     else
         UnifyMode = UnifyMode0
     ).
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 2de8b4f11..9779b9630 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -145,6 +145,7 @@ ORDINARY_PROGS =	\
 	functor_ho_inst_2 \
 	functor_ho_inst_excp \
 	functor_ho_inst_excp_2 \
+	functor_ho_inst_float_reg \
 	getopt_test \
 	ground_dd \
 	ground_terms \
diff --git a/tests/hard_coded/functor_ho_inst_float_reg.exp b/tests/hard_coded/functor_ho_inst_float_reg.exp
new file mode 100644
index 000000000..24458958c
--- /dev/null
+++ b/tests/hard_coded/functor_ho_inst_float_reg.exp
@@ -0,0 +1,2 @@
+3.141529
+3.141529
diff --git a/tests/hard_coded/functor_ho_inst_float_reg.m b/tests/hard_coded/functor_ho_inst_float_reg.m
new file mode 100644
index 000000000..ca788c662
--- /dev/null
+++ b/tests/hard_coded/functor_ho_inst_float_reg.m
@@ -0,0 +1,49 @@
+%---------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%---------------------------------------------------------------------------%
+%
+% Test a higher-order argument with an inst with the float_regs pass.
+%
+
+:- module functor_ho_inst_float_reg.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+:- type job_generic(T)
+    --->    job_generic(pred(T::out, io::di, io::uo) is det).
+
+:- type job_float
+    --->    job_float(pred(float::out, io::di, io::uo) is det).
+
+:- pred run_generic(job_generic(T)::in, io::di, io::uo) is det.
+
+run_generic(Job, !IO) :-
+    Job = job_generic(Pred),
+    Pred(Result, !IO),
+    io.write_line(Result, !IO).
+
+:- pred run_float(job_float::in, io::di, io::uo) is det.
+
+run_float(Job, !IO) :-
+    Job = job_float(Pred),
+    Pred(Result, !IO),
+    io.write_line(Result, !IO).
+
+:- pred j1(float::out, io::di, io::uo) is det.
+
+j1(3.141529, !IO).
+
+main(!IO) :-
+    JobsGeneric = [job_generic(j1)],
+    list.foldl(run_generic, JobsGeneric, !IO),
+
+    JobsFloat = [job_float(j1)],
+    list.foldl(run_float, JobsFloat, !IO).
+
-- 
2.16.2