Benjamin Franksen wrote:
I haven't read Daan's paper yet, but I think his translation is similar to the TIR (type indexed row)
part of the HList library...
Keean.
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
_______________________________________________
Haskell mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell
_______________________________________________ Haskell mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell
