git.iko.soy/syntax
on master help sign in
Added vector combinators.
b6dbe1aPaweł Nowak
Data/Syntax.hs+38−10
compare with master
unifiedsplit
@@ -20,15 +20,17 @@ module Data.Syntax (
20 packed
20 packed
21 ) where
21 ) where
22
22
23−import Prelude hiding (take, takeWhile)
23+import Prelude hiding (take, takeWhile, id, (.))
24−
24+
25+import Control.Category
25−import Control.Category.Reader
26+import Control.Category.Reader
26−import Control.Category.Structures
27+import Control.Category.Structures
27−import Control.Lens.Iso
28+import Control.Lens.Iso
28−import Control.Lens.SemiIso
29+import Control.Lens.SemiIso
29−import Control.SIArrow
30+import Control.SIArrow
30−import Data.MonoTraversable
31+import Data.MonoTraversable
31−import Data.Sequences hiding (take, takeWhile)
32+import Data.Sequences hiding (take, takeWhile, replicate)
33+import Data.Vector (Vector)
32
34
33-- | An isomorphism between a sequence and a list of its elements.
35-- | An isomorphism between a sequence and a list of its elements.
34packed :: IsSequence seq => Iso' seq [Element seq]
36packed :: IsSequence seq => Iso' seq [Element seq]
@@ -37,7 +39,7 @@ packed = iso otoList fromList
37-- | An abstract syntax description based on semi-isomorphisms.
39-- | An abstract syntax description based on semi-isomorphisms.
38--
40--
39-- This class can be implemented by both parsers and printers.
41-- This class can be implemented by both parsers and printers.
40−--
42+--
41-- The usual use is to write a polymorphic syntax description and instantiate it
43-- The usual use is to write a polymorphic syntax description and instantiate it
42-- both as a parser and a printer. Examples are available in 'syntax-example' and
44-- both as a parser and a printer. Examples are available in 'syntax-example' and
43-- 'syntax-example-json' packages.
45-- 'syntax-example-json' packages.
@@ -96,6 +98,32 @@ class ( SIArrow syn
96 takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
98 takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
97 takeTill1 p = takeWhile1 (not . p)
99 takeTill1 p = takeWhile1 (not . p)
98
100
101+ -- | Constant size vector. The default implementation uses lists, but
102+ -- "syntax-attoparsec" and "syntax-printer" override it with an efficient
103+ -- implementation that works on a vector directly.
104+ --
105+ -- @vecN n e@ describes a size @n@ vector with elements @e@.
106+ --
107+ -- Also see 'Data.Syntax.Combinator.vec'.
108+ vecN :: Int -> syn () a -> syn () (Vector a)
109+ vecN n e = packed /$/ sireplicate n e
110+
111+ -- | Constant size vector with index-aware element. The default implementation
112+ -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an
113+ -- efficient implementation that works on a vector directly.
114+ --
115+ -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element
116+ -- gets its index and should output a value and the index unchanged.
117+ --
118+ -- Also see 'Data.Syntax.Combinator.ivec'.
119+ ivecN :: Int -> syn Int (Int, a) -> syn () (Vector a)
120+ ivecN n e = (packed /$/)
121+ $ sisequence
122+ $ map (\(i, e') -> constant i ^>> e'
123+ >>> first (sipure (constant i))
124+ >># unit . swapped)
125+ $ zip [0 .. n-1] (replicate n e)
126+
99 {-# MINIMAL anyChar #-}
127 {-# MINIMAL anyChar #-}
100
128
101instance Syntax syn => Syntax (ReaderCT env syn) where
129instance Syntax syn => Syntax (ReaderCT env syn) where
Data/Syntax/Combinator.hs+85−12
@@ -1,3 +1,6 @@
1+{-# LANGUAGE RankNTypes #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+{-# LANGUAGE FlexibleContexts #-}
1{- |
4{- |
2Module : Data.Syntax.Combinator
5Module : Data.Syntax.Combinator
3Description : Combinators that work with any sequence type.
6Description : Combinators that work with any sequence type.
@@ -9,12 +12,38 @@ Stability : experimental
9
12
10Combinators that work with any sequence type.
13Combinators that work with any sequence type.
11-}
14-}
12−module Data.Syntax.Combinator where
15+module Data.Syntax.Combinator
16+ (
17+ -- * Combinators.
18+ optional,
19+ opt,
20+ opt_,
21+ choice,
22+ eitherOf,
13
23
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
14−import Control.Category.Structures
39+import Control.Category.Structures
15−import Control.Lens
40+import Control.Lens
16−import Control.Lens.SemiIso
41+import Control.Lens.SemiIso
17−import Control.SIArrow
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, (.))
18
47
19-- | One or zero occurences of @f@.
48-- | One or zero occurences of @f@.
20optional :: SIArrow cat => cat () a -> cat () (Maybe a)
49optional :: SIArrow cat => cat () a -> cat () (Maybe a)
@@ -29,6 +58,15 @@ opt_ :: SIArrow cat => cat () () -> cat () ()
29opt_ f = semiIso (const (Left "opt_")) Right /$/ f
58opt_ f = semiIso (const (Left "opt_")) Right /$/ f
30 /+/ sipure id
59 /+/ sipure id
31
60
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+
32-- | @manyTill p end@ applies action p zero or more times until action
70-- | @manyTill p end@ applies action p zero or more times until action
33-- end succeeds, and returns the list of values returned by p.
71-- end succeeds, and returns the list of values returned by p.
34manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
72manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
@@ -43,11 +81,46 @@ sepBy v s = sepBy1 v s /+/ sipure _Empty
43sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
81sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
44sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
82sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
45
83
46−-- | Tries to apply the actions in the list in order, until one of
84+-- | Constant size vector with separators.
47−-- them succeeds. Returns the value of the succeeding action.
85+--
48−choice :: SIArrow cat => [cat () a] -> cat () a
86+-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
49−choice = foldr (/+/) (sifail "choice: all alternatives failed")
87+vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (Vector a)
88+vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep
50
89
51−-- | Combine two alternatives.
90+-- | Constant size vector with separators and index-aware elements.
52−eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
91+--
53−eitherOf a b = _Left /$/ a /+/ _Right /$/ b
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)