[Haskell] Proposal: Allow "\=" for field update in record update syntax

Benjamin Franksen benjamin.franksen at bessy.de
Thu Feb 24 06:54:40 EST 2005


On Thursday 24 February 2005 11:56, Keean Schupke wrote:
> Benjamin Franksen wrote:
> >You mentioned that higher-ranked types are not allowed in instance
> >declarations and that this limits the usefulness of your
> > translation. This is unfortunate and applies to my translation too.
> > From what I read elsewhere, I guess the standard workaround is to
> > wrap such types in a newtype. The problem is that this newtype
> > wrapping and unwrapping cannot be made transparent (at least I
> > don't see a way to do this).
> >
> >Keean, how do you solve this problem in your TH code?
>
> Can you think of an example where a higher ranked label would be
> useful? Lookups are normally done with values.

Dear Keean,

you should read more carefully what people write. Nowhere have I stated 
that I want higher-ranked *labels*. In fact, in my translation labels 
always have the value bottom.

My concern is with higher-ranked record fields. Stupid example:

 data R = R {
  f :: (forall a. a -> a)
 }

My translation doesn't work in this case, because the compiler doesn't 
accept

 instance RecordField R Label_f (forall a. a->a) where
  ...

> Here's an example of a higher ranked type used as a non-label which
> works fine:
>
> ---------------------------------------------------------------------
>----------------------- --{-# OPTIONS -fglasgow-exts #-}
>
> module Main where
>
> class Test a b | a -> b where
>         test :: a -> b -> Bool
>
> newtype I = I (forall a . Integral a => a)
> newtype S = S (forall a . Show a => a)
>
> instance Test Int I where
>         test _ _ = True
>
> instance Test String S where
>         test _ _ = False
>
> main = do
>         putStrLn $ show $ test (1::Int) (I undefined)
>         putStrLn $ show $ test ("a"::String) (S undefined)
>
> ---------------------------------------------------------------------
>-----------
>
> Which shows that even though you cannot use higher ranked types as
> labels, you can use them in other fields... Effectively they cannot
> be on the LHS of a functional dependancy (for obvious reasons if you
> think about it).

Yes, you can wrap higher-ranked types into a newtype and then you can 
define instances for them.

Again, that is what I already wrote in my previous message. With the 
above stupid example:

 newtype Wrap_f = Wrap_f (forall a. a->a)

 unWrap_f (Wrap_f x) = x

However, the result of 

 getField Label_f

now has type Wrap_f and not (forall a. a->a). To really get the field, I 
have to unwrap the newtype constructor manually:

 get_f :: R -> (forall a. a->a)
 get_f = unWrap_f . getField Label_f

This means that a translation as proposed by Daan (i.e. without 
first-class labels) is feasible even with higher-ranked field types, 
but not my version.

Ben


More information about the Haskell mailing list