Fix a bug with nested fundep instances

Previously, when one type would contain an instance of a class and it used that contained instance's instance to supply its own instance of the class, then it would fail to compile.

The issue was that define-instance removes the class constraints before
checking the types of the instance methods. Normally that's not a problem because they're entailed. But fundep-entail% checks for structural similarity, not entailment. To fix it, fundep-entail now skips fundep-entail% for any predicate that was entailed by the environment.

The tests pass, and the commit includes a regression test that failed with the fix removed and passes now.

Author: Jason Walker

src/typechecker/context-reduction.lisp

@@ -31,7 +31,6 @@
 ;; Context reduction
 ;;
 
-
 (defun true (x)
   (if x
       t
@@ -294,7 +293,10 @@ the type variables of the class D.
           :with preds      := (expand preds)
           :with subs       := nil
           :for pred :in preds
-          :for new-subs := (fundep-entail% env expr-preds pred known-tyvars)
+          :for new-subs :=
+            (if (entail env expr-preds pred)
+                '()
+                (fundep-entail% env expr-preds pred known-tyvars))
           :do (setf subs (compose-substitution-lists subs new-subs))
           :finally (return subs))))
 

tests/fundep-tests.lisp

@@ -258,3 +258,31 @@
     (declare foo (MonadChain :h :h => :h String))
     (define foo
       bar)"))
+
+(deftest fundep-nested-fundep-instances ()
+  ;; See https://github.com/coalton-lang/coalton/pull/1743
+  (check-coalton-types
+   "
+  (define-class (FundepClass :a :b (:a -> :b))
+    (use-a (:a -> Unit)))
+
+  (define-type (BaseType :a :b)
+    (BaseType :a))
+
+  (declare unwrap% (BaseType :a :b -> :a))
+  (define (unwrap% (BaseType val))
+    val)
+
+  (define-instance (FundepClass :a :b => FundepClass (BaseType :a :b) (List :b))
+    (inline)
+    (define (use-a grouped)
+      (use-a (unwrap% grouped))))
+
+  (define-struct (WrapperType :a)
+    (inner-base-type (BaseType :a Unit)))
+
+  (define-instance (FundepClass (BaseType :a Unit) (List Unit)
+                    => FundepClass (WrapperType :a) Unit)
+    (inline)
+    (define (use-a wrapper)
+      (use-a (.inner-base-type wrapper))))"))