on master help sign in
syntax/Data/Syntax/Combinator.hs
190 lines 7.1 kB history raw
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE FlexibleContexts #-}
4{- |
5Module : Data.Syntax.Combinator
6Description : Combinators that work with any sequence type.
7Copyright : (c) Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014, Paweł Nowak 2014
8License : MIT
10Maintainer : Paweł Nowak <pawel834@gmail.com>
11Stability : experimental
13Combinators that work with any sequence type.
14-}
15module Data.Syntax.Combinator
16 (
17 -- * Combinators.
18 optional,
19 opt,
20 opt_,
21 choice,
22 eitherOf,
24 -- * Lists.
25 manyTill,
26 sepBy,
27 sepBy1,
29 -- * Arrowized combinators.
30 takeArr,
32 -- * Vectors.
33 vecNSepBy,
34 ivecNSepBy,
35 vec,
36 vecSepBy,
37 ivec,
38 ivecSepBy,
40 -- * Unboxed vectors.
41 uvecNSepBy,
42 uivecNSepBy,
43 uvec,
44 uvecSepBy,
45 uivec,
46 uivecSepBy
47 ) where
49import Control.Category
50import Control.Category.Structures
51import Control.Lens
52import Control.Lens.SemiIso
53import Control.SIArrow
54import qualified Data.MonoTraversable as Seq
55import Data.Syntax
56import qualified Data.Vector as V
57import qualified Data.Vector.Unboxed as VU
58import Prelude hiding (id, (.), take)
60-- | One or zero occurences of @f@.
61optional :: SIArrow cat => cat () a -> cat () (Maybe a)
62optional f = _Just /$/ f /+/ sipure _Nothing
64-- | Like 'optional', but specialized for @()@.
65opt :: SIArrow cat => cat () () -> cat () ()
66opt f = f /+/ sipure id
68-- | Parser one or zero occurences of @f@, but prints nothing.
69opt_ :: SIArrow cat => cat () () -> cat () ()
70opt_ f = semiIso (const (Left "opt_")) Right /$/ f
71 /+/ sipure id
73-- | Tries to apply the actions in the list in order, until one of
74-- them succeeds. Returns the value of the succeeding action.
75choice :: SIArrow cat => [cat () a] -> cat () a
76choice = foldr (/+/) (sifail "choice: all alternatives failed")
78-- | Combine two alternatives.
79eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
80eitherOf a b = _Left /$/ a /+/ _Right /$/ b
82-- | @manyTill p end@ applies action p zero or more times until action
83-- end succeeds, and returns the list of values returned by p.
84manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
85manyTill p end = _Empty /$/ end
86 /+/ _Cons /$/ p /*/ manyTill p end
88-- | Zero or more occurences of @v@ separated by @s@.
89sepBy :: SIArrow cat => cat () a -> cat () () -> cat () [a]
90sepBy v s = sepBy1 v s /+/ sipure _Empty
92-- | One or more occurences of @v@ separated by @s@.
93sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
94sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
96-- | A string of given length.
97takeArr :: Syntax syn => syn Int (Seq syn)
98takeArr = sibind $ iso (\n -> constant n #>> take n)
99 (\s -> constant (Seq.olength s) #>> take (Seq.olength s))
101-- | Constant size vector with separators.
102--
103-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
104vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (V.Vector a)
105vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep
107-- | Constant size vector with separators and index-aware elements.
108--
109-- @ivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
110-- Each element gets its index and should output a value and the index unchanged.
111ivecNSepBy :: Syntax syn => Int -> syn Int (Int, a) -> syn () () -> syn () (V.Vector a)
112ivecNSepBy n e sep = ivecN n $ sibind $ iso el (el . fst)
113 where
114 el k | k < n - 1 = unit ^>> e *** sep >># unit
115 | otherwise = e
117-- | Runtime sized vector. The size can depend on the result of some computation.
118--
119-- @vec e@ describes a vector with elements @e@.
120vec :: Syntax syn => syn () a -> syn Int (V.Vector a)
121vec e = vecSepBy e (siarr id)
123-- | Runtime sized vector with separators. The size can depend on the result of some
124-- computation.
125--
126-- @vecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
127vecSepBy :: Syntax syn => syn () a -> syn () () -> syn Int (V.Vector a)
128vecSepBy e sep = ivecSepBy (unit ^>> second e) sep
130-- | Runtime sized vector with index-aware elements. The size can depend on the result
131-- of some computation.
132--
133-- @ivec e@ describes a vector with elements @e@.
134ivec :: Syntax syn => syn Int (Int, a) -> syn Int (V.Vector a)
135ivec e = ivecSepBy e (siarr id)
137-- | Runtime sized vector with index-aware elements and separators. The size can depend
138-- on the result of some computation.
139--
140-- @ivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
141ivecSepBy :: Syntax syn => syn Int (Int, a) -> syn () () -> syn Int (V.Vector a)
142ivecSepBy e sep = sibind $ iso (\n -> constant n #>> ivecNSepBy n e sep)
143 (\v -> constant (V.length v) #>> ivecNSepBy (V.length v) e sep)
145-- | Constant size unboxed vector with separators.
146--
147-- @uvecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
148uvecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn () a -> syn () () -> syn () (VU.Vector a)
149uvecNSepBy n e sep = uivecNSepBy n (unit ^>> second e) sep
151-- | Constant size unboxed vector with separators and index-aware elements.
152--
153-- @uivecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
154-- Each element gets its index and should output a value and the index unchanged.
155uivecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn Int (Int, a)
156 -> syn () () -> syn () (VU.Vector a)
157uivecNSepBy n e sep = uivecN n $ sibind $ iso el (el . fst)
158 where
159 el k | k < n - 1 = unit ^>> e *** sep >># unit
160 | otherwise = e
162-- | Runtime sized unboxed vector. The size can depend on the result of some computation.
163--
164-- @uvec e@ describes a vector with elements @e@.
165uvec :: (Syntax syn, VU.Unbox a) => syn () a -> syn Int (VU.Vector a)
166uvec e = uvecSepBy e (siarr id)
168-- | Runtime sized unboxed vector with separators. The size can depend on the result of some
169-- computation.
170--
171-- @uvecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
172uvecSepBy :: (Syntax syn, VU.Unbox a) => syn () a -> syn () () -> syn Int (VU.Vector a)
173uvecSepBy e sep = uivecSepBy (unit ^>> second e) sep
175-- | Runtime sized unboxed vector with index-aware elements. The size can depend on the result
176-- of some computation.
177--
178-- @uivec e@ describes a vector with elements @e@.
179uivec :: (Syntax syn, VU.Unbox a) => syn Int (Int, a) -> syn Int (VU.Vector a)
180uivec e = uivecSepBy e (siarr id)
182-- | Runtime sized unboxed vector with index-aware elements and separators. The size can depend
183-- on the result of some computation.
184--
185-- @uivecSepBy e sep@ describes a vector with elements @e@ separated by @sep@.
186uivecSepBy :: (Syntax syn, VU.Unbox a) => syn Int (Int, a)
187 -> syn () () -> syn Int (VU.Vector a)
188uivecSepBy e sep = sibind $ iso (\n -> constant n #>> uivecNSepBy n e sep)
189 (\v -> constant (VU.length v)
190 #>> uivecNSepBy (VU.length v) e sep)