Hugs extension in GHC ?

Ed Komp komp@ittc.ku.edu
Sun, 16 Mar 2003 11:09:44 -0600


Is there a way to express the following Hugs (Gofer) Haskell extension in GHC?

>From the Hugs User's Manual, "Section 7.3.5  Restricted type synonyms"

>> Hugs supports the use of restricted type synonyms, first introduced
>> in Gofer, and similar to the mechanisms for defining abstract
>> datatypes that were provided in several earlier languages. The purpose
>> of a restricted type synonym is to restrict the expansion of a type
>> synonym to a particular set of functions. Outside of the selected
>> group of functions, the synonym constructor behaves like a standard
>> datatype. More precisely, a restricted type synonym definition is a
>> top level declaration of the form:
>>  > type T a1 ... am = rhs in f1, ..., fn
>> where T is a new type constructor name and rhs is a type expression
>> typically involving some of the (distinct) type variables a1, ...,
>> am. The major difference with a normal type synonym definition is that
>> the expansion of the type synonym can only be used within the binding
>> group of one of the functions f1, ..., fn (all of which must be
>> defined by top-level definitions in the module containing the
>> restricted type synonym definition). In the definition of any other
>> value, T is treated as if it had been introduced by a definition of
>> the form:
>>  >  data T a1 ... am = ...

For my intended application, this last line,
the type synonym is treated as if it had been introduced with "data"
is of key importance.

Here are some code snippets, taken from the paper 
"Using catamorphisms, subtypes and monad transformers for writing 
modular functional interpretors" by Luc Duponcheel (Nov. 1995)
further explain what I to express:

>> data Sum x y = L x | R y
>> 
>> type E x = Sum (E1 x) (E2 x)  in fmapE, phiE
>> 
>> fmapE :: (x -> y) -> (E x -> E y)
>> fmapE g = (L . fmap1 g) <+> (R . fmap2 g)
>> 
>> phiE :: E Int -> Int
>> phiE = phi1 <+> phi2
>> 
>> data Rec1 f = In (f (Rec1 f))
>> 
>> type Expr  = Rec1 E
>> 
>> instance Functor E  where 
>>    fmap = fmapE

Trying to compile this with GHC (after removing the "in fmapE, phiE"),
generates the (expected) error:

>>     Type synonym `E' should have 1 argument, but has been given 0
>>     In the type: Rec1 E
>>     While checking the RHS of a type synonym declaration `Expr'

 for the line:  type Expr  = Rec1 E

and, if I replace that line with:  type Expr x  = Rec1 E x
I get the following error message:

>>     Couldn't match `*' against `k -> k1'
>> 	Expected kind: *
>> 	Inferred kind: k -> k1
>>     When checking kinds in `Rec1 E x'
>>     In the type synonym declaration for `Expr'

and, more problems are anticipated for:

>> instance Functor E  where 
>>    fmap = fmapE

Thanks in advance for all help,

Ed Komp
komp@ittc.ku.edu