content: > {-# LANGUAGE BangPatterns,CPP #-}
  > module IOList where
  
  -- #define USE_UNPACK
  -- #define USE_STRICT
  
  #if defined(USE_UNPACK)
  #define UNPACK(p) {-# UNPACK #-} !(p)
  #elif defined(USE_STRICT)
  #define UNPACK(p) !(p)
  #else
  #define UNPACK(p) p
  #endif
  
  > import Data.IORef
  
  
  > data List a = Node { val :: a, next :: UNPACK(IORef (List a))}   
  >           | Null
  >           | Head {next :: UNPACK(IORef (List a)) }
  
  > data ListHandle a = ListHandle { headList :: UNPACK(IORef (IORef (List a))),
  >                            tailList :: UNPACK(IORef (IORef (List a))) }
  
  > atomically = \x -> x
  
  
  > -- we create a new list
  > newList :: IO (ListHandle a)
  > newList = 
  >   do null <- newIORef Null
  >      hd <- newIORef (Head {next = null })
  >      hdPtr <- newIORef hd
  >      tailPtr <- newIORef null
  >      return (ListHandle {headList = hdPtr, tailList = tailPtr})
    
  > find ::  Eq a => ListHandle a -> a -> IO Bool
  > find (ListHandle {headList = ptrPtr})  i =  do 
  >  ptr <- readIORef ptrPtr
  >  Head {next = startptr} <- readIORef ptr
  >  find2 startptr i 
  >   where 
  >    find2 :: Eq a => IORef (List a) -> a -> IO Bool
  >    find2 curNodePtr i = do
  >    { curNode <- readIORef curNodePtr
  >    ; case curNode of
  >        Null -> return False  -- we've reached the end of the list
  >                              -- element not found
  >        Node {val = curval, next = curnext} ->
  >          if (curval == i) then return True -- element found
  >          else find2 curnext i              -- keep searching
  >    }
   
  
  > -- we add a new node, by overwriting the null tail node
  > -- we only need to adjust tailList but not headList because
  > -- of the static Head
  > -- we return the location of the newly added node
  > addToTail :: ListHandle a -> a -> IO (IORef (List a))
  > addToTail (ListHandle {tailList = tailPtrPtr}) x =
  >   do tPtr <- atomically (
  >                do null <- newIORef Null
  >                   tailPtr <- readIORef tailPtrPtr
  >                   writeIORef tailPtr (Node {val = x, next = null})
  >                   writeIORef tailPtrPtr null
  >                   return tailPtr
  >              )
  >      return tPtr
  
  
  > delete :: Eq a => ListHandle a -> a -> IO Bool
  > delete (ListHandle {headList = ptrPtr})  i = 
  >  atomically (
  >          do startptr <- readIORef ptrPtr
  >             delete2 startptr i)
  >   where
  >    delete2 :: Eq a => IORef (List a) -> a -> IO Bool
  >    delete2 prevPtr i =
  >     do
  >    { prevNode <- readIORef prevPtr
  >    ; let curNodePtr = next prevNode --  head/node have both next 
  >    ; curNode <- readIORef curNodePtr
  >    ; case curNode of
  >        Null -> return False  -- we've reached the end of the list
  >                              -- element not found
  >        Node {val = curval, next = nextNode} ->
  >          if (curval /= i) 
  >           then delete2 curNodePtr i         -- keep searching
  >           else 
  >               -- delete element (ie delink node)
  >               do { case prevNode of
  >                      Head {} -> do writeIORef prevPtr (Head {next = nextNode})
  >                                    return True
  >                      Node {} -> do writeIORef prevPtr
  >                                       (Node {val = val prevNode, next = nextNode})
  >                                    return True
  >                  }
  >     }
  
  
  printing and counting
  
  > printList :: Show a => ListHandle a -> IO ()
  > printList (ListHandle {headList = ptrPtr}) =
  >   do startptr <- (
  >          do ptr <- readIORef ptrPtr
  >             Head {next = startptr} <- readIORef ptr
  >             return startptr)
  >      printListHelp startptr
  
  
  > printListHelp :: Show a => IORef (List a) -> IO ()
  > printListHelp curNodePtr =
  >   do { curNode <- readIORef curNodePtr
  >      ; case curNode of
  >          Null -> putStr "Nil"
  >          Node {val = curval, next = curnext} ->
  >             do { putStr (show curval  ++ " -> ")
  >                ;  printListHelp curnext }
  >      } 
  
  > cntList :: Show a => ListHandle a -> IO Int
  > cntList (ListHandle {headList = ptrPtr}) =
  >  do startptr <- (
  >          do ptr <- readIORef ptrPtr
  >             Head {next = startptr} <- readIORef ptr
  >             return startptr)
  >     cntListHelp startptr 0
  
  
  > cntListHelp :: Show a => IORef (List a) -> Int -> IO Int
  > cntListHelp curNodePtr i =
  >   do { curNode <- readIORef curNodePtr
  >      ; case curNode of
  >          Null -> return i
  >          Node {val = curval, next = curnext} -> 
  >                cntListHelp curnext (i+1)
  >      } 
  