[m-rev.] for review: report an error for obviously redundant functional dependencies

[Julien Fischer]

For review by anyone.

Question for reviewers: should these be warnings rather than errors?

The reference manual also needs to be updated, but I will do that separately.

-----------------------------------

Report an error for obviously redundant functional dependencies.

Report an error where the same type variable occurs in both the domain and
range of a functional dependency (e.g. A -> A or A, B -> A). Such dependencies
are redundant, but they are probably not something the programmer intended to
write.

compiler/parse_class.m:
    Report an error where a functional dependency has the same type variable
    in both its domain and range.

tests/invalid_nodepend/Mmakefile:
tests/invalid_nodepend/self_fundep.{m,err_exp}:
    Add a test case for the above error message.

Julien.

diff --git a/compiler/parse_class.m b/compiler/parse_class.m
index 6162d2add..a31934700 100644
--- a/compiler/parse_class.m
+++ b/compiler/parse_class.m
@@ -1086,7 +1086,32 @@ parse_fundep(VarSet, Term, Result) :-
         MaybeDomain = ok1(Domain),
         MaybeRange = ok1(Range)
     then
-        Result = ok1(ac_fundep(prog_fundep(Domain, Range), Context))
+        ( if
+            list_to_set(Domain, DomainSet),
+            list_to_set(Range, RangeSet),
+            set.intersect(DomainSet, RangeSet, CommonTypeVarSet),
+            set.is_non_empty(CommonTypeVarSet)
+        then
+            varset.coerce(VarSet, TVarSet),
+            set.to_sorted_list(CommonTypeVarSet, CommonTypeVars),
+            CommonTypeVarPieces = list.map(var_to_quote_piece(TVarSet),
+                CommonTypeVars),
+            CommonTypeVarsPieces = piece_list_to_color_pieces(color_subject,
+                "and", [], CommonTypeVarPieces),
+            Pieces = [
+                words("Error: type"),
+                words(choose_number(CommonTypeVars, "variable", "variables"))
+            ] ++
+            CommonTypeVarsPieces ++
+            color_as_incorrect([
+                words(choose_number(CommonTypeVars, "occurs", "occur")),
+                words("in both the domain and range of a functional
dependency.")
+            ]),
+            Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
+            Result = error1([Spec])
+        else
+            Result = ok1(ac_fundep(prog_fundep(Domain, Range), Context))
+        )
     else
         Specs = get_any_errors1(MaybeDomain) ++ get_any_errors1(MaybeRange),
         Result = error1(Specs)
diff --git a/tests/invalid_nodepend/Mmakefile b/tests/invalid_nodepend/Mmakefile
index 87b872a6f..d4ecb08f2 100644
--- a/tests/invalid_nodepend/Mmakefile
+++ b/tests/invalid_nodepend/Mmakefile
@@ -76,6 +76,7 @@ PROGS = \
     require_tailrec_invalid \
     reserved \
     reserved_type_name \
+    self_fundep \
     specified \
     subtype_invalid_supertype \
     subtype_syntax \
diff --git a/tests/invalid_nodepend/self_fundep.err_exp
b/tests/invalid_nodepend/self_fundep.err_exp
new file mode 100644
index 000000000..08dcf362a
--- /dev/null
+++ b/tests/invalid_nodepend/self_fundep.err_exp
@@ -0,0 +1,10 @@
+self_fundep.m:013: Error: type variable  [38;5;87m`A' [39;49m
 [38;5;203moccurs in both the domain and range [39;49m
+self_fundep.m:013:    [38;5;203mof a functional dependency. [39;49m
+self_fundep.m:015: Error: type variable  [38;5;87m`A' [39;49m
 [38;5;203moccurs in both the domain and range [39;49m
+self_fundep.m:015:    [38;5;203mof a functional dependency. [39;49m
+self_fundep.m:017: Error: type variable  [38;5;87m`B' [39;49m
 [38;5;203moccurs in both the domain and range [39;49m
+self_fundep.m:017:    [38;5;203mof a functional dependency. [39;49m
+self_fundep.m:019: Error: type variables  [38;5;87m`A' [39;49m and
 [38;5;87m`B' [39;49m  [38;5;203moccur in both the domain [39;49m
+self_fundep.m:019:    [38;5;203mand range of a functional dependency. [39;49m
+self_fundep.m:021: Error: type variables  [38;5;87m`A', [39;49m
 [38;5;87m`B' [39;49m and  [38;5;87m`C' [39;49m  [38;5;203moccur in
both the [39;49m
+self_fundep.m:021:    [38;5;203mdomain and range of a functional
dependency. [39;49m
diff --git a/tests/invalid_nodepend/self_fundep.m
b/tests/invalid_nodepend/self_fundep.m
new file mode 100644
index 000000000..729360578
--- /dev/null
+++ b/tests/invalid_nodepend/self_fundep.m
@@ -0,0 +1,21 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Test that obviously redundant functional dependencies are reported as an
+% error.
+%---------------------------------------------------------------------------%
+
+:- module self_fundep.
+:- interface.
+
+:- type suppress_warnings ---> suppress_warnings.
+
+:- typeclass foo(A) <= (A -> A) where [].
+
+:- typeclass bar(A, B) <= (A -> A, B) where [].
+
+:- typeclass baaz(A, B) <= (A, B -> B) where [].
+
+:- typeclass quux(A, B) <= (A, B -> B, A) where [].
+
+:- typeclass thud(A, B, C) <= (A, B, C -> A, B, C) where [].