1{-# LANGUAGE TypeFamilies #-} 2-- | Doubly-linked list 3module Data.Mutable.DLList 4 ( DLList 5 , asDLList 6 , module Data.Mutable.Class 7 ) where 8 9import Data.Mutable.Class 10 11data Node s a = Node 12 a 13 (MutVar s (Maybe (Node s a))) -- previous 14 (MutVar s (Maybe (Node s a))) -- next 15 16-- | A doubly-linked list. 17-- 18-- Since 0.3.0 19data DLList s a = DLList (MutVar s (Maybe (Node s a))) (MutVar s (Maybe (Node s a))) 20 21-- | 22-- Since 0.2.0 23asDLList :: DLList s a -> DLList s a 24asDLList = id 25{-# INLINE asDLList #-} 26 27instance MutableContainer (DLList s a) where 28 type MCState (DLList s a) = s 29instance MutableCollection (DLList s a) where 30 type CollElement (DLList s a) = a 31 newColl = do 32 x <- newRef $! Nothing 33 y <- newRef $! Nothing 34 return $! DLList x y 35 {-# INLINE newColl #-} 36instance MutablePopFront (DLList s a) where 37 popFront (DLList frontRef backRef) = do 38 mfront <- readRef frontRef 39 case mfront of 40 Nothing -> return Nothing 41 Just (Node val _ nextRef) -> do 42 mnext <- readRef nextRef 43 case mnext of 44 Nothing -> do 45 writeRef frontRef $! Nothing 46 writeRef backRef $! Nothing 47 Just next@(Node _ prevRef _) -> do 48 writeRef prevRef $! Nothing 49 writeRef frontRef $! Just next 50 return $ Just val 51 {-# INLINE popFront #-} 52instance MutablePopBack (DLList s a) where 53 popBack (DLList frontRef backRef) = do 54 mback <- readRef backRef 55 case mback of 56 Nothing -> return Nothing 57 Just (Node val prevRef _) -> do 58 mprev <- readRef prevRef 59 case mprev of 60 Nothing -> do 61 writeRef frontRef $! Nothing 62 writeRef backRef $! Nothing 63 Just prev@(Node _ _ nextRef) -> do 64 writeRef nextRef $! Nothing 65 writeRef backRef (Just prev) 66 return $ Just val 67 {-# INLINE popBack #-} 68instance MutablePushFront (DLList s a) where 69 pushFront (DLList frontRef backRef) val = do 70 mfront <- readRef frontRef 71 case mfront of 72 Nothing -> do 73 prevRef <- newRef $! Nothing 74 nextRef <- newRef $! Nothing 75 let node = Just $ Node val prevRef nextRef 76 writeRef frontRef node 77 writeRef backRef node 78 Just front@(Node _ prevRef _) -> do 79 prevRefNew <- newRef $! Nothing 80 nextRef <- newRef $ Just front 81 let node = Just $ Node val prevRefNew nextRef 82 writeRef prevRef node 83 writeRef frontRef node 84 {-# INLINE pushFront #-} 85instance MutablePushBack (DLList s a) where 86 pushBack (DLList frontRef backRef) val = do 87 mback <- readRef backRef 88 case mback of 89 Nothing -> do 90 prevRef <- newRef $! Nothing 91 nextRef <- newRef $! Nothing 92 let node = Just $! Node val prevRef nextRef 93 writeRef frontRef $! node 94 writeRef backRef $! node 95 Just back@(Node _ _ nextRef) -> do 96 nextRefNew <- newRef $! Nothing 97 prevRef <- newRef $! Just back 98 let node = Just $! Node val prevRef nextRefNew 99 writeRef nextRef $! node 100 writeRef backRef $! node 101 {-# INLINE pushBack #-} 102