[Haskell-cafe] Re: GHC 6.7 and Associated Types
Maxime Henrion
mux at FreeBSD.org
Tue Apr 17 08:27:13 EDT 2007
apfelmus wrote:
> Maxime Henrion wrote:
> > apfelmus wrote:
> >> Maxime Henrion wrote:
> >>> class MonadState m where
> >>> type StateType m :: *
> >>> get :: m StateType
> >>> put :: m StateType -> m ()
> >>>
> >>> As for instances:
> >>>
> >>> instance MonadState (State s) where
> >>> type StateType = s -- this is line 22
> >> When defining the type function StateType, you have to give it the
> >> required argument m = State s:
> >>
> >> type StateType (State s) = s
> >>
> >>> get = State $ \s -> (s, s)
> >>> put s = State $ \_ -> ((), s)
> >
> > I tried that too already, it gives:
> >
> > State.hs:19:39:
> > Kind mis-match
> > Expected kind `k -> *', but `()' has kind `*'
> > In the type `m ()'
> > In the type `m StateType -> m ()'
> > In the class declaration for `MonadState'
>
> Ah, oh, I didn't even check whether the types in the class are good. I'm
> not sure, but don't you want
>
> class MonadState m where
> type StateType m :: *
> get :: m (StateType m)
> put :: StateType m -> m ()
>
> ? Then, the substitutions m = State s and StateType (State s) = s yields
> the expected types for put and get:
>
> get :: (State s) s
> put :: s -> (State s) ()
Ah, I tried something like that too, and then I get errors in the
definition of the instance :
State.hs:23:19:
Couldn't match expected type `StateType (State s)'
against inferred type `s' (a rigid variable)
`s' is bound by the instance declaration at State.hs:21:27
Expected type: State s (StateType (State s))
Inferred type: State s s
In the expression: State $ (\ s -> (s, s))
In the definition of `get': get = State $ (\ s -> (s, s))
State.hs:24:19:
Couldn't match expected type `s' (a rigid variable)
against inferred type `StateType (State s)'
`s' is bound by the instance declaration at State.hs:21:27
Expected type: State s ()
Inferred type: State (StateType (State s)) ()
In the expression: State $ (\ _ -> ((), s))
In the definition of `put': put s = State $ (\ _ -> ((), s))
I would expect GHC to see that 'State s (StateType (State s))' is the
same as 'State s s', per the definition of StateType. I'm not sure how
to express get differently so that it matches, and similarly for put.
If I write:
get = State $ \s -> (StateType (State s), s)
I get:
State.hs:23:34: Not in scope: data constructor `StateType'
Thanks,
Maxime
More information about the Haskell-Cafe
mailing list