@@ -1,7 +1,6 @@
1+{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE FlexibleContexts #-}
23{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE FunctionalDependencies #-}
54{- |
65Module : Data.Syntax
76Description : Abstract syntax description.
@@ -11,22 +10,28 @@ License : MIT
1110Maintainer : Paweł Nowak <pawel834@gmail.com>
1211Stability : experimental
1312
14−Abstract syntax descriptions based on semi-isomorphisms.
13+Reversible parsing and pretty-printing.
1514-}
1615module Data.Syntax (
1716 -- * Syntax.
1817 Syntax(..),
18+ Isolable(..),
1919 -- * Common isomorphisms.
2020 packed
2121 ) where
2222
23−import Prelude hiding (take, takeWhile)
23+import Prelude hiding (take, takeWhile, id, (.))
2424
25−import Control.Lens
26−import Control.Lens.SemiIso
27−import Data.MonoTraversable
28−import Data.SemiIsoFunctor
29−import Data.Sequences hiding (take, takeWhile)
25+import Control.Category
26+import Control.Category.Reader
27+import Control.Category.Structures
28+import Control.Lens.Iso
29+import Control.Lens.SemiIso
30+import Control.SIArrow
31+import Data.MonoTraversable
32+import Data.Sequences hiding (take, takeWhile, replicate)
33+import qualified Data.Vector as V
34+import qualified Data.Vector.Unboxed as VU
3035
3136-- | An isomorphism between a sequence and a list of its elements.
3237packed :: IsSequence seq => Iso' seq [Element seq]
@@ -34,91 +39,150 @@ packed = iso otoList fromList
3439
3540-- | An abstract syntax description based on semi-isomorphisms.
3641--
37−-- This class can be implemented by both parsers and printers (and maybe more?).
38−--
39−-- The usual use is to write a polymorphic syntax description and instantiate it
40−-- both as a parser and a printer. An example syntax description:
42+-- This class can be implemented by both parsers and printers.
4143--
42−-- > | A simple untyped lambda calculus.
43−-- > data AST = Var Text
44−-- > | App AST AST
45−-- > | Abs Text AST
46−-- > deriving (Show)
47−-- >
48−-- > $(makePrisms ''AST)
49−-- >
50−-- > -- | A variable name.
51−-- > name :: Syntax syn Text => syn Text
52−-- > name = S.takeWhile1 isAlphaNum
53−-- >
54−-- > -- | Encloses a symbol in parentheses.
55−-- > parens :: Syntax syn Text => syn a -> syn a
56−-- > parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'
57−-- >
58−-- > -- | An atom is a variable or an expression in parentheses.
59−-- > atom :: Syntax syn Text => syn AST
60−-- > atom = _Var /$/ name
61−-- > /|/ parens expr
62−-- >
63−-- > -- | An expression of our lambda calculus.
64−-- > expr :: Syntax syn Text => syn AST
65−-- > expr = _App /$/ atom /* S.spaces1 /*/ atom
66−-- > /|/ _Abs /$/ S.char '\\' /* S.spaces_
67−-- > */ name /* S.spaces
68−-- > /* S.string "->" /* S.spaces
69−-- > /*/ expr
70−-- > /|/ atom
44+-- The usual use is to write a polymorphic syntax description and instantiate it
45+-- both as a parser and a printer. Examples are available in 'syntax-example' and
46+-- 'syntax-example-json' packages.
7147--
7248-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
73−class ( SemiIsoAlternative syn
74− , IsSequence seq
75− , Eq seq
76− , Eq (Element seq))
77− => Syntax syn seq | syn -> seq
49+class ( SIArrow syn
50+ , IsSequence (Seq syn)
51+ , Eq (Seq syn)
52+ , Eq (Element (Seq syn)))
53+ => Syntax syn
7854 where
79−
55+ -- | The sequence type used by this syntax.
56+ type Seq syn :: *
57+
8058 -- | Any character.
81− anyChar :: syn (Element seq)
59+ anyChar :: syn () (Element (Seq syn))
8260
8361 -- | A specific character.
84− char :: Element seq -> syn ()
85− char c = exact c /$/ anyChar
62+ char :: Element (Seq syn) -> syn () ()
63+ char c = rev (exact c) /$/ anyChar
8664
8765 -- | Any character except the given one.
88− notChar :: Element seq -> syn (Element seq)
89− notChar c = filtered (/= c) /$/ anyChar
66+ notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
67+ notChar c = bifiltered (/= c) /$/ anyChar
9068
9169 -- | Any character satisfying a predicate.
92− satisfy :: (Element seq -> Bool) -> syn (Element seq)
93− satisfy p = filtered p /$/ anyChar
70+ satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
71+ satisfy p = bifiltered p /$/ anyChar
9472
9573 -- | Transforms a character using a SemiIso and filters out values
9674 -- not satisfying the predicate.
97− satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a
98− satisfyWith ai p = filtered p . ai /$/ anyChar
75+ satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a
76+ satisfyWith ai p = bifiltered p . ai /$/ anyChar
9977
10078 -- | A specific string.
101− string :: seq -> syn ()
102− string s = exact s /$/ take (olength s)
79+ string :: Seq syn -> syn () ()
80+ string s = rev (exact s) /$/ take (olength s)
10381
10482 -- | A string of length @n@.
105− take :: Int -> syn seq
83+ take :: Int -> syn () (Seq syn)
10684 take n = packed /$/ sireplicate n anyChar
10785
10886 -- | Maximal string which elements satisfy a predicate.
109− takeWhile :: (Element seq -> Bool) -> syn seq
87+ takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
11088 takeWhile p = packed /$/ simany (satisfy p)
11189
11290 -- | Maximal non-empty string which elements satisfy a predicate.
113− takeWhile1 :: (Element seq -> Bool) -> syn seq
91+ takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
11492 takeWhile1 p = packed /$/ sisome (satisfy p)
11593
11694 -- | Maximal string which elements do not satisfy a predicate.
117− takeTill :: (Element seq -> Bool) -> syn seq
95+ takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
11896 takeTill p = takeWhile (not . p)
11997
12098 -- | Maximal non-empty string which elements do not satisfy a predicate.
121− takeTill1 :: (Element seq -> Bool) -> syn seq
99+ takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
122100 takeTill1 p = takeWhile1 (not . p)
123101
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+
124154 {-# MINIMAL anyChar #-}
155+
156+instance Syntax syn => Syntax (ReaderCT env syn) where
157+ type Seq (ReaderCT env syn) = Seq syn
158+ anyChar = clift anyChar
159+ char = clift . char
160+ notChar = clift . notChar
161+ satisfy = clift . satisfy
162+ satisfyWith ai = clift . satisfyWith ai
163+ string = clift . string
164+ take = clift . take
165+ takeWhile = clift . takeWhile
166+ takeWhile1 = clift . takeWhile1
167+ takeTill = clift . takeTill
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
173+
174+-- | Execute a computation in an isolated context.
175+--
176+-- The motivating example: you want to write a function
177+--
178+-- > serializeList :: Syntax syn => syn () a -> syn () [a]
179+--
180+-- Notice that we cannot just use simany, because the first @syn () a@
181+-- could eat the entire sequence (even though we printed more than 1 value!), so
182+-- we have to insert some kind of separators between the element. But how can we
183+-- be sure that @syn () a@ will not eat our separators? We can't! Thats why we
184+-- have to do the parsing in two stages: first extract the sequence between separators,
185+-- then run the @syn () a@ on this sequence.
186+class Syntax syn => Isolable syn where
187+ -- | Turns a computation into one executed in an isolated context.
188+ isolate :: syn () b -> syn (Seq syn) b