@@ -1,6 +1,7 @@
1−{-# LANGUAGE TypeFamilies #-}
21{-# LANGUAGE FlexibleContexts #-}
32{-# LANGUAGE DefaultSignatures #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE FunctionalDependencies #-}
45{- |
56Module : Data.Syntax
67Description : Abstract syntax description.
@@ -10,28 +11,22 @@ License : MIT
1011Maintainer : Paweł Nowak <pawel834@gmail.com>
1112Stability : experimental
1213
13−Reversible parsing and pretty-printing.
14+Abstract syntax descriptions based on semi-isomorphisms.
1415-}
1516module Data.Syntax (
1617 -- * Syntax.
1718 Syntax(..),
18− Isolable(..),
1919 -- * Common isomorphisms.
2020 packed
2121 ) where
2222
23−import Prelude hiding (take, takeWhile, id, (.))
23+import Prelude hiding (take, takeWhile)
2424
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
25+import Control.Lens
26+import Control.Lens.SemiIso
27+import Data.MonoTraversable
28+import Data.SemiIsoFunctor
29+import Data.Sequences hiding (take, takeWhile)
3530
3631-- | An isomorphism between a sequence and a list of its elements.
3732packed :: IsSequence seq => Iso' seq [Element seq]
@@ -39,150 +34,95 @@ packed = iso otoList fromList
3934
4035-- | An abstract syntax description based on semi-isomorphisms.
4136--
42−-- This class can be implemented by both parsers and printers.
43−--
37+-- This class can be implemented by both parsers and printers (and maybe more?).
38+--
4439-- 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.
40+-- both as a parser and a printer. An example syntax description:
41+--
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+-- > --| Parses a list of applications.
64+-- > apps :: Syntax syn Text => syn AST
65+-- > apps = bifoldl1 (attemptAp_ _App) /$/ S.sepBy1 atom S.spaces1
66+-- >
67+-- > -- | An expression of our lambda calculus.
68+-- > expr :: Syntax syn Text => syn AST
69+-- > expr = _Abs /$/ S.char '\\' /* S.spaces_
70+-- > */ name /* S.spaces
71+-- > /* S.string "->" /* S.spaces
72+-- > /*/ expr
73+-- > /|/ apps
4774--
4875-- Methods of this class try to mimic "Data.Attoparsec.Text" interface.
49−class ( SIArrow syn
50− , IsSequence (Seq syn)
51− , Eq (Seq syn)
52− , Eq (Element (Seq syn)))
53− => Syntax syn
76+class ( SemiIsoAlternative syn
77+ , SemiIsoMonad syn
78+ , IsSequence seq
79+ , Eq seq
80+ , Eq (Element seq))
81+ => Syntax syn seq | syn -> seq
5482 where
55− -- | The sequence type used by this syntax.
56− type Seq syn :: *
5783
5884 -- | Any character.
59− anyChar :: syn () (Element (Seq syn))
85+ anyChar :: syn (Element seq)
6086
6187 -- | A specific character.
62− char :: Element (Seq syn) -> syn () ()
63− char c = rev (exact c) /$/ anyChar
88+ char :: Element seq -> syn ()
89+ char c = exact c /$/ anyChar
6490
6591 -- | Any character except the given one.
66− notChar :: Element (Seq syn) -> syn () (Element (Seq syn))
67− notChar c = bifiltered (/= c) /$/ anyChar
92+ notChar :: Element seq -> syn (Element seq)
93+ notChar c = filtered (/= c) /$/ anyChar
6894
6995 -- | Any character satisfying a predicate.
70− satisfy :: (Element (Seq syn) -> Bool) -> syn () (Element (Seq syn))
71− satisfy p = bifiltered p /$/ anyChar
96+ satisfy :: (Element seq -> Bool) -> syn (Element seq)
97+ satisfy p = filtered p /$/ anyChar
7298
7399 -- | Transforms a character using a SemiIso and filters out values
74100 -- not satisfying the predicate.
75− satisfyWith :: ASemiIso' a (Element (Seq syn)) -> (a -> Bool) -> syn () a
76− satisfyWith ai p = bifiltered p . ai /$/ anyChar
101+ satisfyWith :: ASemiIso' a (Element seq) -> (a -> Bool) -> syn a
102+ satisfyWith ai p = filtered p . ai /$/ anyChar
77103
78104 -- | A specific string.
79− string :: Seq syn -> syn () ()
80− string s = rev (exact s) /$/ take (olength s)
105+ string :: seq -> syn ()
106+ string s = exact s /$/ take (olength s)
81107
82108 -- | A string of length @n@.
83− take :: Int -> syn () (Seq syn)
109+ take :: Int -> syn seq
84110 take n = packed /$/ sireplicate n anyChar
85111
86112 -- | Maximal string which elements satisfy a predicate.
87− takeWhile :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
113+ takeWhile :: (Element seq -> Bool) -> syn seq
88114 takeWhile p = packed /$/ simany (satisfy p)
89115
90116 -- | Maximal non-empty string which elements satisfy a predicate.
91− takeWhile1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
117+ takeWhile1 :: (Element seq -> Bool) -> syn seq
92118 takeWhile1 p = packed /$/ sisome (satisfy p)
93119
94120 -- | Maximal string which elements do not satisfy a predicate.
95− takeTill :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
121+ takeTill :: (Element seq -> Bool) -> syn seq
96122 takeTill p = takeWhile (not . p)
97123
98124 -- | Maximal non-empty string which elements do not satisfy a predicate.
99− takeTill1 :: (Element (Seq syn) -> Bool) -> syn () (Seq syn)
125+ takeTill1 :: (Element seq -> Bool) -> syn seq
100126 takeTill1 p = takeWhile1 (not . p)
101127
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−
154128 {-# 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