git.iko.soy/syntax
on master help sign in
swap
64f67b78 ahead, 0 behind
Data/Syntax.hs+69−10
since splitsnapshots
unifiedsplit
@@ -20,15 +20,18 @@ 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 qualified Data.Vector as V
34+import qualified Data.Vector.Unboxed as VU
32
35
33-- | An isomorphism between a sequence and a list of its elements.
36-- | An isomorphism between a sequence and a list of its elements.
34packed :: IsSequence seq => Iso' seq [Element seq]
37packed :: IsSequence seq => Iso' seq [Element seq]
@@ -37,7 +40,7 @@ packed = iso otoList fromList
37-- | An abstract syntax description based on semi-isomorphisms.
40-- | An abstract syntax description based on semi-isomorphisms.
38--
41--
39-- This class can be implemented by both parsers and printers.
42-- This class can be implemented by both parsers and printers.
40−--
43+--
41-- The usual use is to write a polymorphic syntax description and instantiate it
44-- 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
45-- both as a parser and a printer. Examples are available in 'syntax-example' and
43-- 'syntax-example-json' packages.
46-- 'syntax-example-json' packages.
@@ -96,6 +99,58 @@ class ( SIArrow syn
96 takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
99 takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
97 takeTill1 p = takeWhile1 (not . p)
100 takeTill1 p = takeWhile1 (not . p)
98
101
102+ -- | Constant size vector. The default implementation uses lists, but
103+ -- "syntax-attoparsec" and "syntax-printer" override it with an efficient
104+ -- implementation that works on a vector directly.
105+ --
106+ -- @vecN n e@ describes a size @n@ vector with elements @e@.
107+ --
108+ -- Also see 'Data.Syntax.Combinator.vec'.
109+ vecN :: Int -> syn () a -> syn () (V.Vector a)
110+ vecN n e = packed /$/ sireplicate n e
111+
112+ -- | Constant size vector with index-aware element. The default implementation
113+ -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an
114+ -- efficient implementation that works on a vector directly.
115+ --
116+ -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element
117+ -- gets its index and should output a value and the index unchanged.
118+ --
119+ -- Also see 'Data.Syntax.Combinator.ivec'.
120+ ivecN :: Int -> syn Int (Int, a) -> syn () (V.Vector a)
121+ ivecN n e = (packed /$/)
122+ $ sisequence
123+ $ map (\(i, e') -> constant i ^>> e'
124+ >>> first (sipure (constant i))
125+ >># unit . swapped)
126+ $ zip [0 .. n-1] (replicate n e)
127+
128+ -- | Constant size unboxed vector. The default implementation uses lists, but
129+ -- "syntax-attoparsec" and "syntax-printer" override it with an efficient
130+ -- implementation that works on a vector directly.
131+ --
132+ -- @vecN n e@ describes a size @n@ vector with elements @e@.
133+ --
134+ -- Also see 'Data.Syntax.Combinator.vec'.
135+ uvecN :: VU.Unbox a => Int -> syn () a -> syn () (VU.Vector a)
136+ uvecN n e = packed /$/ sireplicate n e
137+
138+ -- | Constant size unboxed vector with index-aware element. The default implementation
139+ -- uses lists, but "syntax-attoparsec" and "syntax-printer" override it with an
140+ -- efficient implementation that works on a vector directly.
141+ --
142+ -- @ivecN n e@ describes a size @n@ vector with elements @e@. Each element
143+ -- gets its index and should output a value and the index unchanged.
144+ --
145+ -- Also see 'Data.Syntax.Combinator.ivec'.
146+ uivecN :: VU.Unbox a => Int -> syn Int (Int, a) -> syn () (VU.Vector a)
147+ uivecN n e = (packed /$/)
148+ $ sisequence
149+ $ map (\(i, e') -> constant i ^>> e'
150+ >>> first (sipure (constant i))
151+ >># unit . swapped)
152+ $ zip [0 .. n-1] (replicate n e)
153+
99 {-# MINIMAL anyChar #-}
154 {-# MINIMAL anyChar #-}
100
155
101instance Syntax syn => Syntax (ReaderCT env syn) where
156instance Syntax syn => Syntax (ReaderCT env syn) where
@@ -111,6 +166,10 @@ instance Syntax syn => Syntax (ReaderCT env syn) where
111 takeWhile1 = clift . takeWhile1
166 takeWhile1 = clift . takeWhile1
112 takeTill = clift . takeTill
167 takeTill = clift . takeTill
113 takeTill1 = clift . takeTill1
168 takeTill1 = clift . takeTill1
169+ vecN n e = ReaderCT $ vecN n . runReaderCT e
170+ ivecN n e = ReaderCT $ ivecN n . runReaderCT e
171+ uvecN n e = ReaderCT $ uvecN n . runReaderCT e
172+ uivecN n e = ReaderCT $ uivecN n . runReaderCT e
114
173
115-- | Execute a computation in an isolated context.
174-- | Execute a computation in an isolated context.
116--
175--
Data/Syntax/Combinator.hs+149−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,50 @@ 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+ -- * Arrowized combinators.
30+ takeArr,
31+
32+ -- * Vectors.
33+ vecNSepBy,
34+ ivecNSepBy,
35+ vec,
36+ vecSepBy,
37+ ivec,
38+ ivecSepBy,
39+
40+ -- * Unboxed vectors.
41+ uvecNSepBy,
42+ uivecNSepBy,
43+ uvec,
44+ uvecSepBy,
45+ uivec,
46+ uivecSepBy
47+ ) where
48+
49+import Control.Category
14−import Control.Category.Structures
50+import Control.Category.Structures
15−import Control.Lens
51+import Control.Lens
16−import Control.Lens.SemiIso
52+import Control.Lens.SemiIso
17−import Control.SIArrow
53+import Control.SIArrow
54+import qualified Data.MonoTraversable as Seq
55+import Data.Syntax
56+import qualified Data.Vector as V
57+import qualified Data.Vector.Unboxed as VU
58+import Prelude hiding (id, (.), take)
18
59
19-- | One or zero occurences of @f@.
60-- | One or zero occurences of @f@.
20optional :: SIArrow cat => cat () a -> cat () (Maybe a)
61optional :: SIArrow cat => cat () a -> cat () (Maybe a)
@@ -29,6 +70,15 @@ opt_ :: SIArrow cat => cat () () -> cat () ()
29opt_ f = semiIso (const (Left "opt_")) Right /$/ f
70opt_ f = semiIso (const (Left "opt_")) Right /$/ f
30 /+/ sipure id
71 /+/ sipure id
31
72
73+-- | Tries to apply the actions in the list in order, until one of
74+-- them succeeds. Returns the value of the succeeding action.
75+choice :: SIArrow cat => [cat () a] -> cat () a
76+choice = foldr (/+/) (sifail "choice: all alternatives failed")
77+
78+-- | Combine two alternatives.
79+eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
80+eitherOf a b = _Left /$/ a /+/ _Right /$/ b
81+
32-- | @manyTill p end@ applies action p zero or more times until action
82-- | @manyTill p end@ applies action p zero or more times until action
33-- end succeeds, and returns the list of values returned by p.
83-- end succeeds, and returns the list of values returned by p.
34manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
84manyTill :: SIArrow cat => cat () a -> cat () () -> cat () [a]
@@ -43,11 +93,98 @@ sepBy v s = sepBy1 v s /+/ sipure _Empty
43sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
93sepBy1 :: SIArrow cat => cat () a -> cat () () -> cat () [a]
44sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
94sepBy1 v s = _Cons /$/ v /*/ (s */ sepBy1 v s /+/ sipure _Empty)
45
95
46−-- | Tries to apply the actions in the list in order, until one of
96+-- | A string of given length.
47−-- them succeeds. Returns the value of the succeeding action.
97+takeArr :: Syntax syn => syn Int (Seq syn)
48−choice :: SIArrow cat => [cat () a] -> cat () a
98+takeArr = sibind $ iso (\n -> constant n #>> take n)
49−choice = foldr (/+/) (sifail "choice: all alternatives failed")
99+ (\s -> constant (Seq.olength s) #>> take (Seq.olength s))
50
100
51−-- | Combine two alternatives.
101+-- | Constant size vector with separators.
52−eitherOf :: SIArrow cat => cat () a -> cat () b -> cat () (Either a b)
102+--
53−eitherOf a b = _Left /$/ a /+/ _Right /$/ b
103+-- @vecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
104+vecNSepBy :: Syntax syn => Int -> syn () a -> syn () () -> syn () (V.Vector a)
105+vecNSepBy n e sep = ivecNSepBy n (unit ^>> second e) sep
106+
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.
111+ivecNSepBy :: Syntax syn => Int -> syn Int (Int, a) -> syn () () -> syn () (V.Vector a)
112+ivecNSepBy 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
116+
117+-- | Runtime sized vector. The size can depend on the result of some computation.
118+--
119+-- @vec e@ describes a vector with elements @e@.
120+vec :: Syntax syn => syn () a -> syn Int (V.Vector a)
121+vec e = vecSepBy e (siarr id)
122+
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@.
127+vecSepBy :: Syntax syn => syn () a -> syn () () -> syn Int (V.Vector a)
128+vecSepBy e sep = ivecSepBy (unit ^>> second e) sep
129+
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@.
134+ivec :: Syntax syn => syn Int (Int, a) -> syn Int (V.Vector a)
135+ivec e = ivecSepBy e (siarr id)
136+
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@.
141+ivecSepBy :: Syntax syn => syn Int (Int, a) -> syn () () -> syn Int (V.Vector a)
142+ivecSepBy e sep = sibind $ iso (\n -> constant n #>> ivecNSepBy n e sep)
143+ (\v -> constant (V.length v) #>> ivecNSepBy (V.length v) e sep)
144+
145+-- | Constant size unboxed vector with separators.
146+--
147+-- @uvecNSepBy n e sep@ describes a size @n@ vector with elements @e@ separated by @sep@.
148+uvecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn () a -> syn () () -> syn () (VU.Vector a)
149+uvecNSepBy n e sep = uivecNSepBy n (unit ^>> second e) sep
150+
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.
155+uivecNSepBy :: (Syntax syn, VU.Unbox a) => Int -> syn Int (Int, a)
156+ -> syn () () -> syn () (VU.Vector a)
157+uivecNSepBy 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
161+
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@.
165+uvec :: (Syntax syn, VU.Unbox a) => syn () a -> syn Int (VU.Vector a)
166+uvec e = uvecSepBy e (siarr id)
167+
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@.
172+uvecSepBy :: (Syntax syn, VU.Unbox a) => syn () a -> syn () () -> syn Int (VU.Vector a)
173+uvecSepBy e sep = uivecSepBy (unit ^>> second e) sep
174+
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@.
179+uivec :: (Syntax syn, VU.Unbox a) => syn Int (Int, a) -> syn Int (VU.Vector a)
180+uivec e = uivecSepBy e (siarr id)
181+
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@.
186+uivecSepBy :: (Syntax syn, VU.Unbox a) => syn Int (Int, a)
187+ -> syn () () -> syn Int (VU.Vector a)
188+uivecSepBy e sep = sibind $ iso (\n -> constant n #>> uivecNSepBy n e sep)
189+ (\v -> constant (VU.length v)
190+ #>> uivecNSepBy (VU.length v) e sep)
syntax.cabal+7−7
@@ -4,9 +4,10 @@ synopsis: Reversible parsing and pretty-printing.
4description:
4description:
5 "syntax" allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.
5 "syntax" allows you to write a single syntax description and instantiate is both as a parser and a pretty printer.
6 .
6 .
7− Syntax descriptions are written in applicative or arrow style. The library uses a custom hierarchy, provided by the
7+ Syntax descriptions are written in applicative or arrow style. The library uses a custom typeclass hierarchy, provided
8− "semi-iso" package. Most of the time you will be using operators like '/$/' and '/*/', just like parser combinators.
8+ by the "semi-iso" package. Most of the time you will be using operators like '/$/', '/*/' and '/+/' (= '<|>'), just
9− When more power is needed - e.g. when the syntax depends on the parsed or printed value - you turn to arrows.
9+ like parser combinators. When more power is needed - e.g. when the syntax depends on the parsed or printed value -
10+ you turn to arrows.
10 .
11 .
11 Semi-isomorphisms from "semi-iso" are the basic building block of syntax descriptions. I recommend reading
12 Semi-isomorphisms from "semi-iso" are the basic building block of syntax descriptions. I recommend reading
12 the hackage page of "semi-iso" first, as it contains much more information.
13 the hackage page of "semi-iso" first, as it contains much more information.
@@ -19,11 +20,10 @@ description:
19 Advanced formatting and parsing (for example indentation, haskell layout rule) is implemented as category transformers
20 Advanced formatting and parsing (for example indentation, haskell layout rule) is implemented as category transformers
20 (similar to monad transformers). Currently only simple indentation is implemented (in "Data.Syntax.Indent") - basically
21 (similar to monad transformers). Currently only simple indentation is implemented (in "Data.Syntax.Indent") - basically
21 a reader category transformer that tracks current indentation level. I plan on implementing Haskell layout rule in the
22 a reader category transformer that tracks current indentation level. I plan on implementing Haskell layout rule in the
22− future (as a reusable transformer).
23+ future.
23 .
24 .
24− Note that the library can work with both text and binary data. There are no binary combinators implemented - yet.
25+ The library can work with both text and binary data. Alas, there are no binary combinators implemented yet.
25− Alas, these are not only useful combinators missing! I will slowly but steadily implement them over time
26− (but these category transformers look so much more interesting for now ;).
26+ I will implement them when i have the time (but these category transformers look so much more interesting for now ;).
27 .
27 .
28 EXAMPLES! See @syntax-example@ and @syntax-example-json@ for examples.
28 EXAMPLES! See @syntax-example@ and @syntax-example-json@ for examples.
29 .
29 .