Why does pattern matching on this GADT seem to introduce ambiguity in the type checker?

Question

I'm trying to implement a form of Abstract Syntax Graphs, as described by Andres Loeh and Bruno C. d. S. Oliveira. For the most part, I seem to be understanding things correctly. However, when I try and introduce letrec into my syntax, I am having some problems. I think it's easier to work through this small code sample:

First, a little prelude:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
import Control.Applicative

infixr 8 :::
data TList :: (k -> *) -> [k] -> * where
  TNil :: TList f '[]
  (:::) :: f t -> TList f ts -> TList f (t ': ts)

tmap :: (forall a. f a -> g a) -> TList f as -> TList g as
tmap f (TNil) = TNil
tmap f (x ::: xs) = f x ::: tmap f xs

ttraverse :: Applicative i => (forall a. f a -> i (g a)) -> TList f xs -> i (TList g xs)
ttraverse f TNil = pure TNil
ttraverse f (x ::: xs) = (:::) <$> f x <*> ttraverse f xs

Now I can define the syntax for my language. In this case, I'm trying to describe two-dimensional levels in my video game. I have vertices (points in the plane) and walls (line segments between vertices).

data WallId
data VertexId

data LevelExpr :: (* -> *) -> * -> * where
  Let
    :: (TList f ts -> TList (LevelExpr f) ts)
    -> (TList f ts -> LevelExpr f t)
    -> LevelExpr f t

  Var :: f t -> LevelExpr f t

  Vertex :: (Float, Float) -> LevelExpr f VertexId

  Wall
    :: LevelExpr f VertexId
    -> LevelExpr f VertexId
    -> LevelExpr f WallId

Following PHOAS, we use a higher rank type to enforce parametricity over the choice of f:

newtype Level t = Level (forall f. LevelExpr f t)

Finally, let us introduce some syntactic sugar for letrec that automatically tags everything with Var, as suggested by the paper:

letrec :: (TList (LevelExpr f) ts -> TList (LevelExpr f) ts)
       -> (TList (LevelExpr f) ts -> LevelExpr f t)
       -> LevelExpr f t
letrec es e =
  Let (\xs -> es (tmap Var xs))
      (\xs -> e (tmap Var xs))

We can now write some programs in this language. Here's a simple expression introducing two vertices and defining a wall between them.

testExpr :: Level WallId
testExpr =
  Level (letrec (\ts ->
                   Vertex (0,0) :::
                   Vertex (10,10) :::
                   TNil)
                (\(v1 ::: v2 ::: _) ->
                   Wall v1 v2))

This works just fine. An equivalent expression would be to use letrec to define two vertices and the wall between them, all bound. In the body of letrec, we can just return the wall binding. We start by moving the wall into the letrec, and adding some holes to see what GHC knows:

testExprLetrec :: Level WallId
testExprLetrec =
  Level (letrec (\ts ->
                   Vertex (0,0) :::
                   Vertex (10,10) :::
                   Wall _ _ :::
                   TNil)
                _)

GHC informs us:

y-u-no-infer.hs:74:25:
    Found hole `_' with type: LevelExpr f VertexId
    Where: `f' is a rigid type variable bound by
               a type expected by the context: LevelExpr f WallId
               at y-u-no-infer.hs:71:3
    Relevant bindings include
      ts :: TList (LevelExpr f) '[VertexId, VertexId, WallId]
        (bound at y-u-no-infer.hs:71:19)
      testExprLetrec :: Level WallId (bound at y-u-no-infer.hs:70:1)
    In the first argument of `Wall', namely `_'
    In the first argument of `(:::)', namely `Wall _ _'
    In the second argument of `(:::)', namely `Wall _ _ ::: TNil'

Ok, good - GHC knows that ts contains two VertexIds and a WallId. We should be able to pattern match on ts to extract each of these expressions.

testExprLetrec2 :: Level WallId
testExprLetrec2 =
  Level (letrec (\ts@(v1 ::: v2 ::: _) ->
                   Vertex (0,0) :::
                   Vertex (10,10) :::
                   Wall v1 v2 :::
                   TNil)
                _)

When I try and type check this, I am presented with

y-u-no-infer.hs:109:20:
    Could not deduce (t ~ VertexId)
    from the context (ts0 ~ (t : ts))
      bound by a pattern with constructor
                 ::: :: forall (k :: BOX) (f :: k -> *) (t :: k) (ts :: [k]).
                        f t -> TList f ts -> TList f (t : ts),
               in a lambda abstraction
      at y-u-no-infer.hs:108:23-37
    or from (ts ~ (t1 : ts1))
      bound by a pattern with constructor
                 ::: :: forall (k :: BOX) (f :: k -> *) (t :: k) (ts :: [k]).
                        f t -> TList f ts -> TList f (t : ts),
               in a lambda abstraction
      at y-u-no-infer.hs:108:23-31
      `t' is a rigid type variable bound by
          a pattern with constructor
            ::: :: forall (k :: BOX) (f :: k -> *) (t :: k) (ts :: [k]).
                   f t -> TList f ts -> TList f (t : ts),
          in a lambda abstraction
          at y-u-no-infer.hs:108:23
    Expected type: TList (LevelExpr f) ts0
      Actual type: TList (LevelExpr f) '[VertexId, VertexId, WallId]
    Relevant bindings include
      v1 :: LevelExpr f t (bound at y-u-no-infer.hs:108:23)
    In the expression:
      Vertex (0, 0) ::: Vertex (10, 10) ::: Wall v1 v2 ::: TNil
    In the first argument of `letrec', namely
      `(\ ts@(v1 ::: v2 ::: _)
          -> Vertex (0, 0) ::: Vertex (10, 10) ::: Wall v1 v2 ::: TNil)'
    In the first argument of `Level', namely
      `(letrec
          (\ ts@(v1 ::: v2 ::: _)
             -> Vertex (0, 0) ::: Vertex (10, 10) ::: Wall v1 v2 ::: TNil)
          _)'

Why is GHC now expecting a TList (LevelExpr f) ts0, when it previously new that ts0 ~ '[VertexId, VertexId, WallId]?

Answer 1

Type inference doesn't work reliably with GADTs. You can fix the code by giving a simple type annotation:

testExprLetrec2 :: Level WallId
testExprLetrec2 =
  Level (letrec ((\ts@(v1 ::: v2 ::: _
                       :: TList (LevelExpr f) '[VertexId, VertexId, WallId]) ->
                   Vertex (0,0) :::
                   Vertex (10,10) :::
                   Wall _ _ :::
                   TNil)
                   )
                _)