"Proper" doubly-linked lists in Haskell

Vanessa McHale
2026-03-13T22:25:30Z

DLList.hs

| -- | Immutable doubly-linked lists
| module DLList ( DLList
| , singleton
| , insertL
| , deleteR
| , dbg
| ) where
|
| data DLList a = Cyc { n :: Int, bw :: DLList a, e :: a, fw :: DLList a }
|
| singleton :: a -> DLList a
| singleton x = xs where xs = Cyc 1 xs x xs
|
| -- | Insert to the left; returning new node
| insertL :: a -> DLList a -> DLList a
| insertL x (Cyc n _ y r) = xs where
| xs = Cyc (n+1) penultimate x ys'
| (penultimate, ys') = propagateR (Cyc (n+1) xs y r)
|
| propagateR :: DLList a -- ^ focus, with backlink to cycle stop
| -> (DLList a, DLList a) -- penultimate, updated focus
| propagateR xs = step (m-2) xs (bw xs)
| where m=n xs
| end=bw xs
|
| step 0 (Cyc _ _ x _) b = (ys,ys) where ys = Cyc m b x end
| step k (Cyc _ _ x r) b = (penultimate, ys) where ys=Cyc m b x r'; (penultimate, r') = step (k-1) r ys
|
| -- | Delete focus, returning right neighbor
| deleteR :: DLList a -> DLList a
| deleteR (Cyc 1 _ _ _) = error "deleteR called on a singleton"
| deleteR (Cyc 2 _ _ f) = singleton (e f)
| deleteR (Cyc _ _ _ (Cyc n _ y r)) = xs where
| xs = Cyc (n-1) penultimate y r'
| (penultimate, r') = propagateR (r { bw = xs, n = n-1 })
|
| dbg :: Int -> DLList a -> ([a], a, [a])
| dbg m (Cyc _ l z r) = (reverse $ takeL (m-1) l, z, takeR (m-1) r)
| where
| takeL 0 _ = []
| takeL n (Cyc _ b x _) = x:takeL (n-1) b
|
| takeR 0 _ = []
| takeR n (Cyc _ _ x f) = x:takeR (n-1) f