[m-rev.] for review: fix bug #90

[Peter Wang]

Branches: main

Fix bug #90.  The compiler would abort on the given program when performing
higher order/type specialisation due to "inconsistent type_infos".

compiler/higher_order.m:
        In interpret_typeclass_info_manipulator, when assigning to a variable
        TypeInfoVar the extracted field of a type_info TypeInfoArg, duplicate
        the TypeInfoArg rtti_var_info for TypeInfoVar.

        On the test program the rtti_var_info for TypeInfoVar already existed
        but was for the procedure *before* specialisation, which is what
        lead to the inconsistent type_infos message.

compiler/hlds_rtti.m:
        Add version of rtti_var_info_duplicate which doesn't abort if the
        rtti_varmap already has an entry for the target variable.

tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/tci_spec_varmap.m:
        Add test case.

diff --git a/compiler/higher_order.m b/compiler/higher_order.m
index 68b7f86..d391f6a 100644
--- a/compiler/higher_order.m
+++ b/compiler/higher_order.m
@@ -2031,7 +2031,15 @@
interpret_typeclass_info_manipulator(Manipulator, Args, Goal0, Goal,
!Info) :-
         Uni = assign(TypeInfoVar, TypeInfoArg),
         Goal = unify(TypeInfoVar, rhs_var(TypeInfoArg), out_mode - in_mode,
             Uni, unify_context(umc_explicit, [])),
-        !:Info = !.Info ^ hoi_changed := ho_changed
+
+        ProcInfo0 = !.Info ^ hoi_proc_info,
+        proc_info_get_rtti_varmaps(ProcInfo0, RttiVarMaps0),
+        rtti_var_info_duplicate_replace(TypeInfoArg, TypeInfoVar,
+            RttiVarMaps0, RttiVarMaps),
+        proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo0, ProcInfo),
+        !Info ^ hoi_proc_info := ProcInfo,
+
+        !Info ^ hoi_changed := ho_changed
     ;
         Goal = Goal0
     ).
diff --git a/compiler/hlds_rtti.m b/compiler/hlds_rtti.m
index f36c8c0..02163c2 100644
--- a/compiler/hlds_rtti.m
+++ b/compiler/hlds_rtti.m
@@ -249,6 +249,14 @@
 :- pred rtti_var_info_duplicate(prog_var::in, prog_var::in,
     rtti_varmaps::in, rtti_varmaps::out) is det.

+    % rtti_var_info_duplicate_replace(Var, NewVar, !RttiVarMaps)
+    %
+    % Duplicate the rtti_var_info we have about Var for NewVar.
+    % Replace old information about Var which already exists.
+    %
+:- pred rtti_var_info_duplicate_replace(prog_var::in, prog_var::in,
+    rtti_varmaps::in, rtti_varmaps::out) is det.
+
     % Returns all of the tvars that we have information about in the
     % rtti_varmaps structure.
     %
@@ -524,6 +532,18 @@ rtti_var_info_duplicate(Var, NewVar, !VarMaps) :-
         VarInfo = non_rtti_var
     ).

+rtti_var_info_duplicate_replace(Var, NewVar, !VarMaps) :-
+    rtti_varmaps_var_info(!.VarMaps, Var, VarInfo),
+    (
+        VarInfo = type_info_var(Type),
+        rtti_set_type_info_type(NewVar, Type, !VarMaps)
+    ;
+        VarInfo = typeclass_info_var(Constraint),
+        rtti_set_typeclass_info_var(Constraint, NewVar, !VarMaps)
+    ;
+        VarInfo = non_rtti_var
+    ).
+
 rtti_varmaps_tvars(VarMaps, TVars) :-
     map.keys(VarMaps ^ ti_varmap, TVars).

diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index b7770f9..0fe580b 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -125,6 +125,7 @@ MCFLAGS-solv			= --halt-at-warn
 MCFLAGS-spurious_purity_warning	= --halt-at-warn
 MCFLAGS-stack_opt_simplify	= --optimize-saved-vars
 MCFLAGS-table_no_attr           = --structure-sharing
+MCFLAGS-tci_spec_varmap         = --deforestation --type-specialisation
 MCFLAGS-time_yaowl		= --allow-stubs
 MCFLAGS-tuple_eqv               = --smart-recompilation
 MCFLAGS-two_way_unif		= -O-1
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index 73838a3..76ea6ad 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -41,6 +41,7 @@ TYPECLASS_PROGS= \
 	superclass_bug \
 	superclass_improvement \
 	tc_map_lookup \
+	tci_spec_varmap \
 	time_yaowl \
 	typeclass_constraint_arity \
 	typeclass_constraint_no_var \
diff --git a/tests/valid/tci_spec_varmap.m b/tests/valid/tci_spec_varmap.m
new file mode 100644
index 0000000..fb34e3f
--- /dev/null
+++ b/tests/valid/tci_spec_varmap.m
@@ -0,0 +1,48 @@
+%-----------------------------------------------------------------------------%
+% Regression test.
+%
+% Software Error: hlds_rtti.m: Unexpected: inconsistent type_infos:
+% Type: type_variable(var(1), kind_star)
+% ExistingType: defined_type(qualified(unqualified("profdeep_rtti_varmap"),
+% "checked_out_task"), [type_variable(var(1), kind_star)], kind_star)
+%
+% The problem had to do with a missing rtti varmap entry after a type_info
+% was extracted from a typeclass_info.
+%-----------------------------------------------------------------------------%
+
+:- module tci_spec_varmap.
+:- interface.
+
+:- import_module io.
+
+:- pred something(T::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list.
+
+something(_, !IO) :-
+    _ = marking([] : list(checked_out_task(T))).
+
+:- type checked_out_task(T)
+	--->	checked_out_task.
+
+:- type marking
+    --->    mark.
+
+:- typeclass marking(T) where [
+    func marking(T) = marking
+].
+
+:- instance marking(list(T)) <= marking(T) where [
+    (marking([]) = mark),
+    (marking([_ | Cs]) = marking(Cs))
+].
+
+:- instance marking(checked_out_task(T)) where [
+    marking(checked_out_task) = mark
+].
+
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------