You might find it helpful to read our new paper: Type checking with open type functions  http://research.microsoft.com/%7Esimonpj/papers/assoc-types/index.htm

               

 

From: haskell-cafe-bounces@haskell.org [mailto:haskell-cafe-bounces@haskell.org] On Behalf Of Hugo Pacheco
Sent: 07 April 2008 22:47
To: Haskell Cafe
Subject: [Haskell-cafe] Re: Type Families: infinite compile process?

 

The problem is that the representation probably does not reduce to a normal form.

 

Say, for the case

 

type instance F (Nest a) x = Either() (a,F a x)

 

fnn :: F (Nest a) (Nest a)

fnn = Left ()

 

it compiles ok.

 

But why can't the representation be infinite, like any other infinite data type?

Cheers,

hugo

 

 

On Mon, Apr 7, 2008 at 10:30 PM, Hugo Pacheco <hpacheco@gmail.com> wrote:

Hi guys,

 

I have been experimenting some weird stuff (risky, yes I know) but the behaviour was certainly not the one I expected:

 

{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}

 

module Nest where

 

data Nest a = Nil | Cons a (Nest (a,a))

 

type family F a x :: *

type instance F (Nest a) x = Either () (a,F (Nest (a,a)) x)

 

fnn :: F (Nest Int) (Nest Int)

fnn = Left ()

 

The following module fails to compile (or better, compilation never ends).

 

Maybe there is something very bad going on due to the undecidable-instances extension?

 

Any clue?

hugo