[Haskell-cafe] Indentation Creep

Claus Reinke claus.reinke at talk21.com
Mon Jul 16 06:39:49 EDT 2007


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



More information about the Haskell-Cafe mailing list