@@ -1,167 +0,0 @@
1−#include "inline.hs"
2−
3−-- |
4−-- Module : Streamly.Internal.Data.Zipper
5−-- Copyright : (c) 2020 Composewell Technologies
6−-- License : BSD-3-Clause
7−-- Maintainer : streamly@composewell.com
8−-- Stability : experimental
9−-- Portability : GHC
10−--
11−-- A special zipper derived from a stream to facilitate stream parsing.
12−--
13−-- = Zipper
14−--
15−-- The zipper is designed to enable moving backward and forward in the stream
16−-- efficiently to be able to implement backtracking parsers. The zipper can
17−-- buffer data until the parser indicates that it is not needed, we can move
18−-- back in the buffered data if the parser needs to backtrack.
19−--
20−-- = Checkpointing
21−--
22−-- We have a checkpointing mechanism built into the zipper to handle
23−-- backtracking. Whenever we enter a computation that can fail and has an
24−-- alternative to run then we add a checkpoint to the zipper. The checkpoint
25−-- ensures that we do not release the buffer upto the checkpoint until this
26−-- computation succeeds, if the computation fails we can backtrack to focus the
27−-- cursor back to the checkpoint position.
28−--
29−-- = Future Work
30−--
31−-- We can possibly have a typeclass providing a zipper interface so that we can
32−-- derive a zipper from different data sources efficiently. For example,
33−--
34−-- * stream zipper
35−-- * zippers from different types of arrays
36−-- * zipper from a tree of arrays for dynamic in-memory storage
37−-- * file handle zipper can utilize the seek to go back and forth in the file
38−--
39−-- A tree of zippers where a lower level zipper is dependent on (references
40−-- data in) a higher level zipper could be useful in implementing distributive
41−-- parsers.
42−--
43−-- See https://hackage.haskell.org/package/zipper for an existing type class.
44−-- We need a monadic one.
45−
46−module Streamly.Internal.Data.Zipper
47− (
48− Zipper (..)
49−
50− -- * Construction
51− , nil
52− , fromList
53−
54− -- * Checkpointing
55− , checkpoint
56− , release
57− , restore
58− )
59−where
60−
61−import Control.Exception (assert)
62−import Prelude hiding (splitAt)
63−
64−-------------------------------------------------------------------------------
65−-- Zipper type
66−-------------------------------------------------------------------------------
67−
68−-- | @Zipper checkpoints lefts rights tail@. The focus is on the first element
69−-- of @rights@. @lefts@ is buffered data on the right of the cursor. Note that
70−-- @lefts@ is stored as a reversed list, this helps is adding more items to the
71−-- list quickly.
72−--
73−-- @checkpoints@ is a stack of checkpoints. A new checkpoint is created by a
74−-- @checkpoint@ operation. A checkpoint consists of a count that tracks how
75−-- many elements we have yielded after the checkpoint was created. We need
76−-- this information to backtrack to the checkpoint. If we enter a nested
77−-- alternative we add another checkpoint in the stack. When we exit an
78−-- alternative we call a @release@ on the checkpoint. The @release@ removes the
79−-- checkpoint from the stack and adds its element count to the previous
80−-- checkpoint in the stack. When the last checkpoint is removed the buffer is
81−-- released.
82−--
83−-- /Internal/
84−--
85−data Zipper a = Zipper
86− [Int] -- checkpoints
87− [a] -- past buffered inputs in reverse order (for backtracking)
88− [a] -- future buffered inputs (created by backtracking)
89−
90−-------------------------------------------------------------------------------
91−-- Construction
92−-------------------------------------------------------------------------------
93−
94−-- | Empty zipper.
95−--
96−-- /Internal/
97−--
98−{-# INLINE nil #-}
99−nil :: Zipper a
100−nil = Zipper [] [] []
101−
102−-- | Create a zipper from a list.
103−--
104−-- /Internal/
105−--
106−{-# INLINE fromList #-}
107−fromList :: [a] -> Zipper a
108−fromList = Zipper [] []
109−
110−-------------------------------------------------------------------------------
111−-- Checkpointing
112−-------------------------------------------------------------------------------
113−
114−-- | Add a checkpoint to the Zipper so that we do not release the buffer beyond
115−-- the checkpoint.
116−--
117−-- /Internal/
118−--
119−{-# INLINE checkpoint #-}
120−checkpoint :: Zipper a -> Zipper a
121−checkpoint (Zipper cps xs ys) = Zipper (0:cps) xs ys
122−
123−-- | Release the latest checkpoint, releases any values held by the checkpoint.
124−-- Note that the values may still be held by other checkpoints in the stack of
125−-- checkpoints.
126−--
127−-- /Internal/
128−--
129−{-# INLINE release #-}
130−release :: Zipper a -> Zipper a
131−release (Zipper [] _ _ ) = error "Bug: release, no checkpoint exists!"
132−release (Zipper (n:cps) xs ys) =
133− assert (n <= length xs) $
134− case cps of
135− [] -> assert (n == length xs) $ Zipper [] [] ys
136− cp:rest -> Zipper ((cp + n) : rest) xs ys
137−
138−-- XXX recheck this, and unify with the definition in StreamD and ParserK
139−--
140−-- Inlined definition. Without the inline "serially/parser/take" benchmark
141−-- degrades and splitParse does not fuse. Even using "inline" at the callsite
142−-- does not help.
143−{-# INLINE splitAt #-}
144−splitAt :: Int -> [a] -> ([a],[a])
145−splitAt n ls
146− | n <= 0 = ([], ls)
147− | otherwise = splitAt' n ls
148− where
149− splitAt' :: Int -> [a] -> ([a], [a])
150− splitAt' _ [] = ([], [])
151− splitAt' 1 (x:xs) = ([x], xs)
152− splitAt' m (x:xs) = (x:xs', xs'')
153− where
154− (xs', xs'') = splitAt' (m - 1) xs
155−
156−-- | Rewind to restore the cursor to the latest checkpoint.
157−--
158−-- /Internal/
159−--
160−{-# INLINE restore #-}
161−restore :: Zipper a -> Zipper a
162−restore (Zipper [] _ _) = error "Bug: restore, no checkpoint exists!"
163−restore (Zipper (n:cps) xs ys) =
164− assert (n <= length xs) $
165− let (src0, buf1) = splitAt n xs
166− src = Prelude.reverse src0
167− in Zipper cps buf1 (src ++ ys)