Can I teach GHC mathematical induction?

Viewed 155

I attempted to create a datatype representing a tuple of infinitely many types:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

import GHC.TypeNats

infixr 5 :!!

data OmegaTuple (t :: Nat -> *) (n :: Nat) = t n :!! OmegaTuple t (n+1)

This is fine.

I also attempted to declare the direct product of infinitely many semigroups:

instance (Semigroup (t n), Semigroup (OmegaTuple t (n+1))) => Semigroup (OmegaTuple t n) where
    (x :!! xs) <> (y :!! ys) = x <> y :!! xs <> ys

Yet GHC complains like this:

• Illegal nested constraint ‘Semigroup (OmegaTuple t (n + 1))’
  (Use UndecidableInstances to permit this)

If I understood correctly, using UndecidableInstances will make GHC fall in an infinite loop.

Another attempt:

instance (Semigroup (t n), forall k. Semigroup (t k) => Semigroup (t (k+1))) => Semigroup (OmegaTuple t n) where
    (x :!! xs) <> (y :!! ys) = x <> y :!! xs <> ys

Then GHC complains like this:

• Illegal type synonym family application ‘k + 1’ in instance:
    Semigroup (t (k + 1))

Is it really impossible to teach GHC mathematical induction?

1 Answers

You can manually wrap the dictionaries, that allows lazily building up an “infinite class dictionary”:

{-# LANGUAGE GADTs     #-}
{-# LANGUAGE DataKinds #-}
 
import Data.Kind (Type)
import GHC.TypeLits

data SemigroupSequence (t :: Nat -> Type) (n :: Nat) where
  SemigroupSequence :: Semigroup (t n)
     => SemigroupSequence t (n+1) -> SemigroupSequence t n

class SemigroupFamily t where
  semigroupSequence :: SemigroupSequence t 0

and then

mappendOmega :: SemigroupSequence t n
     -> OmegaTuple t n -> OmegaTuple t n -> OmegaTuple t n
mappendOmega (SemigroupSequence sd') (x :!! xs) (y :!! ys)
   = x <> y :!! mappendOmega sd' xs ys

instance (SemigroupFamily t) => Semigroup (OmegaTuple t 0) where
  (<>) = mappendOmega semigroupSequence
Related