[Haskell-cafe] why do I need class context in declaring data constructor?

Simon Peyton-Jones simonpj at microsoft.com
Fri Aug 31 13:37:05 CEST 2012


Aha.  See http://hackage.haskell.org/trac/ghc/ticket/7205.

I don't think there's a workaround, I'm afraid

Simon

| -----Original Message-----
| From: haskell-cafe-bounces at haskell.org [mailto:haskell-cafe-
| bounces at haskell.org] On Behalf Of Paul Liu
| Sent: 30 August 2012 20:52
| To: Haskell Cafe
| Subject: [Haskell-cafe] why do I need class context in declaring data
| constructor?
| 
| I had a toy program that encodes simply typed lambda in types. It used
| to work fine with GHC prior to 7.2. But now it no longer compiles.
| Here is a minimal fragment that demonstrates this problem.
| 
| > {-# LANGUAGE GADTs,
| >     MultiParamTypeClasses,
| >     FlexibleInstances,
| >     FlexibleContexts #-}
| >
| > data Abs env t v where
| >   Abs :: g (a, env) h v -> Abs env (g (a, env) h v) (a -> v)
| >
| > class Eval g env t v where
| >   eval :: env -> g env t v -> v
| >
| > instance Eval g (a, env) h v =>
| >          Eval Abs env (g (a, env) h v) (a -> v) where
| >   eval env (Abs e) = \x -> eval (x, env) e
| 
| The type Abs has 3 parameters: its environment, sub term (encoded in
| types), and type. The constructor Abs has 1 parameter: its sub term.
| The code loads fine in GHC 7.0.3.
| 
| Here is the error reported by GHC 7.2.2 (and later):
| 
| test.lhs:14:30:
|     Could not deduce (Eval g1 (a1, env) h1 v1)
|       arising from a use of `eval'
|     from the context (Eval g (a, env) h v)
|       bound by the instance declaration at test.lhs:(12,12)-(13,49)
|     or from (g (a, env) h v ~ g1 (a1, env) h1 v1,
|              (a -> v) ~ (a1 -> v1))
|       bound by a pattern with constructor
|                  Abs :: forall env (g :: * -> * -> * -> *) a h v.
|                         g (a, env) h v -> Abs env (g (a, env) h v) (a ->
| v),
|                in an equation for `eval'
|       at test.lhs:14:15-19
|     Possible fix:
|       add (Eval g1 (a1, env) h1 v1) to the context of
|         the data constructor `Abs'
|         or the instance declaration
|       or add an instance declaration for (Eval g1 (a1, env) h1 v1)
|     In the expression: eval (x, env) e
|     In the expression: \ x -> eval (x, env) e
|     In an equation for `eval':
|         eval env (Abs e) = \ x -> eval (x, env) e
| 
| However, if I move the class context to the data constructor of
| definition, then it compiles fine in GHC 7.2.2 (and later):
| 
| > data Abs env t v where
| >   Abs :: Eval g (a, env) h v => g (a, env) h v -> Abs env (g (a, env)
| > h v) (a -> v)
| 
| But this is very troublesome because for every new class instance I want
| to make Abs of, I have to make a new class context to the data
| constructor. It totally defeats the purpose of making class instances to
| extend usage of data types.
| 
| Did I missed a language extension when moving code from GHC 7.0.3 to GHC
| 7.2.2? What can I do to fix it for newer GHCs?
| 
| --
| Regards,
| Paul Liu
| 
| _______________________________________________
| Haskell-Cafe mailing list
| Haskell-Cafe at haskell.org
| http://www.haskell.org/mailman/listinfo/haskell-cafe





More information about the Haskell-Cafe mailing list