EMGM: deriving instances

Hello, This is listed as the mailing list for EMGM on its website: http://www.cs.uu.nl/wiki/GenericProgramming/EMGM I'm not sure if I'm using the template Haskell deriving properly for EMGM instances - I doesn't work for me for: + Data declarations which contain type synonyms + Data declarations which contain a Bool I get errors like:
Exception when trying to run compile-time code: Error! Unsupported constant type: Bool Code: EMGM.derive 'A <<<<<
I get a similar error if my data type uses a 'String' instead of a Bool, but the error for the String goes away if I use [Char] instead. Is this expected behavior? If I'm just running into the limits of what EMGM template-Haskell deriving can do, that's okay. I just didn't see these limitations described anywhere. Thanks, Antoine --- I'm using GHC 6.10, with emgm-0.2 from hackage. Here's the sample program I'm working with:
{-# LANGUAGE TemplateHaskell , MultiParamTypeClasses , FlexibleContexts , FlexibleInstances , OverlappingInstances , UndecidableInstances #-}
import qualified Generics.EMGM as EMGM data MyData a = MkMyData { name :: [Char] -- , flag :: Bool -- , otherName :: String , fa :: A a , fb :: B a } data A a = MkA Int Bool a data B a = MkB Char a $(EMGM.derive ''MyData) $(EMGM.derive ''A) $(EMGM.derive ''B) <<<<<

Hi Antoine, This is listed as the mailing list for EMGM on its website:
You came to the right place. Thanks for trying out EMGM! I'm not sure if I'm using the template Haskell deriving properly for
EMGM instances - I doesn't work for me for:
+ Data declarations which contain type synonyms + Data declarations which contain a Bool
You are using it correctly, but there are some limitations in the current implementation. I get errors like:
Exception when trying to run compile-time code: Error! Unsupported constant type: Bool Code: EMGM.derive 'A <<<<<
This error comes from these lines in Generics.EMGM.Common.Derive.Instance: 104> -- Given a name for a constant type and the rep option, get an appropriate 105> -- expression name. 106> conTypeExpName :: Name -> RepOpt -> Name 107> conTypeExpName typeName = 108> case nameBase typeName of 109> "Int" -> rintN 110> "Integer" -> rintegerN 111> "Float" -> rfloatN 112> "Double" -> rdoubleN 113> "Char" -> rcharN 114> n -> error $ "Error! Unsupported constant type: " ++ n EMGM's Template Haskell deriving doesn't currently handle a non-"primitive" type contained in functor types such as all of your types. Right now, types such as your A can only contain the above-listed primitives or other functor types (e.g. B, Maybe, or []). I get a similar error if my data type uses a 'String' instead of a
Bool, but the error for the String goes away if I use [Char] instead.
Yes, it doesn't resolve type synonyms. It works with [Char], because [] is a functor type (kind * -> *) and Char is a primitive constant type.
Is this expected behavior? If I'm just running into the limits of what EMGM template-Haskell deriving can do, that's okay. I just didn't see these limitations described anywhere.
Unfortunately, it is expected behavior. I was afraid somebody would run into this; I just didn't know how long it would take. ;) I'm using GHC 6.10, with emgm-0.2 from hackage.
Here's the sample program I'm working with:
{-# LANGUAGE TemplateHaskell , MultiParamTypeClasses , FlexibleContexts , FlexibleInstances , OverlappingInstances , UndecidableInstances #-}
import qualified Generics.EMGM as EMGM
data MyData a = MkMyData { name :: [Char] -- , flag :: Bool -- , otherName :: String , fa :: A a , fb :: B a }
data A a = MkA Int Bool a
data B a = MkB Char a
$(EMGM.derive ''MyData) $(EMGM.derive ''A) $(EMGM.derive ''B) <<<<<
So, from what you say, your problem is with String and Bool? If you want immediate satisfaction and you're only using functions based on Rep (i.e. not FRep, FRep2, etc.), then you can change your deriving code to this:
import Generics.EMGM.Common.Derive
$(declareConDescrs ''A) $(declareEP ''A) $(deriveRep ''A)
$(declareConDescrs ''B) $(declareEP ''B) $(deriveRep ''B)
$(declareConDescrs ''MyData) $(declareEP ''MyData) $(deriveRep ''MyData)
"deriveRep" doesn't care whether a type is primitive or not. It does the same thing for every type, notably use the "rep" method as type representation. Otherwise, you'll have to wait on a fix. ;) The problem with functor/bifunctor type representation is not just with the deriving part. It deals with the more fundamental problem of, for example, representing a functor type using the "Generic2" class that contains non-functor types normally be represented using the "Generic" class. I think I can fix EMGM to handle this and other cases where you're using either type synonyms or representations from the EMGM library. Let me see what I can do today or tomorrow, and I'll push out an update. Thanks for letting us know that you encountered this problem. It motivates me to improve things. ;) Regards, Sean

On Thu, Feb 19, 2009 at 2:26 AM, Sean Leather
So, from what you say, your problem is with String and Bool?
If you want immediate satisfaction and you're only using functions based on Rep (i.e. not FRep, FRep2, etc.), then you can change your deriving code to this:
import Generics.EMGM.Common.Derive
$(declareConDescrs ''A) $(declareEP ''A) $(deriveRep ''A)
$(declareConDescrs ''B) $(declareEP ''B) $(deriveRep ''B)
$(declareConDescrs ''MyData) $(declareEP ''MyData) $(deriveRep ''MyData)
"deriveRep" doesn't care whether a type is primitive or not. It does the same thing for every type, notably use the "rep" method as type representation.
Otherwise, you'll have to wait on a fix. ;)
Sadly I was hoping to use the EMGM 'map' function on a more complex type. From what I can tell that uses the FRep instances, correct? Thanks for the quick response. Antoine
participants (2)
-
Antoine Latter
-
Sean Leather