@@ -1,3 +1,6 @@
1+{-# LANGUAGE RankNTypes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE FlexibleContexts #-}
14{- |
25Module : Data.Syntax.Combinator
36Description : Combinators that work with any sequence type.
@@ -9,12 +12,38 @@ Stability : experimental
912
1013Combinators that work with any sequence type.
1114-}
12−module Data.Syntax.Combinator where
15+module Data.Syntax.Combinator
16+ (
17+ -- * Combinators.
18+ optional,
19+ opt,
20+ opt_,
21+ choice,
22+ eitherOf,
1323
14−import Control.Category.Structures
15−import Control.Lens
16−import Control.Lens.SemiIso
17−import Control.SIArrow
24+ -- * Lists.
25+ manyTill,
26+ sepBy,
27+ sepBy1,
28+
29+ -- * Vectors.
30+ vecNSepBy,
31+ ivecNSepBy,
32+ vec,
33+ vecSepBy,
34+ ivec,
35+ ivecSepBy
36+ ) where
37+
38+import Control.Category
39+import Control.Category.Structures
40+import Control.Lens
41+import Control.Lens.SemiIso
42+import Control.SIArrow
43+import Data.Syntax
44+import Data.Vector (Vector)
45+import qualified Data.Vector as V
46+import Prelude hiding (id, (.))
1847
1948-- | One or zero occurences of @f@.
2049optional :: SIArrow cat => cat () a -> cat () (Maybe a)
@@ -29,6 +58,15 @@ opt_ :: SIArrow cat => cat () () -> cat () ()
2958opt_ f = semiIso (const (Left "opt_")) Right /$/ f
3059 /+/ sipure id
3160
61+-- | Tries to apply the actions in the list in order, until one of
62+-- them succeeds. Returns the value of the succeeding action.
63+choice :: SIArrow cat => [cat () a] -> cat () a
64+choice = foldr (/+/) (sifail "choice: all alternatives failed")
65+
66+-- | Combine two alternatives.
67+eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
68+eitherOf a b = _Left /$/ a /+/ _Right /$/ b
69+
3270-- | @manyTill p end@ applies action p zero or more times until action
3371-- end succeeds, and returns the list of values returned by p.
3472manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
@@ -43,11 +81,46 @@ sepBy v s = sepBy1 v s /+/ sipure _Empty
4381sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
4482sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
4583
46−-- | Tries to apply the actions in the list in order, until one of
47−-- them succeeds. Returns the value of the succeeding action.
48−choice :: SIArrow cat => [cat () a] -> cat () a
49−choice = foldr (/+/) (sifail "choice: all alternatives failed")
84+-- | Constant size vector with separators.
85+--
86+-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
87+vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (Vector a)
88+vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep
5089
51−-- | Combine two alternatives.
52−eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
53−eitherOf a b = _Left /$/ a /+/ _Right /$/ b
90+-- | Constant size vector with separators and index-aware elements.
91+--
92+-- @ivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
93+-- Each element gets its index and should output a value and the index unchanged.
94+ivecNSepBy :: Syntax syn => Int -> syn Int (Int, a) -> syn () () -> syn () (Vector a)
95+ivecNSepBy n e sep = ivecN n $ sibind $ iso el (el . fst)
96+ where
97+ el k | k < n - 1 = unit ^>> e *** sep >># unit
98+ | otherwise = e
99+
100+-- | Runtime sized vector. The size can depend on the result of some computation.
101+--
102+-- @vec e@ describes a vector with elements @e@.
103+vec :: Syntax syn => syn () a -> syn Int (Vector a)
104+vec e = vecSepBy e (siarr id)
105+
106+-- | Runtime sized vector with separators. The size can depend on the result of some
107+-- computation.
108+--
109+-- @vecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
110+vecSepBy :: Syntax syn => syn () a -> syn () () -> syn Int (Vector a)
111+vecSepBy e sep = ivecSepBy (unit ^>> second e) sep
112+
113+-- | Runtime sized vector with index-aware elements. The size can depend on the result
114+-- of some computation.
115+--
116+-- @ivec e@ describes a vector with elements @e@.
117+ivec :: Syntax syn => syn Int (Int, a) -> syn Int (Vector a)
118+ivec e = ivecSepBy e (siarr id)
119+
120+-- | Runtime sized vector with index-aware elements and separators. The size can depend
121+-- on the result of some computation.
122+--
123+-- @ivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
124+ivecSepBy :: Syntax syn => syn Int (Int, a) -> syn () () -> syn Int (Vector a)
125+ivecSepBy e sep = sibind $ iso (\n -> constant n #>> ivecNSepBy n e sep)
126+ (\v -> constant (V.length v) #>> ivecNSepBy (V.length v) e sep)