Benjamin Franksen wrote:
On Sunday 20 February 2005 10:16, Daan Leijen wrote:Can you think of an example where a higher ranked label would be useful?
Benjamin Franksen wrote:
This library class defines the operations on a record:
class RecordField r l t | r l -> t where
getField :: l -> r -> t
putField :: l -> t -> r -> r
I have once written a short note about how Haskell'98 records could be made more useful using a conservative extensions. The suggested implementation method corresponds quite closely to what you sketch here. Here is the url:
<http://www.cs.uu.nl/~daan/download/papers/records.pdf>
It should be interesting to read about the different tradeoffs of
extending the current record system, but keep in mind that this is a
just a quick writeup of ideas (and written two years ago!)
Yes, quite interesting, indeed.
"My" sketch (I don't claim any originality) differs from yours mostly in that mine has one additional argument, namely the label type, which results in labels becoming first class values. I really like first class record labels!
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?
Ben
_______________________________________________
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell
Lookups are normally done with values. Firstly a type variable must have a kind. So for a type variable of kind '*' the only possible family of higher ranked types are:
(forall a . Contraint a => a)
We certainly could use a newtype to represent this, but what would it mean in the context of a label?
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).
Keean.
_______________________________________________ Haskell mailing list Haskell@haskell.org http://www.haskell.org/mailman/listinfo/haskell