diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,10 +3,11 @@ sexp-grammar ============ -It is a library of invertible parsing combinators for -S-expressions. The combinators -- primitive grammars -- not only -encode a way how to parse S-expressions into a Haskell value, but how -to serialise it back into an S-expression. +Library of invertible parsing combinators for S-expressions. The +combinators define primitive grammars and ways to compose them. A +grammar constructed with these combinators can be run in two +directions: parsing from S-expressions direction (forward) and +serialising to S-expressions direction (backward). The approach used in `sexp-grammar` is inspired by the paper [Invertible syntax descriptions: Unifying parsing and pretty printing](http://www.informatik.uni-marburg.de/~rendel/unparse/) diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -23,6 +23,8 @@ import Data.Text (Text) import GHC.Generics (Generic) +import qualified Language.Sexp.Located as Sexp + import Language.SexpGrammar import qualified Language.SexpGrammar.TH as TH import qualified Language.SexpGrammar.Generic as G @@ -120,8 +122,8 @@ $ End -expr :: ByteString -> Expr -expr = either error id . decodeWith exprGrammarTH "" +exprOf :: ByteString -> Expr +exprOf = either error id . decodeWith exprGrammarTH "" benchCases :: [(String, ByteString)] benchCases = map (\a -> ("expression, size " ++ show (B8.length a) ++ " bytes", a)) @@ -132,17 +134,39 @@ \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ \:args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ \:args (* 10 (+ 1 2)))))))" + , "(fibonacci :args (* (+ (cond :pred (+ 42 314) :false (invert (* (+ (cond :pred (+ 42 314) :false \ + \(fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ foo bar)))) (cond :pred (invert (* (+ (cond :pred (+ 42 314) :false (invert (* \ + \(+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ 1 2))))))) :true (factorial :args \ + \(* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ 1 2))))))) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ 1 2))))))) :true (factorial :args \ + \(* 10 (+ 1 2)))) (cond :pred (+ 42 28) :false (fibonacci :args 3) :true (factorial :args \ + \(* 10 (+ 1 2))))) (+ (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ foo bar)))) (cond :pred (+ 42 314) :false (fibonacci :args 3) :true (factorial \ + \:args (* 10 (+ 1 2)))))))" ] mkBenchmark :: String -> ByteString -> IO Benchmark mkBenchmark name str = do - expr <- evaluate $ force $ expr str + expr <- evaluate $ force $ exprOf str sexp <- evaluate $ force $ either error id (toSexp exprGrammarTH expr) return $ bgroup name - [ bench "gen" $ nf (toSexp exprGrammarTH) expr - , bench "genG" $ nf (toSexp exprGrammarGeneric) expr - , bench "parse" $ nf (fromSexp exprGrammarTH) sexp - , bench "parseG" $ nf (fromSexp exprGrammarGeneric) sexp + [ bench "decode" $ nf (Sexp.decode) str + , bench "encode" $ nf (Sexp.encode) sexp + , bench "format" $ nf (Sexp.format) sexp + , bench "toSexpTH" $ nf (toSexp exprGrammarTH) expr + , bench "toSexpG" $ nf (toSexp exprGrammarGeneric) expr + , bench "fromSexpTH" $ nf (fromSexp exprGrammarTH) sexp + , bench "fromSexpG" $ nf (fromSexp exprGrammarGeneric) sexp ] main :: IO () diff --git a/examples/Expr.hs b/examples/Expr.hs --- a/examples/Expr.hs +++ b/examples/Expr.hs @@ -78,5 +78,5 @@ sexp' <- toSexp g e return (e, B8.unpack (Sexp.format sexp')) --- > test "(cond 1 (+ 42 10) (* 2 (* 2 2)))" +-- > test "(cond :pred 1 :true (+ 42 10) :false (* 2 (* 2 2)))" -- (IfZero (Lit 1) (Add (Lit 42) (Lit 10)) (Mul (Lit 2) (Mul (Lit 2) (Lit 2))),"(cond 1 (+ 42 10) (* 2 (* 2 2)))") diff --git a/sexp-grammar.cabal b/sexp-grammar.cabal --- a/sexp-grammar.cabal +++ b/sexp-grammar.cabal @@ -1,5 +1,5 @@ name: sexp-grammar -version: 2.0.1 +version: 2.0.2 license: BSD3 license-file: LICENSE author: Eugene Smolanka, Sergey Vinokurov @@ -51,7 +51,7 @@ array >=0.5 && <0.6 , base >=4.7 && <5.0 , bytestring >=0.10 && <0.11 - , containers >=0.5.5 && <0.6 + , containers >=0.5.5 && <0.7 , deepseq >=1.0 && <2.0 , invertible-grammar >=0.1 && <0.2 , prettyprinter >=1 && <1.3 diff --git a/src/Language/Sexp/Token.hs b/src/Language/Sexp/Token.hs --- a/src/Language/Sexp/Token.hs +++ b/src/Language/Sexp/Token.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,11 +9,13 @@ , unescape ) where +import Data.Scientific +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif import Data.Text (Text) import qualified Data.Text.Lazy as TL -import Data.Scientific import Data.Text.Prettyprint.Doc -import Data.Semigroup import Language.Sexp.Types (Prefix(..)) diff --git a/src/Language/SexpGrammar/Base.hs b/src/Language/SexpGrammar/Base.hs --- a/src/Language/SexpGrammar/Base.hs +++ b/src/Language/SexpGrammar/Base.hs @@ -219,7 +219,6 @@ takePairs other acc = (other, acc) - endProperties :: Grammar Position t (PropertyList :- t) endProperties = PartialIso