On Jul 13, 2007, at 18:56 , Brandon S. Allbery KF8NH wrote:

...

return (isJust v)

*blush* Invert that, of course: isNothing v -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

On 7/14/07, Aaron Denney wrote:

It might be a bit clearer if every level of the tree were a flat map of pointers. You can even parametrize on this map type...

Yes, this would be an obvious generalization, though if I were to modify the details of the structure, I'd be inclined to go in exactly the opposite direction, and rather than have the keys be [Bit], use Bits b => .... and use an Int argument to recurse down the tree. The motivation for this structure is that I wanted a queue, from which I could remove elements from the middle efficiently, and using only local updates (for high concurrency). The structure I was replacing used a doubly linked list using TVars as pointers between nodes. As I hinted in the original post, this was ugly, and seem to be leaking memory (I actually think there might be some issues with the GHC implementation of TVars and GC - I'm not certain, but I think the leak *may* be a bug in GHC, and as I posted separately, GC was taking an awfully large proportion of the time). One way of achieving what I wanted was to keep a "timestamp" counter and use (Map TimeStamp k). The problem with Map is that it is hostile to concurrency - all modifications are "global" wrt the Map. The structure that is required in this instance is a structure with enough TVars linking the pieces that updates are local - a write to one TVar doesn't interact with reads in other parts of the structure. For example a binary tree with TVars between the nodes. Except a (vanilla) binary tree would be rotten in this case because the new keys arrive in strictly increasing order - a worst case for such a structure. So I could have modified Map, or my own home-rolled AVL tree to stick TVars between the nodes, there were reasons not to: 1. Tries are easy to implement and offer O(b) ~= O(1) for keys with b bits. Thanks to apfelmus for reminding me of this recently. 2. In Haskell, it's *fun* rolling new data structures to see how elegant you can be. (A favorite quote of mine is "Elegance is not Optional", I think due to Richard O'Keefe.) 3. This structure is used in an inner loop, so a structure giving O(1) operations was desirable. Anyway, the point of the original post was to find tricks for avoiding indentation creep, rather than the trie itself. cheers, T. -- Dr Thomas Conway drtomc@gmail.com Silence is the perfectest herald of joy: I were but little happy, if I could say how much.

Everyone's suggestions show that in order to advance to a level 3 Haskell Mage[*], I need to spend a chunk of time learning to grok monad transformers.

let's see whether we can get from the initial version to the suggested final version without any magic, in a somewhat long sequence of minor rewrites/refactorings. i won't list all intermediate stages (the derivation is long enough as it is), and i hope that readers will find this interesting in spite of its length (you might want to load the initial version into your editor and follow along as you read the refactoring notes below). enjoy (i hope:-), claus --------------------------------------------- initial version dmin p = do mv <- dmin' p case mv of Nothing -> error "dmin: no values" Just (v,_) -> return v dmin' p = do t <- readTVar p case t of Empty -> return Nothing Trie l m r -> do mv <- dmin' l case mv of Nothing -> do mv <- readTVar m case mv of Nothing -> do mv <- dmin' r case mv of Nothing -> error "emit nasal daemons" Just (v,e) -> do if e then writeTVar p Empty else return () return mv Just v -> do re <- nullT r case re of False -> writeTVar m Nothing True -> writeTVar p Empty return (Just (v,re)) Just (v,e) -> do case e of True -> do me <- empty m re <- nullT r case me && re of False -> writeTVar m Nothing True -> writeTVar p Empty return (Just (v,me && re)) False -> return mv where nullT :: Monad m => TriePtr t -> m Bool nullT t = undefined empty m = do v <- readTVar m case v of Nothing -> return True Just _ -> return False --------------------------------------------- initial version simple things first: in dmin: replace case with maybe use =<< to avoid intermediate mv replace lambda with (return . fst) in empty: replace case with maybe lift return out of the branches use =<< to avoid intermediate v 'maybe True (const False)' is (Data.Maybe) isNothing use liftM to apply isNothing in dmin': use (Control.Monad) 'when e .' to replace 'if e then . else return ()' create and use (2x) function 'write' write m p (v,False) = writeTVar m Nothing >> return (Just (v,False)) write m p (v,True ) = writeTVar p Empty >> return (Just (v,True)) now, on to slightly bigger rewrites: inside-out, replace 'case . of Nothing -> .; Just . -> .' with maybe case mv of Nothing -> error "emit nasal daemons" Just (v,e) -> do when e $ writeTVar p Empty return mv becomes maybe (error "emit nasal daemons") (\(v,e) -> do when e $ writeTVar p Empty return mv) mv and so on, for all three levels of case (in the outermost case, one 'return mv' needs to be replaced with 'return (Just (v,e))', we'll do the same for the other 'return mv', for clarity) at this stage, the code looks somewhat like this: dmin p = maybe (error "dmin: no values") (return . fst) =<< dmin' p dmin' p = do t <- readTVar p case t of Empty -> return Nothing Trie l m r -> do mv <- dmin' l maybe (do mv <- readTVar m maybe (do mv <- dmin' r maybe (error "emit nasal daemons") (\(v,e) -> do when e $ writeTVar p Empty return (Just (v,e))) mv) (\v -> do re <- nullT r write m p (v,re)) mv) (\(v,e) -> do case e of True -> do me <- empty m re <- nullT r write m p (v,me && re) False -> return (Just (v,e))) mv where write m p (v,False) = writeTVar m Nothing >> return (Just (v,False)) write m p (v,True ) = writeTVar p Empty >> return (Just (v,True)) nullT :: Monad m => TriePtr t -> m Bool nullT t = undefined empty m = liftM isNothing $ readTVar m we'd still like to get rid of the nesting, and we see the pattern action >>= maybe (nontrivialB) (nontrivialA) repeatedly, which strongly suggests the use of (MonadPlus) 'mplus' (action >>= nontrivialA) `mplus` nontrivialB the problem is that those Maybes are interleaved with STM operations. as a first step, we can define our own 'mplus' for the special case of 'STM (Maybe a)', where we want the alternatives to be controlled by the Maybe result of the outer monad (STM in this case): a `mplus` b = (a >>= maybe b (return . Just)) however, our pattern is slightly more complex: there's always another STM operation to be executed first (readTVar or dmin'), and the result of that operation selects the branch, so we also need to define our own version of sequential composition: a >>> b = a >>= maybe (return Nothing) b now, we can rewrite the pattern do { v<-op; maybe that this v } to, using our own combinator versions, (op >>> this) `mplus` that so that do mv <- dmin' r maybe (error "emit nasal daemons") (\(v,e) -> do when e $ writeTVar p Empty return (Just (v,e))) mv turns into (dmin' r >>> (\ (v,e) -> do when e $ writeTVar p Empty return (Just (v,e)))) `mplus` (error "emit nasal daemons") again, we apply this rewriting inside out to all three levels of maybe, which gives us something like this code: dmin' p = do t <- readTVar p case t of Empty -> return Nothing Trie l m r -> (dmin' l >>> (\(v,e) -> do case e of True -> do me <- empty m re <- nullT r write m p (v,me && re) False -> return (Just (v,e)))) `mplus` ((readTVar m >>> (\v -> do re <- nullT r write m p (v,re))) `mplus` ((dmin' r >>> (\ (v,e) -> do when e $ writeTVar p Empty return (Just (v,e)))) `mplus` (error "emit nasal daemons"))) where a `mplus` b = (a >>= maybe b (return . Just)) a >>> b = a >>= maybe (return Nothing) b write m p (v,False) = writeTVar m Nothing >> return (Just (v,False)) write m p (v,True ) = writeTVar p Empty >> return (Just (v,True)) nullT :: Monad m => TriePtr t -> m Bool nullT t = undefined empty m = liftM isNothing $ readTVar m which already gets rid of most of the indentation creep. next, we want to turn our local combinators into proper Monad/MonadPlus instances, to avoid confusion and to get back the do-notation. since both these classes are defined over type constructors, rather than plain types, we need a type constructor that captures the composition of STM and Maybe in 'STM (Maybe a)'. actually, our combinators only depend on the composition of some Monad m with Maybe: data MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) } the Monad instance is almost exactly what we expect, using the definition of >>> we already have, with some added wrapping and unwrapping for our "type constructor composition constructor" (aka monad transformer;-): instance Monad m => Monad (MaybeT m) where return = MaybeT . return . Just a >>= b = MaybeT $ runMaybeT a >>= maybe (return Nothing) (runMaybeT . b) the MonadPlus instance is just what we expect, using our mplus definition with some extra wrapping and unwrapping. instance Monad m => MonadPlus (MaybeT m) where mzero = MaybeT $ return Nothing a `mplus` b = MaybeT $ runMaybeT a >>= maybe (runMaybeT b) (return . Just) now, before we can apply our shiny new instances to our code, there is the issue of plain STM operations like writeTVar and readTVar. when running code in our composed monad, we still want to be able to run operations in the wrapped inner monad. the standard way to do that is to define a 'lift' operation for lifting inner monad operations to the composed monad. so standard, in fact, that there is a class for this, (Control.Monad.Trans) MonadTrans, and we only need to define an instance for our wrapper: instance MonadTrans MaybeT where lift m = MaybeT $ m >>= return . Just 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 could now declare the type as dmin' :: TVar (Trie t) -> MaybeT STM (Maybe t, Bool) to retain compatibility, we also need to apply runMaybeT in dmin, unwrapping (dmin' p). 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) >>= (\ v -> do re <- lift $ nullT r lift $ write m p (v,re))) `mplus` ((dmin' r >>= (\ (v,e) -> do when e $ lift $ writeTVar p Empty return (v,e))) `mplus` (error "emit nasal daemons"))) where write m p (v,False) = writeTVar m Nothing >> return (v,False) write m p (v,True ) = writeTVar p Empty >> return (v,True) nullT :: Monad m => TriePtr t -> m Bool nullT t = undefined empty m = liftM isNothing $ readTVar m to clean up, we reapply do-notation instead of >>=, drop some redundant parentheses for mplus, and move the lift calls to the definitions of empty, nullT, etc., creating lifted variants readTVar' and writeTVar'. 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 replace the remaining 'case e of True ..' by appealing to 'guard e' and mzero. at which stage our code looks sufficiently similar to Miguel's. we still don't need to have any idea what the code is supposed to do, as long as we haven't made any mistakes in refactoring, the final version should do the same thing as the initial version. usually, one would use a testsuite or a proven tool to monitor the steps, whereas my only test was "does it still compile?", which gives no assurance that the code transformations were indeed refactorings. no magic involved, just repeated simplifications, generalizations, and use of sufficiently advanced technology!-) by noticing that there was something about your code you didn't like, and looking for improvements, you've already done the most important step. as long as you remain determined to keep reviewing and simplifying your code, the route to "higher levels" isn't all that steep. part of the reason why i take part in such rewrite exercises on this list is to hone my own skills - there is always something more to learn;-) --------------------------------------------- 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 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

CR> let's see whether we can get from the initial version to the CR> suggested final version without any magic, in a somewhat long CR> sequence of minor rewrites/refactorings. Great! Thanks a lot, Claus. It's always interesting and enjoyable to see somebody explaining your own way of reasoning (well, not exactly, but the idea is the same). CR> next, we can make use of the fact that pattern match failure in CR> do-notation invokes fail in the monad, by defining 'fail msg = CR> mzero' My bad, I forgot about "fail". CR> whereas my only test was "does it still compile?", So was mine. CR> which gives no assurance that the code transformations were indeed CR> refactorings.