From 0bf070cd1fa33f6c4439ff15c8d3265ea7254a98 Mon Sep 17 00:00:00 2001 From: Divesh Otwani Date: Sun, 17 Jan 2021 22:49:35 -0500 Subject: [PATCH 1/4] Adding Deques --- linear-base.cabal | 1 + src/Data/Deque/Mutable/Linear.hs | 203 ++++++++++++++++++++ src/Data/Unrestricted/Internal/Instances.hs | 2 + 3 files changed, 206 insertions(+) create mode 100644 src/Data/Deque/Mutable/Linear.hs diff --git a/linear-base.cabal b/linear-base.cabal index 553c9ebb..f6c641d4 100644 --- a/linear-base.cabal +++ b/linear-base.cabal @@ -40,6 +40,7 @@ library Data.Bifunctor.Linear.Internal.Bifunctor Data.Bifunctor.Linear.Internal.SymmetricMonoidal Data.Bool.Linear + Data.Deque.Mutable.Linear Data.Either.Linear Data.Functor.Linear Data.Functor.Linear.Internal.Functor diff --git a/src/Data/Deque/Mutable/Linear.hs b/src/Data/Deque/Mutable/Linear.hs new file mode 100644 index 00000000..54a2dfb0 --- /dev/null +++ b/src/Data/Deque/Mutable/Linear.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Mutable Linear Deque +-- +-- This module provides a pure interface to a mutable deque. +-- +-- It is designed to be imported qualfied: +-- +-- > import qualfied Data.Deque.Mutable.Linear as Deque +module Data.Deque.Mutable.Linear + ( + -- * Allocation + Deque + , alloc + , fromList + -- * Querying + , size + , length + , isFull + , peekFront + , peekBack + -- * Modification + , pushFront + , pushBack + , popFront + , popBack + , map + -- * Consumption + , toList + ) +where + +import qualified Data.Array.Mutable.Linear as Array +import Data.Unrestricted.Linear +import Prelude.Linear hiding (length, map) +import qualified Prelude +import GHC.Stack + + +-- # Types +------------------------------------------------------------------------------- + +data Deque a where + Deque :: !Int -> !Ptr -> !(Array.Array a) %1-> Deque a + -- This is: Deque length ptr array + -- + -- The length is the number of elements stored. + -- The ptr is the starting pointer to the front end, and the deque + -- continues forward, wrapping the end if needed. Example: + -- + -- [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + -- ....^ ^.......... + -- | | + -- ptr+len ptr + -- + -- + -- So the deque is: 7--8--9--10--0--1 + +newtype Ptr = Ptr Int deriving Prelude.Num + +-- | The two faces of a deque +data Face = Front | Back + + +-- # Internal Helpers +------------------------------------------------------------------------------- + +-- @backPtr offset len size ptr = ptr'@ where @ptr'@ is the pointer +-- to the back of the deque + the offset +-- Must have: len >= 1 +backPtr :: Int -> Int -> Int -> Ptr -> Int +backPtr off len sz (Ptr p) = (off + p + len - 1) `mod` sz + +-- @prevPtr size ptr@ will be the previous pointer +prevPtr :: Int -> Ptr -> Int +prevPtr sz (Ptr p) = (p - 1 + sz) `mod` sz + +-- @nextPtr size ptr@ will be the next pointer +nextPtr :: Int -> Ptr -> Int +nextPtr sz (Ptr p) = (p + 1) `mod` sz + + +-- # Allocation +------------------------------------------------------------------------------- + +-- | Run a computation of an empty Deque with a given size +alloc :: HasCallStack => Int -> (Deque a %1-> Ur b) %1-> Ur b +alloc k f = Array.alloc k err $ \arr -> f (Deque 0 0 arr) where + err = Prelude.error "Accessing error element of a collection!" + +-- | Run a computation on a Deque that is deterimined by the given the list +-- where we treat the start and end of the list as the left and right pointers, +-- with the total capacity as the length of the list. +fromList :: HasCallStack => [a] -> (Deque a %1-> Ur b) %1-> Ur b +fromList xs f = + Array.fromList xs $ \arr -> f (Deque (Prelude.length xs) 0 arr) + + +-- # Querying +------------------------------------------------------------------------------- + +-- | The total capacity of the Deque +size :: Deque a %1-> (Ur Int, Deque a) +size (Deque len ptr arr) = Array.size arr & + \(sz, arr0) -> (sz, Deque len ptr arr0) + +-- | The number of elements currently stored +length :: Deque a %1-> (Ur Int, Deque a) +length (Deque len ptr arr) = (Ur len, Deque len ptr arr) + +-- | We are full if the length equals the size +isFull :: Deque a %1-> (Ur Bool, Deque a) +isFull d = + size d & \(Ur sz, Deque len ptr arr) -> (Ur (len == sz), Deque len ptr arr) + +peek :: HasCallStack => Face -> Deque a %1-> (Ur a, Deque a) +peek _ (Deque 0 _ arr) = error "Peeking a zero-length deque." $ arr +peek face (Deque len ptr@(Ptr p) arr) = case face of + Front -> Array.read arr p & \(val, arr0) -> (val, Deque len ptr arr0) + Back -> Array.size arr & \(Ur sz, arr0) -> + Array.read arr0 (backPtr 0 len sz ptr) & \(val, arr1) -> + (val, Deque len ptr arr1) + +-- | View the top of the left queue +peekFront :: HasCallStack => Deque a %1-> (Ur a, Deque a) +peekFront = peek Front + +-- | View the top of the right queue +peekBack :: HasCallStack => Deque a %1-> (Ur a, Deque a) +peekBack = peek Back + + +-- # Modification +------------------------------------------------------------------------------- + +push :: HasCallStack => Face -> a -> Deque a %1-> Deque a +push face x deq = isFull deq & \case + (Ur True, deq0) -> error "Pushing to full deque" $ deq0 + (Ur False, Deque 0 _ arr) -> Array.write arr 0 x & \arr0 -> Deque 1 0 arr0 + (Ur False, Deque len (Ptr p) arr) -> case face of + Front -> Array.size arr & \(Ur sz, arr0) -> + Array.write arr0 (prevPtr sz (Ptr p)) x & \arr1 -> + Deque (len+1) (Ptr $ prevPtr sz (Ptr p)) arr1 + Back -> Array.size arr & \(Ur sz, arr0) -> + Array.write arr0 (backPtr 1 len sz (Ptr p)) x & \arr1 -> + Deque (len+1) (Ptr p) arr1 + +-- | Push to the front end +pushFront :: HasCallStack => a -> Deque a %1-> Deque a +pushFront = push Front + +-- | Push to the back end +pushBack :: HasCallStack => a -> Deque a %1-> Deque a +pushBack = push Back + +pop :: HasCallStack => Face -> Deque a %1-> (Ur a, Deque a) +pop _ (Deque 0 _ arr) = error "Popping from an empty deque" $ arr +pop face (Deque len ptr@(Ptr p) arr) = case face of + Front -> Array.size arr & \(Ur sz, arr0) -> + Array.read arr0 p & \(val, arr1) -> + (val, Deque (len-1) (Ptr $ nextPtr sz ptr) arr1) + Back -> Array.size arr & \(Ur sz, arr0) -> + Array.read arr0 (backPtr 0 len sz ptr) & \(val, arr1) -> + (val, Deque (len-1) ptr arr1) + +-- | Remove the last added element from the left queue +popFront :: HasCallStack => Deque a %1-> (Ur a, Deque a) +popFront = pop Front + +-- | Remove the last added element from the right queue +popBack :: HasCallStack => Deque a %1-> (Ur a, Deque a) +popBack = pop Back + +-- Note: We can't use a Prelude.Functor nor a Data.Functor +-- because the mapped function need not be linear but we must +-- consume the Deque linearly. The types don't align. +map :: (a -> b) -> Deque a %1-> Deque b +map f (Deque len p arr) = Deque len p (Array.map f arr) + + +-- # Consumption +------------------------------------------------------------------------------- + +-- | Convert the Deque to a list where the first element is the left +-- top and the last element is the right top +toList :: Deque a %1-> Ur [a] +toList (Deque len (Ptr p) arr) = Array.size arr & \(Ur sz, arr0) -> + loop len (backPtr 0 len sz (Ptr p)) [] arr0 + where + loop :: Int -> Int -> [a] -> Array.Array a %1-> Ur [a] + loop 0 _ xs arr' = lseq arr' (Ur xs) + loop l ptr xs arr' = Array.read arr' ptr & \(Ur a, arr0) -> + Array.size arr0 & \(Ur sz, arr1) -> + loop (l-1) (prevPtr sz (Ptr ptr)) (a:xs) arr1 + +instance Consumable (Deque a) where + consume (Deque _ _ arr) = consume arr + diff --git a/src/Data/Unrestricted/Internal/Instances.hs b/src/Data/Unrestricted/Internal/Instances.hs index d7ef91be..c2ee60a5 100644 --- a/src/Data/Unrestricted/Internal/Instances.hs +++ b/src/Data/Unrestricted/Internal/Instances.hs @@ -196,6 +196,8 @@ instance Dupable (Ur a) where instance Movable (Ur a) where move (Ur a) = Ur (Ur a) +deriving instance Prelude.Show a => Prelude.Show (Ur a) + instance Prelude.Functor Ur where fmap f (Ur a) = Ur (f a) From 8a18dbe59b163a332c8f6842ee59b5d7ef6700ed Mon Sep 17 00:00:00 2001 From: Divesh Otwani Date: Tue, 19 Jan 2021 08:20:34 -0500 Subject: [PATCH 2/4] Better comments --- src/Data/Deque/Mutable/Linear.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Data/Deque/Mutable/Linear.hs b/src/Data/Deque/Mutable/Linear.hs index 54a2dfb0..9862d381 100644 --- a/src/Data/Deque/Mutable/Linear.hs +++ b/src/Data/Deque/Mutable/Linear.hs @@ -7,7 +7,8 @@ -- | Mutable Linear Deque -- --- This module provides a pure interface to a mutable deque. +-- This module provides a pure interface to a bounded mutable deque. +-- The deque has a maxiumum size and is represented with an array underneath. -- -- It is designed to be imported qualfied: -- From 5cc36e1dae007341be37c1e3ebf397c20918c212 Mon Sep 17 00:00:00 2001 From: Divesh Otwani Date: Tue, 19 Jan 2021 08:38:11 -0500 Subject: [PATCH 3/4] Peek and pop return maybes --- src/Data/Deque/Mutable/Linear.hs | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/Data/Deque/Mutable/Linear.hs b/src/Data/Deque/Mutable/Linear.hs index 9862d381..f879ef15 100644 --- a/src/Data/Deque/Mutable/Linear.hs +++ b/src/Data/Deque/Mutable/Linear.hs @@ -119,20 +119,21 @@ isFull :: Deque a %1-> (Ur Bool, Deque a) isFull d = size d & \(Ur sz, Deque len ptr arr) -> (Ur (len == sz), Deque len ptr arr) -peek :: HasCallStack => Face -> Deque a %1-> (Ur a, Deque a) -peek _ (Deque 0 _ arr) = error "Peeking a zero-length deque." $ arr +peek :: HasCallStack => Face -> Deque a %1-> (Ur (Maybe a), Deque a) +peek _ (Deque 0 p arr) = (Ur Nothing, Deque 0 p arr) peek face (Deque len ptr@(Ptr p) arr) = case face of - Front -> Array.read arr p & \(val, arr0) -> (val, Deque len ptr arr0) + Front -> + Array.read arr p & \(Ur a, arr0) -> (Ur (Just a), Deque len ptr arr0) Back -> Array.size arr & \(Ur sz, arr0) -> - Array.read arr0 (backPtr 0 len sz ptr) & \(val, arr1) -> - (val, Deque len ptr arr1) + Array.read arr0 (backPtr 0 len sz ptr) & \(Ur a, arr1) -> + (Ur (Just a), Deque len ptr arr1) -- | View the top of the left queue -peekFront :: HasCallStack => Deque a %1-> (Ur a, Deque a) +peekFront :: HasCallStack => Deque a %1-> (Ur (Maybe a), Deque a) peekFront = peek Front -- | View the top of the right queue -peekBack :: HasCallStack => Deque a %1-> (Ur a, Deque a) +peekBack :: HasCallStack => Deque a %1-> (Ur (Maybe a), Deque a) peekBack = peek Back @@ -159,22 +160,22 @@ pushFront = push Front pushBack :: HasCallStack => a -> Deque a %1-> Deque a pushBack = push Back -pop :: HasCallStack => Face -> Deque a %1-> (Ur a, Deque a) -pop _ (Deque 0 _ arr) = error "Popping from an empty deque" $ arr +pop :: HasCallStack => Face -> Deque a %1-> (Ur (Maybe a), Deque a) +pop _ (Deque 0 p arr) = (Ur Nothing, Deque 0 p arr) pop face (Deque len ptr@(Ptr p) arr) = case face of Front -> Array.size arr & \(Ur sz, arr0) -> - Array.read arr0 p & \(val, arr1) -> - (val, Deque (len-1) (Ptr $ nextPtr sz ptr) arr1) + Array.read arr0 p & \(Ur a, arr1) -> + (Ur (Just a), Deque (len-1) (Ptr $ nextPtr sz ptr) arr1) Back -> Array.size arr & \(Ur sz, arr0) -> - Array.read arr0 (backPtr 0 len sz ptr) & \(val, arr1) -> - (val, Deque (len-1) ptr arr1) + Array.read arr0 (backPtr 0 len sz ptr) & \(Ur a, arr1) -> + (Ur (Just a), Deque (len-1) ptr arr1) -- | Remove the last added element from the left queue -popFront :: HasCallStack => Deque a %1-> (Ur a, Deque a) +popFront :: Deque a %1-> (Ur (Maybe a), Deque a) popFront = pop Front -- | Remove the last added element from the right queue -popBack :: HasCallStack => Deque a %1-> (Ur a, Deque a) +popBack :: Deque a %1-> (Ur (Maybe a), Deque a) popBack = pop Back -- Note: We can't use a Prelude.Functor nor a Data.Functor From 7439f28af404c78e72f26883b213d1cac52815ed Mon Sep 17 00:00:00 2001 From: Divesh Otwani Date: Tue, 19 Jan 2021 09:09:33 -0500 Subject: [PATCH 4/4] Resizing done --- src/Data/Deque/Mutable/Linear.hs | 40 +++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/src/Data/Deque/Mutable/Linear.hs b/src/Data/Deque/Mutable/Linear.hs index f879ef15..2a516d45 100644 --- a/src/Data/Deque/Mutable/Linear.hs +++ b/src/Data/Deque/Mutable/Linear.hs @@ -7,8 +7,7 @@ -- | Mutable Linear Deque -- --- This module provides a pure interface to a bounded mutable deque. --- The deque has a maxiumum size and is represented with an array underneath. +-- This module provides a pure interface to a mutable deque. -- -- It is designed to be imported qualfied: -- @@ -22,7 +21,6 @@ module Data.Deque.Mutable.Linear -- * Querying , size , length - , isFull , peekFront , peekBack -- * Modification @@ -40,7 +38,6 @@ import qualified Data.Array.Mutable.Linear as Array import Data.Unrestricted.Linear import Prelude.Linear hiding (length, map) import qualified Prelude -import GHC.Stack -- # Types @@ -90,14 +87,14 @@ nextPtr sz (Ptr p) = (p + 1) `mod` sz ------------------------------------------------------------------------------- -- | Run a computation of an empty Deque with a given size -alloc :: HasCallStack => Int -> (Deque a %1-> Ur b) %1-> Ur b +alloc :: Int -> (Deque a %1-> Ur b) %1-> Ur b alloc k f = Array.alloc k err $ \arr -> f (Deque 0 0 arr) where err = Prelude.error "Accessing error element of a collection!" -- | Run a computation on a Deque that is deterimined by the given the list -- where we treat the start and end of the list as the left and right pointers, -- with the total capacity as the length of the list. -fromList :: HasCallStack => [a] -> (Deque a %1-> Ur b) %1-> Ur b +fromList :: [a] -> (Deque a %1-> Ur b) %1-> Ur b fromList xs f = Array.fromList xs $ \arr -> f (Deque (Prelude.length xs) 0 arr) @@ -119,7 +116,7 @@ isFull :: Deque a %1-> (Ur Bool, Deque a) isFull d = size d & \(Ur sz, Deque len ptr arr) -> (Ur (len == sz), Deque len ptr arr) -peek :: HasCallStack => Face -> Deque a %1-> (Ur (Maybe a), Deque a) +peek :: Face -> Deque a %1-> (Ur (Maybe a), Deque a) peek _ (Deque 0 p arr) = (Ur Nothing, Deque 0 p arr) peek face (Deque len ptr@(Ptr p) arr) = case face of Front -> @@ -129,20 +126,20 @@ peek face (Deque len ptr@(Ptr p) arr) = case face of (Ur (Just a), Deque len ptr arr1) -- | View the top of the left queue -peekFront :: HasCallStack => Deque a %1-> (Ur (Maybe a), Deque a) +peekFront :: Deque a %1-> (Ur (Maybe a), Deque a) peekFront = peek Front -- | View the top of the right queue -peekBack :: HasCallStack => Deque a %1-> (Ur (Maybe a), Deque a) +peekBack :: Deque a %1-> (Ur (Maybe a), Deque a) peekBack = peek Back -- # Modification ------------------------------------------------------------------------------- -push :: HasCallStack => Face -> a -> Deque a %1-> Deque a +push :: Face -> a -> Deque a %1-> Deque a push face x deq = isFull deq & \case - (Ur True, deq0) -> error "Pushing to full deque" $ deq0 + (Ur True, deq0) -> push face x (doubleSize deq0) (Ur False, Deque 0 _ arr) -> Array.write arr 0 x & \arr0 -> Deque 1 0 arr0 (Ur False, Deque len (Ptr p) arr) -> case face of Front -> Array.size arr & \(Ur sz, arr0) -> @@ -152,15 +149,28 @@ push face x deq = isFull deq & \case Array.write arr0 (backPtr 1 len sz (Ptr p)) x & \arr1 -> Deque (len+1) (Ptr p) arr1 +doubleSize :: Deque a %1-> Deque a +doubleSize (Deque len ptr@(Ptr start) arr) = + Array.size arr & \(Ur sz, arr0) -> + Array.resize (sz*2) err arr0 & \arr1 -> + Deque len ptr (movePrefix 0 start arr1) + where + err = Prelude.error "Accessing error element of a collection!" + movePrefix :: Int -> Int -> Array.Array a %1-> Array.Array a + movePrefix ix p arr' + | ix == p = arr' + | otherwise = Array.read arr' ix & \(Ur a, arr0) -> + Array.write arr0 (p+ix+1) a & \arr1 -> movePrefix (ix+1) p arr1 + -- | Push to the front end -pushFront :: HasCallStack => a -> Deque a %1-> Deque a +pushFront :: a -> Deque a %1-> Deque a pushFront = push Front -- | Push to the back end -pushBack :: HasCallStack => a -> Deque a %1-> Deque a +pushBack :: a -> Deque a %1-> Deque a pushBack = push Back -pop :: HasCallStack => Face -> Deque a %1-> (Ur (Maybe a), Deque a) +pop :: Face -> Deque a %1-> (Ur (Maybe a), Deque a) pop _ (Deque 0 p arr) = (Ur Nothing, Deque 0 p arr) pop face (Deque len ptr@(Ptr p) arr) = case face of Front -> Array.size arr & \(Ur sz, arr0) -> @@ -181,6 +191,8 @@ popBack = pop Back -- Note: We can't use a Prelude.Functor nor a Data.Functor -- because the mapped function need not be linear but we must -- consume the Deque linearly. The types don't align. +-- Note: This could be more efficient if we only mapped the +-- elements we care about and coerced the rest map :: (a -> b) -> Deque a %1-> Deque b map f (Deque len p arr) = Deque len p (Array.map f arr)