Class ATs Question
Dave Menendez
dave at zednenem.com
Fri Apr 28 23:50:25 EDT 2006
Bulat Ziganshin writes:
> Friday, April 28, 2006, 5:09:07 AM, Ashely Yakeley wrote:
>
> > You can do two-way fundeps. Can these be done with associated types?
I'm not an expert, but I think the answer is "sort of".
For example,
class Key k where
data Map k a
empty :: Map k a
insert :: k -> a -> Map k a -> Map k a
lookup :: k -> Map k a -> Maybe a
There is a one-to-one relation between "k" and "Map k", but "Map k" is a
new, distinct type.
Your example would become something like
class HasSign u where
data Signed u
unsignedToSigned :: u -> Signed u
signedToUnsigned :: Signed u -> u
But you wouldn't be able to declare Signed Word8 = Int8.
Probably the right way to do it would be a pair of associated type
synonyms.
class HasSigned u where
type Signed u
unsignedToSigned :: u -> Signed u
class HasUnsigned s where
type Unsigned u
signedToUnsigned :: s -> Unsigned s
That gets you most of what you want, but I don't think there's a way to
set it up such that s1 == Signed (Unsigned s2) requires s1 == s2.
> > It might not be a great loss if not.
>
> may be you want to say "it might be a great loss" ?
>
> i'm using two-way fundeps to implement monad-independent algorithms
> that uses references. these definitions:
>
> class (Monad m) => Ref m r | m->r, r->m where
> newRef :: a -> m (r a)
> readRef :: r a -> m a
> writeRef :: r a -> a -> m ()
> instance Ref IO IORef where
> newRef = newIORef
> readRef = readIORef
> writeRef = writeIORef
> instance Ref (ST s) (STRef s) where
> newRef = newSTRef
> readRef = readSTRef
> writeRef = writeSTRef
>
> allows me to write algorithms that works in both monads
This is one of the motivating examples for associated types. You would
define Ref as,
class (Monad m) => Ref m where
data Ref m a
newRef :: a -> m (Ref m a)
readRef :: Ref m a -> m a
writeRef :: Ref m a -> a -> m ()
This declares a one-to-one relation between "m" and "Ref m". That is,
you are guaranteed that Ref (ST s1) == Ref (ST s2) iff s1 == s2.
That being said, I think you only need a single functional dependency
here, as in:
class (Monad m) => Ref m r | m -> r where
...
This allows you to promote Ref through monad transformers.
instance (Ref m r) => Ref (ReaderT m) r where
newRef = lift . newRef
readRef = lift . readRef
writeRef r = lift . writeRef r
This is also expressible using associated type synonyms.
class (Monad m) => Ref m where
type Ref m a
...
--
David Menendez <zednenem at psualum.com> | "In this house, we obey the laws
<http://www.eyrie.org/~zednenem> | of thermodynamics!"
More information about the Haskell-prime
mailing list