my MutableList module (If anybody cares)

Jay Cox
Fri, 08 Jun 2001 14:44:32 -0500

This is a multi-part message in MIME format.
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Attached is my first attempt at a library containing functions for  the
construction and modification of "imperative lists".  Such can allow for
the replacement of nodes, appending, truncation, etc in constant time.
(of course, all this is done through the IO or ST monad).  Basically,
anything you could do with lists in C (without modifying the actual node
values) you can do with these lists.  

I'm not sure if this would be useful to anybody, (indeed I thought the
idea of functional programming was to get away from this stuff!) but I
would like some input as to the design of this module or other comments
before I continue developing it.  Could a refined version of this module
(perhaps with more abstraction, name changes, and name hiding) be
beneficial to the development of haskell? (Perhaps in the very least
does anybody think it as a tutorial for a non-trivial use of IORef or

Thanks for your reply,

Jay Cox
Content-Type: text/plain; charset=us-ascii;
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;

module MutList where

import IOExts
import ST

data S m a = Nil | Cons a (m (S m a))

class Monad m => MyRef m f where
  newRef        :: a -> m (f a)
  readRef       :: f a -> m a
  writeRef      :: f a -> a -> m ()
--  modifyRef     :: f a -> (a -> a) -> m ()

instance MyRef IO IORef where
  newRef = newIORef
  readRef = readIORef
  writeRef = writeIORef
--  modifyRef = modifyIORef

instance MyRef (ST s) (STRef s) where
  newRef = newSTRef
  readRef = readSTRef
  writeRef = writeSTRef
--modifyRef = modifySTRef

mkempty :: MyRef m myref => m (myref (S myref a))
mkempty = newRef Nil
push ref val = newRef (Cons val ref);
mpush ref val = do x<-readRef ref
                   y<-newRef x
                   writeRef ref (Cons val y)
pop ref = do x <- readRef ref
             case x of
               (Cons _ ls) -> return ls
               _ -> error "empty list"
mpop ref = do  x<-pop ref;
               y<-readRef x
               writeRef ref y
top ref = do x <- readRef ref
             case x of
               (Cons value _) -> return value
               _ -> error "empty list"
safepop ref = do x <- readRef ref
                 case x of
                   (Cons _ ls) -> return (Just ls)
                   _ -> return Nothing
safempop ref = do  x<-safepop ref
                   y<-result x
                   writeRef ref y
    where result Nothing = return Nil
          result (Just ls) = readRef ls
safetop ref = do x <- readRef ref
                 case x of
                   (Cons value _) -> return (Just value)
                   _ ->  return Nothing

-- the above could easily be replaced with versions 
-- which use the maybe datatype

--printM :: (MyRef m myref,Show a) => (myref (S myref a)) -> m ()
printM x = (readRef x) >>= printM1
  printM1 Nil        = print "Nil"
  printM1 (Cons a x) = do print "Cons "
                          print (show a)
                          y <- readRef x
                          printM1 y

-- this might be doable with foldM or somesuch
makeM :: MyRef m myref => [a] -> m ( myref (S myref a))
makeM x = (makeM' x)>>= newRef

makeM' :: MyRef m myref => [a] -> m (S myref a)
makeM' [] = return Nil
makeM' (x:xs) = do
                  rest <- makeM' xs
                  refrest <- newRef rest
                  return (Cons x refrest)

makeM1 refmaker arry = (makeM' arry) >>= refmaker

makeIORefM :: [a] -> IO (IORef (S IORef a))
makeIORefM = makeM
--or makeIORefM = makeM1 newIORef

makeSTRefM :: [a] -> ST s (STRef s (S (STRef s) a))
makeSTRefM = makeM
--or makeSTRefM = makeM1 newSTRef

unmakeM :: MyRef m myref => myref (S myref a) -> m [a]
unmakeM = foldrM (:) []

foldrM :: MyRef m myref => (a->b->b)->b->myref(S myref a)-> m (b)
foldrM f init ref = do x<-readRef ref
                       case x of 
                         Nil -> return init
                         (Cons val rest) -> 
                               do value <- foldrM f init rest
                                  return (f val value)

foldlM :: MyRef m myref => (b->a->b) -> b -> myref (S myref a) -> m (b)
foldlM f acc ref = do x<-readRef ref
                      case x of 
                        Nil -> return acc
                        (Cons val rest) -> foldlM f (f acc val) rest

-- cut off part of a list and replace part with another list
replaceM ::MyRef m myref => myref (S myref a) -> Int -> myref (S myref a) -> m ()
replaceM x n y = do z <-readRef y; replaceM1 x n z

replaceM1 ::MyRef m myref => myref (S myref a) -> Int -> (S myref a) -> m ()
replaceM1 x 0 y = writeRef x y
replaceM1 x n y = do z <- readRef x
                     case z of
                        Nil -> do  --print "cannot replace list part"
                                   writeRef x Nil
                        (Cons a ls)-> replaceM1 ls (n-1) y

truncateM x n = replaceM1 x n Nil

splitwhere:: MyRef m myref => (a-> Bool) ->myref (S myref a) -> m (myref (S myref a),myref (S myref a))
splitwhere f original = something original
  where something l = 
                do z <- readRef l
                   case z of
                     Nil -> do x1 <-newRef Nil
                               return (original,x1)
                     (Cons val ls) -> if (f val) then
                                         x1 <-  newRef z
                                         writeRef l Nil
                                         something ls

mymapM :: MyRef m myref => (a->b) -> myref (S myref a) -> m ( myref (S myref b))
mymapM f ls = readRef ls >>= mymapM1 f 
  mymapM1 :: MyRef m myref => (a->b) -> (S myref a) -> m ( myref (S myref b))
  mymapM1 f Nil = newRef Nil
  mymapM1 f (Cons x ls) = do  y <-readRef ls
                              zs <- (mymapM1 f y)
                              newRef (Cons (f x) zs)

duplicateM :: MyRef m myref => myref (S myref a) -> m (myref (S myref a))
duplicateM = mymapM id

-- The following could go into another file and make another module

data MyRef m myref => O1appendList m myref a = Lt{list::myref(S myref a),butt::myref(myref(S myref a))}

makelist:: MyRef m myref => [a] -> m (O1appendList m myref a)
makelist ls  = do x<-mkempty
                  t<- newRef x
                  let p = Lt x t in m ls p
   where m [] p = return p
         m (h:t) p = do x <- m t p
                        y<- push (list x) h
                        return (x {list=y})

makeSTReflist :: [a] -> ST s (O1appendList (ST s) (STRef s) a)
makeSTReflist = makelist
makeIOReflist :: [a] -> IO (O1appendList IO IORef a)
makeIOReflist = makelist

listappend :: MyRef m myref => (O1appendList m myref a) -> (O1appendList m myref a) -> m ()
listappend l1 l2 = do end<- readRef (butt l2)
                      middle <- readRef (butt l1)
                      beginl2 <-readRef (list l2)
                      writeRef middle beginl2
                      writeRef (butt l1) end

printlist x = printM (list x)

--the following function is good to get out of the state world.

unmakelist x = unmakeM (list x)