[Haskell] Proposal: Allow "\=" for field update in record update
syntax
Keean Schupke
k.schupke at imperial.ac.uk
Thu Feb 24 05:56:53 EST 2005
Benjamin Franksen wrote:
>On Sunday 20 February 2005 10:16, Daan Leijen wrote:
>
>
>>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 at haskell.org
>http://www.haskell.org/mailman/listinfo/haskell
>
>
Can you think of an example where a higher ranked label would be useful?
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.
More information about the Haskell
mailing list