[Haskell-cafe] Implementation of "Dynamic" datatype
Lennart Augustsson
lennart at augustsson.net
Sat Mar 3 16:03:31 EST 2007
I have no idea what function you are talking about. I must be
missing your point.
Here's a version of Dynamic that seem to compile and work fine.
{-# OPTIONS_GHC -fglasgow-exts #-}
module Dyn(Dynamic, toDyn, fromDyn) where
import GHC.Base(unsafeCoerce#)
import Data.Typeable
data Dynamic = forall a . Dynamic TypeRep a
toDyn :: (Typeable a) => a -> Dynamic
toDyn v = Dynamic (typeOf v) v
fromDyn :: (Typeable a) => Dynamic -> a -> a
fromDyn (Dynamic t v) def
| typeOf def == t = unsafeCoerce# v
| otherwise = def
And here is another one
{-# OPTIONS_GHC -fglasgow-exts #-}
module Dyn1(Dynamic, toDyn, fromDyn) where
import GHC.Base(unsafeCoerce#)
import Data.Typeable
data Dynamic = forall a . (Typeable a) => Dynamic a
toDyn :: (Typeable a) => a -> Dynamic
toDyn v = Dynamic v
fromDyn :: (Typeable a) => Dynamic -> a -> a
fromDyn (Dynamic v) def
| typeOf def == typeOf v = unsafeCoerce# v
| otherwise = def
-- Lennart
On Mar 3, 2007, at 09:29 , Stefan O'Rear wrote:
> On Sat, Mar 03, 2007 at 09:18:00AM +0000, Lennart Augustsson wrote:
>> Why would there be an extra function?
>>
>> The type
>> data Dynamic = forall a . Dynamic TypeRep a
>> is simply a pair. And so is
>> data Dynamic = forall a . (Typeable a) => Dynamic a
>> I think the latter is the most natural representation for Dynamic.
>>
>> -- Lennart
>>
>> On Mar 2, 2007, at 23:55 , Stefan O'Rear wrote:
>>
>>> the current type:
>>>
>>> data Dynamic = Dynamic TypeRep Obj
>>>
>>> the new type, if lucky:
>>>
>>> data Dynamic = Dynamic !(a -> TypeRep) a
>>>
>>> if unlucky:
>>>
>>> data TypeableD a = TypeableD (a -> TypeRep)
>>> data Dynamic = Dynamic (TypeableD a) a
>>>
>>> either way, the typeclass approach gives a lot more boxing.
>
> Because the compiler can't statically prove that the typeRep field of
> the dictionary doesn't depend on its argument. Therefore, the
> function cannot be unpacked. (Or can it? Could hbc?)
>
> Stefan
More information about the Haskell-Cafe
mailing list