as Thomas pointed out off-list, the transformation sequence as given
is not type-preserving. i even documented that problem in my email,
because i thought the type was dodgy, but forgot to track it down
before posting. so here are the changes. a good demonstration that
"does it still compile?" is not a sufficient test for refactoring!-)
claus
to prepare for our next step, we apply lift to all barebones STM
operations, readTVar, write, empty, nullT. at this stage, our types
(asking ghci, with :t dmin') are slightly redundant:
dmin' :: (MonadTrans t1, Monad (t1 STM))
=> TVar (Trie t) -> t1 STM (Maybe (t, Bool))
since our particular MonadTrans, MaybeT, already wraps results in
Maybe, this is one level of Maybe too much. so, when we remove our
local definitions of mplus and >>> (replacing >>> with >>=), we remove
that extra layer of Maybe, by removing the redundant (Just _) in
returns, and by replacing 'return Nothing' with 'mzero'.
we also need to take into account that the second readTVar already
returns a Maybe, so we only need to wrap it in MaybeT, without
applying the full lift.
we could now declare the type as
dmin' :: TVar (Trie t) -> MaybeT STM (Maybe t, Bool)
there's that dodgy type. it should just be:
dmin' :: TVar (Trie t) -> MaybeT STM (t, Bool)
after all that refactoring, the code should look something like this:
dmin p = maybe (error "dmin: no values") (return . fst)
=<< runMaybeT (dmin' p)
dmin' p = do
t <- lift $ readTVar p
case t of
Empty -> mzero
Trie l m r ->
(dmin' l >>=
(\ (v,e) -> do
case e of
True -> do
me <- lift $ empty m
re <- lift $ nullT r
lift $ write m p (v,me && re)
False -> return (v,e)))
`mplus` (((lift $ readTVar m) >>=
it was the return-wrapping of lift that introduced the extra Maybe
here. this TVar already holds Maybes, so this should just be:
`mplus` (((MaybeT $ readTVar m) >>=
next, we can make use of the fact that pattern match failure in
do-notation invokes fail in the monad, by defining 'fail msg = mzero'
in our wrapped monad, and by pattern matching directly on the result
of the first readTVar' (we only need the Trie-case, the other case
will fail to match, leading to mzero, which is what we wanted anyway).
we can also use this feature to replace the "half-lifted" second
readTVar with a fully lifted readTVar' followed by a pattern match
on 'Just v'.
--------------------------------------------- final version
dmin p = maybe (error "dmin: no values") (return . fst)
=<< runMaybeT (dmin' p)
dmin' p = do
Trie l m r <- readTVar' p
(do (v,e) <- dmin' l
(do guard e
me <- empty m
re <- nullT r
write m p (v,me && re))
`mplus` return ((v,e)))
`mplus` (do v <- readTVar' m
by employing pattern-match failure handling, this can become:
`mplus` (do Just v <- readTVar' m
re <- nullT r
write m p (v,re))
`mplus` (do (v,e) <- dmin' r
when e $ writeTVar' p Empty
return ((v,e)))
`mplus` error "emit nasal daemons"
where
readTVar' var = lift $ readTVar var
writeTVar' var val = lift $ writeTVar var val
write m p (v,False) = lift $ writeTVar m Nothing >> return ((v,False))
write m p (v,True ) = lift $ writeTVar p Empty >> return ((v,True))
nullT :: Monad m => TriePtr t -> m Bool
nullT t = undefined
empty m = lift $ liftM isNothing $ readTVar m
data MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
instance Monad m => Monad (MaybeT m) where
return = MaybeT . return . Just
a >>= b = MaybeT $ runMaybeT a >>= maybe (return Nothing) (runMaybeT . b)
fail msg= mzero
instance Monad m => MonadPlus (MaybeT m) where
mzero = MaybeT $ return Nothing
a `mplus` b = MaybeT $ runMaybeT a >>= maybe (runMaybeT b) (return . Just)
instance MonadTrans MaybeT where
lift m = MaybeT $ m >>= return . Just
--------------------------------------------- final version
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
