invertible-syntax (empty) → 0.1
raw patch · 9 files changed
+532/−0 lines, 9 filesdep +basedep +partial-isomorphismssetup-changed
Dependencies added: base, partial-isomorphisms
Files
- Example.lhs +199/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- invertible-syntax.cabal +42/−0
- src/Text/Syntax.hs +7/−0
- src/Text/Syntax/Classes.hs +26/−0
- src/Text/Syntax/Combinators.hs +131/−0
- src/Text/Syntax/Parser/Naive.hs +51/−0
- src/Text/Syntax/Printer/Naive.hs +44/−0
+ Example.lhs view
@@ -0,0 +1,199 @@+% An invertible syntax description of a small example language+% Tillmann Rendel+% April to November, 2010++Introduction+============++In this example file, the packages `partial-isomorphisms` and+`invertible-syntax` are used to describe the syntax of a small+language. This syntax descriptions can be used for both parsing+and printing. An earlier version of this document was published+as part of++ * Tillmann Rendel and Klaus Ostermann. + Invertible syntax descriptions: + Unifying parsing and pretty printing. + Haskell symposium, 2010.+ + http://www.informatik.uni-marburg.de/~rendel/unparse/++Abstract Syntax+===============++The abstract syntax of the example language is encoded with+abstract data types.++%if False++> {-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction, RelaxedPolyRec #-}+> module Example where+>+> import Prelude (Show (..), Read (..), Eq (..), String, Integer,+> map, (++), Maybe (..), ($), fst, not, elem, +> notElem, reads, Char)+> +> import Control.Category (id, (.))+>+> import Control.Monad (mplus)+>+> import Data.Char (isLetter, isDigit)+>+> import qualified Text.ParserCombinators.Parsec as Parsec+>+> import Control.Isomorphism.Partial+> import Control.Isomorphism.Partial.TH+> import Text.Syntax++%endif++> data Expression+> = Variable String+> | Literal Integer+> | BinOp Expression Operator Expression+> | IfZero Expression Expression Expression+> deriving (Show, Eq)+>+> data Operator+> = AddOp +> | MulOp +> deriving (Show, Eq)++The Template Haskell macro `defineIsomorphisms` is used to+generate partial isomorphisms for the data constructors.++> $(defineIsomorphisms ''Expression)+> $(defineIsomorphisms ''Operator)++Syntax descriptions+-------------------++The first character of an identifier is a letter, the remaining+characters are letters or digits. Keywords are excluded.++> keywords = ["ifzero", "else"]++> letter, digit :: Syntax delta => delta Char+> letter = subset isLetter <$> token+> digit = subset isDigit <$> token++> identifier +> = subset (`notElem` keywords) . cons <$> +> letter <*> many (letter <|> digit)++Keywords are literal texts but not identifiers.++> keyword :: Syntax delta => String -> delta ()+> keyword s = inverse right <$> (identifier <+> text s)++Integer literals are sequences of digits, processed by read+resp. show. ++> integer :: Syntax delta => delta Integer+> integer = Iso read' show' <$> many digit where+> read' s = case [ x | (x, "") <- reads s ] of+> [] -> Nothing+> (x : _) -> Just x+> +> show' x = Just (show x)++A parenthesized expressions is an expression between parentheses.++> parens = between (text "(") (text ")")++The syntax descriptions `ops` handles operators of arbitrary +priorities. The priorities are handled further below. ++> ops = mulOp <$> text "*"+> <|> addOp <$> text "+"++We allow optional spaces around operators.++> spacedOps = between optSpace optSpace ops++The priorities of the operators are defined in this function. ++> priority :: Operator -> Integer+> priority MulOp = 1+> priority AddOp = 2++Finally, we can define the `expression` syntax description. ++> expression = exp 2 where++> exp 0 = literal <$> integer+> <|> variable <$> identifier+> <|> ifZero <$> ifzero+> <|> parens (skipSpace *> expression <* skipSpace)+> exp 1 = chainl1 (exp 0) spacedOps (binOpPrio 1)+> exp 2 = chainl1 (exp 1) spacedOps (binOpPrio 2)++> ifzero = keyword "ifzero" +> *> optSpace *> parens (expression)+> <*> optSpace *> parens (expression) +> <*> optSpace *> keyword "else" +> *> optSpace *> parens (expression)+> +> binOpPrio n +> = binOp . subset (\(x, (op, y)) -> priority op == n)++This syntax description is correctly processing binary operators+according to their priority during both parsing and printing.+Similar to the standard idiom for expression grammars with infix+operators, the description of `expression` is layered into+several `exp i` descriptions, one for each priority level. The+syntax description combinator `chainl1` parses a left-recursive+tree of expressions, separated by infix operators. Note that the+syntax descriptions `exp 1` to `exp 2` both use the same syntax+descriptions `ops` which describes all operators, not just the+operators of a specific priority. Instead, the correct operators+are selected by the `binOpPrio n` partial isomorphisms. The+partial isomorphism `binOpPrio n` is a subrelation of+`binOp` which only accepts operators of the priority level `n`.++While parsing a high-priority expressions, the partial+isomorphism will reject low-priority operators, so that the+parser stops processing the high-priority subexpression and+backtracks to continue a surrounding lower-priority expression.+When the parser encounters a set of parentheses, it allows+low-priority expressions again inside.++Similarly, during printing a high-priority expression,+the partial isomorphism will reject low-priority operators,+so that the printer continues to the description of `exp 0`+and inserts a matching set of parentheses.++All taken together, the partial isomorphisms `binOpPrio n` not+only control the processing of operator priorities for both+printing and parsing, but also ensure that parentheses are+printed exactly where they are needed so that the printer output+can be correctly parsed again. This way, correct round trip+behavior is automatically guaranteed. ++The following evaluation shows that operator priorities are+respected while parsing.++ > parse expression "ifzero (2+3*4) (5) else (6)"+ [IfZero (BinOp (Literal 2) AddOp + (BinOp (Literal 3) MulOp (Literal 4))) + (Literal 5) + (Literal 6)]++And this evaluation shows that needed parentheses are inserted+during printing.+ + > print expression + (BinOp (BinOp (Literal 7) AddOp + (Literal 8)) MulOp + (Literal 9))+ Just "(7 + 8) * 9"++By implementing whitespace handling and associativity and+priorities for infix operators, we have shown how to implement+two non-trivial aspects of syntax descriptions which occur in+existing parsers and pretty printers for formal languages. We+have shown how to implement well-known combinators like `between`+and `chainl1` in our framework, which enabled us to write the+syntax descriptions in a style which closely resembles how one+can program with monadic or applicative parser combinator+libraries.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2010, Tillmann Rendel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Tillmann Rendel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ invertible-syntax.cabal view
@@ -0,0 +1,42 @@+Name: invertible-syntax +Version: 0.1 +Synopsis: Invertible syntax descriptions for both parsing and pretty printing. +Description: Invertible syntax descriptions as a common + interface for parser combinator and pretty + printing libraries, as described in the paper: + . + Tillmann Rendel and Klaus Ostermann. + Invertible Syntax Descriptions: + Unifying Parsing and Pretty Printing. + In /Proc. of Haskell Symposium/, 2010. + . + The distribution contains a file + /Example.lhs/ with the example grammar from + the paper. + . + The paper also describes partial isomorphisms. + These are distributed separately in the + /partial-isomorphism/ package. +Homepage: http://www.informatik.uni-marburg.de/~rendel/unparse +License: BSD3 +License-file: LICENSE +Author: Tillmann Rendel +Maintainer: rendel@informatik.uni-marburg.de +-- Copyright: +Category: Text +Build-type: Simple +Extra-source-files: Example.lhs +Cabal-version: >=1.2 + +Library + Hs-source-dirs: src + Exposed-modules: Text.Syntax, + Text.Syntax.Classes, + Text.Syntax.Combinators, + Text.Syntax.Parser.Naive, + Text.Syntax.Printer.Naive + Build-depends: base >= 3 && < 5, + partial-isomorphisms == 0.1 + -- Other-modules: + -- Build-tools: +
+ src/Text/Syntax.hs view
@@ -0,0 +1,7 @@+module Text.Syntax+ ( module Text.Syntax.Classes+ , module Text.Syntax.Combinators+ ) where++import Text.Syntax.Classes+import Text.Syntax.Combinators
+ src/Text/Syntax/Classes.hs view
@@ -0,0 +1,26 @@+module Text.Syntax.Classes where++import Prelude ()++import Control.Isomorphism.Partial (IsoFunctor)+import Data.Eq (Eq)+import Data.Char (Char)++infixl 3 <|> +infixr 6 <*>++class ProductFunctor f where+ (<*>) :: f alpha -> f beta -> f (alpha, beta)++class Alternative f where+ (<|>) :: f alpha -> f alpha -> f alpha+ empty :: f alpha++class (IsoFunctor delta, ProductFunctor delta, Alternative delta) + => Syntax delta where+ -- (<$>) :: Iso alpha beta -> delta alpha -> delta beta+ -- (<*>) :: delta alpha -> delta beta -> delta (alpha, beta)+ -- (<|>) :: delta alpha -> delta alpha -> delta alpha+ -- empty :: delta alpha+ pure :: Eq alpha => alpha -> delta alpha+ token :: delta Char
+ src/Text/Syntax/Combinators.hs view
@@ -0,0 +1,131 @@+module Text.Syntax.Combinators+ ( -- * Lexemes+ text+ , comma+ , dot+ -- * Repetition+ , many+ , many1+ , sepBy+ , chainl1+ -- * Sequencing+ , (*>)+ , (<*)+ , between+ -- * Alternation+ , (<+>)+ , optional+ -- * Whitespace+ , skipSpace+ , sepSpace+ , optSpace) where++import Prelude ()++import Control.Category ((.))+import Control.Isomorphism.Partial.Constructors (nothing, just, nil, cons, left, right)+import Control.Isomorphism.Partial.Derived (foldl)+import Control.Isomorphism.Partial.Prim (Iso, (<$>), inverse, element, unit, commute, ignore) ++import Data.Char (String)+import Data.Maybe (Maybe)+import Data.Either (Either)++import Text.Syntax.Classes++-- derived combinators+many :: Syntax delta => delta alpha -> delta [alpha]+many p + = nil <$> pure ()+ <|> cons <$> p + <*> many p ++many1 :: Syntax delta => delta alpha -> delta [alpha]+many1 p = cons <$> p <*> many p+ +infixl 4 <+>++(<+>) :: Syntax delta => delta alpha -> delta beta -> delta (Either alpha beta)+p <+> q = (left <$> p) <|> (right <$> q) ++-- | `text` parses\/prints a fixed text and consumes\/produces a unit value.+text :: Syntax delta => String -> delta ()+text [] = pure ()+text (c:cs) = inverse (element ((), ())) + <$> (inverse (element c) <$> token) + <*> text cs++-- | This variant of `<*>` ignores its left result.+-- In contrast to its counterpart derived from the `Applicative` class, the ignored+-- parts have type `delta ()` rather than `delta beta` because otherwise information relevant+-- for pretty-printing would be lost. ++(*>) :: Syntax delta => delta () -> delta alpha -> delta alpha+p *> q = inverse unit . commute <$> p <*> q++-- | This variant of `<*>` ignores its right result.+-- In contrast to its counterpart derived from the `Applicative` class, the ignored+-- parts have type `delta ()` rather than `delta beta` because otherwise information relevant+-- for pretty-printing would be lost. ++(<*) :: Syntax delta => delta alpha -> delta () -> delta alpha+p <* q = inverse unit <$> p <*> q++-- | The `between` function combines `*>` and `<*` in the obvious way.+between :: Syntax delta => delta () -> delta () -> delta alpha -> delta alpha+between p q r = p *> r <* q++-- | The `chainl1` combinator is used to parse a+-- left-associative chain of infix operators. +chainl1 :: Syntax delta => delta alpha -> delta beta -> Iso (alpha, (beta, alpha)) alpha -> delta alpha+chainl1 arg op f + = foldl f <$> arg <*> many (op <*> arg)++optional :: Syntax delta => delta alpha -> delta (Maybe alpha)+optional x = just <$> x <|> nothing <$> text ""++sepBy :: Syntax delta => delta alpha -> delta () -> delta [alpha]+sepBy x sep + = nil <$> text "" + <|> cons <$> x <*> many (sep *> x) ++comma :: Syntax delta => delta ()+comma = text ","++dot :: Syntax delta => delta ()+dot = text "."+++-- Expressing whitespace+-- ---------------------+-- +-- Parsers and pretty printers treat whitespace +-- differently. Parsers+-- specify where whitespace is allowed or required to occur, while+-- pretty printers specify how much whitespace is to be inserted at+-- these locations. To account for these different roles of+-- whitespace, the following three syntax descriptions provide+-- fine-grained control over where whitespace is allowed, desired or+-- required to occur.++-- | `skipSpace` marks a position where whitespace is allowed to+-- occur. It accepts arbitrary space while parsing, and produces+-- no space while printing. ++skipSpace :: Syntax delta => delta ()+skipSpace = ignore [] <$> many (text " ")+ +-- | `optSpace` marks a position where whitespace is desired to occur.+-- It accepts arbitrary space while parsing, and produces a +-- single space character while printing.++optSpace :: Syntax delta => delta ()+optSpace = ignore [()] <$> many (text " ")++-- | `sepSpace` marks a position where whitespace is required to+-- occur. It requires one or more space characters while parsing, +-- and produces a single space character while printing.+ +sepSpace :: Syntax delta => delta ()+sepSpace = text " " <* skipSpace+
+ src/Text/Syntax/Parser/Naive.hs view
@@ -0,0 +1,51 @@+module Text.Syntax.Parser.Naive where++import Prelude ()++import Control.Category ()+import Control.Isomorphism.Partial (IsoFunctor, (<$>), apply)+import Control.Monad (Monad, return, fail, (>>=))++import Data.Char (String)+import Data.List ((++))+import Data.Maybe (Maybe (Just))++import Text.Syntax.Classes (ProductFunctor, Alternative, Syntax, (<*>), (<|>), empty, pure, token) ++-- parser+ +newtype Parser alpha + = Parser (String -> [(alpha, String)])++parse :: Parser alpha -> String -> [alpha]+parse (Parser p) s = [ x | (x, "") <- p s ]++parseM :: Monad m => Parser alpha -> String -> m alpha+parseM p s+ = case parse p s of+ [] -> fail "parse error"+ [result] -> return result+ _ -> fail "ambiguous input"++instance IsoFunctor Parser where+ iso <$> Parser p + = Parser (\s -> [ (y, s') + | (x, s') <- p s+ , Just y <- [apply iso x] ])++instance ProductFunctor Parser where+ Parser p <*> Parser q + = Parser (\s -> [ ((x, y), s'') + | (x, s') <- p s+ , (y, s'') <- q s' ])++instance Alternative Parser where+ Parser p <|> Parser q + = Parser (\s -> p s ++ q s)+ empty = Parser (\s -> [])++instance Syntax Parser where+ pure x = Parser (\s -> [(x, s)])+ token = Parser f where+ f [] = []+ f (t:ts) = [(t, ts)]
+ src/Text/Syntax/Printer/Naive.hs view
@@ -0,0 +1,44 @@+module Text.Syntax.Printer.Naive where++import Prelude ()++import Control.Category ()+import Control.Isomorphism.Partial (IsoFunctor ((<$>)), unapply)+import Control.Monad (Monad, return, fail, (>>=), liftM2, mplus)++import Data.Char (String)+import Data.Eq (Eq ((==)))+import Data.Function (($))+import Data.List ((++))+import Data.Maybe (Maybe (Just, Nothing), maybe)++import Text.Syntax.Classes (ProductFunctor ((<*>)), Alternative ((<|>), empty), Syntax (pure, token))++-- printer+ +newtype Printer alpha = Printer (alpha -> Maybe String)++print :: Printer alpha -> alpha -> Maybe String+print (Printer p) x = p x++printM :: Monad m => Printer alpha -> alpha -> m String+printM p x = maybe (fail "print error") return $ print p x++instance IsoFunctor Printer where+ iso <$> Printer p + = Printer (\b -> unapply iso b >>= p)++instance ProductFunctor Printer where+ Printer p <*> Printer q + = Printer (\(x, y) -> liftM2 (++) (p x) (q y))++instance Alternative Printer where+ Printer p <|> Printer q + = Printer (\s -> mplus (p s) (q s))+ empty = Printer (\s -> Nothing)++instance Syntax Printer where+ pure x = Printer (\y -> if x == y + then Just "" + else Nothing) + token = Printer (\t -> Just [t])