A mutable tree. This appears to run more efficiently under Hugs, than
using a purely functional one, when performing lots of replace actions 
on a big tree. 
To do: test whether this is really true

\begin{code}
module TreeIO where
import IOExts
import Monad

type TreeIO a = IORef (TreeIO' a)
data TreeIO' a = TreeIO a [TreeIO a]

data SubTree a = SubTree a [SubTree a]
 deriving Show

test = do
 t <- initTreeIO st1
 toSubTree t >>= print
 (mk,dead,above) <- replaceInTree ((== 5) . fst) t
 maybe (print "dead") ($ st1) mk
 print (dead,above)
 toSubTree t >>= print

st1 = SubTree (1,"a") [SubTree (2,"b") [],SubTree (3,"c") [],SubTree (4,"d") [],SubTree (5,"e") []]

-- make a tree
initTreeIO :: SubTree a -> IO (TreeIO a)
initTreeIO (SubTree a cs) = do
 ts <- mapM initTreeIO cs
 newIORef $ TreeIO a ts

-- replace with the first element satisfying the boolean predicate with
-- the new subtree in the given tree. Return the new tree, and the list
-- of elements that were in the old removed subtree

replaceInTree :: (a -> Bool) -> TreeIO a 
              -> IO (Maybe (SubTree a -> IO ()),[a],[a])
replaceInTree (p :: a -> Bool)  tio = register tio []
  where
   register :: TreeIO a -> [a] 
            -> IO (Maybe (SubTree a -> IO ()),[a],[a])
   register tref abv = do
    (TreeIO a cs) <- readIORef tref 
    if p a then do
      as <- preorder tref
      return (Just $ \(SubTree a cs) -> do
			cs <- mapM initTreeIO cs
			writeIORef tref (TreeIO a cs),
	      as,abv)
     else 
      regList cs (a:abv)

   regList :: [TreeIO a] -> [a]
           -> IO (Maybe (SubTree a -> IO ()),
		  [a],[a])
   regList [] abv = return (Nothing,[],[])
   regList (t:ts) abv = do
     info@(ret,as,abv') <- register t abv
     case ret of
      Nothing -> regList ts abv
      Just op -> return info 

preorder :: TreeIO a -> IO [a]
preorder tref = do
 (TreeIO a cs) <- readIORef tref
 as <- mapM preorder cs
 return $ a:concat as

toSubTree :: TreeIO a -> IO (SubTree a)
toSubTree tref = do
 (TreeIO a cs) <- readIORef tref
 cs <- mapM toSubTree cs
 return $ SubTree a cs
\end{code}


replaceInTree :: (a -> Bool) -> SubTree a -> TreeIO a -> IO (TreeIO a,[a])
replaceInTree p (s :: SubTree a) tio = do
 st <- initTreeIO s
 fmap fst $ register st tio
  where
   register :: TreeIO a -> TreeIO a -> IO ((TreeIO a,[a]),Bool)
   register st t@(TreeIO a ref) = 
    if p a then do
      as <- preorder t
      return ((st,as),True)
    else do
      cs <- readIORef ref
      (ts,as,b) <- regList st [] cs
      when b $ writeIORef ref ts
      return ((t,as),b)
      
   regList :: TreeIO a -> [TreeIO a] -> [TreeIO a] -> IO ([TreeIO a],[a],Bool)
   regList st vs [] = return (reverse vs,[],False)
   regList st' vs (t:ts) = do
     ((st,as),b) <- register st' t
     if b then 
       return (reverse (st:vs) ++ ts,as,b)
      else
       regList st' (st:vs) ts 

{-

-}