diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -6,20 +6,20 @@ import Control.Lens.Cons import Control.Lens.SemiIso import Control.Lens.TH -import qualified Data.Attoparsec.Text as AP +import qualified Data.Attoparsec.Text.Lazy as AP import Data.Char import Data.Scientific (Scientific) import Data.SemiIsoFunctor import Data.Syntax (Syntax) import qualified Data.Syntax as S -import qualified Data.Syntax.Attoparsec.Text as S +import qualified Data.Syntax.Attoparsec.Text.Lazy as S import Data.Syntax.Char (SyntaxChar) import qualified Data.Syntax.Char as S import qualified Data.Syntax.Combinator as S -import qualified Data.Syntax.Pretty as S +import qualified Data.Syntax.Printer.Text as S import Data.Text (Text) -import qualified Data.Text.IO as T -import qualified Text.PrettyPrint as P +import qualified Data.Text.Lazy.Builder as T +import qualified Data.Text.Lazy.IO as T -- A simple lambda calculus. @@ -73,7 +73,7 @@ expr :: SyntaxChar syn Text => syn AST expr = _Abs /$~ S.char '\\' /*/ S.spaces_ /*/ name /*/ S.spaces - /*/ S.string "->" /*/ S.spaces + /*/ S.string "->" /*/ S.spaces /*/ expr /|/ _Let /$~ S.string "let" /*/ S.spaces1 @@ -91,16 +91,16 @@ t <- T.getContents -- Try to parse it. - case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of - Left err -> putStrLn err - Right ast -> do - -- If parsing succeeded print the AST. - print ast - - -- Try to pretty print it. - -- (Printing cannot really fail in this example) - case S.runPrinter expr ast of - Left err -> putStrLn err - Right doc -> putStrLn (P.render doc) + case AP.parse (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of + AP.Fail _ _ err -> putStrLn err + AP.Done _ ast -> do + -- If parsing succeeded print the AST. + print ast + + -- Try to pretty print it. + -- (Printing cannot really fail in this example) + case S.runPrinter expr ast of + Left err -> putStrLn err + Right bld -> T.putStrLn (T.toLazyText bld) return () diff --git a/syntax-example.cabal b/syntax-example.cabal --- a/syntax-example.cabal +++ b/syntax-example.cabal @@ -1,114 +1,28 @@ name: syntax-example -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Example application using syntax, a library for abstract syntax descriptions. description: Example application using syntax, a library for abstract syntax descriptions. . - /The code./ + The code: . - > import Control.Applicative - > import Control.Lens.Cons - > import Control.Lens.SemiIso - > import Control.Lens.TH - > import qualified Data.Attoparsec.Text as AP - > import Data.Char - > import Data.Scientific (Scientific) - > import Data.SemiIsoFunctor - > import Data.Syntax (Syntax) - > import qualified Data.Syntax as S - > import qualified Data.Syntax.Attoparsec.Text as S - > import Data.Syntax.Char (SyntaxChar) - > import qualified Data.Syntax.Char as S - > import qualified Data.Syntax.Combinator as S - > import qualified Data.Syntax.Pretty as S - > import Data.Text (Text) - > import qualified Data.Text.IO as T - > import qualified Text.PrettyPrint as P - > - > -- A simple lambda calculus. - > - > data Literal = LitStr Text - > | LitNum Scientific - > deriving (Show) - > - > $(makePrisms ''Literal) - > - > data AST = Var Text - > | Lit Literal - > | App AST AST - > | Abs Text AST - > | Let Text AST AST - > deriving (Show) - > - > $(makePrisms ''AST) - > - > -- | A variable name. - > name :: Syntax syn Text => syn Text - > name = _Cons /$/ S.satisfy isAlpha /*/ S.takeWhile isAlphaNum - > - > -- | A quoted string. - > quoted :: SyntaxChar syn seq => syn seq - > quoted = S.char '"' */ S.takeTill (=='"') /* S.char '"' - > - > -- | Encloses a symbol in parentheses. - > parens :: SyntaxChar syn seq => syn a - > syn a - > parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')' - > - > -- | A literal. - > literal :: SyntaxChar syn Text => syn Literal - > literal = _LitNum /$/ S.scientific - > /|/ _LitStr /$/ quoted - > - > -- | An atom is a variable, literal or an expression in parentheses. - > atom :: SyntaxChar syn Text => syn AST - > atom = _Lit /$/ literal - > /|/ _Var /$/ name - > /|/ parens expr - > - > -- | Parses a list of atoms and folds them with the _App prism. - > apps :: SyntaxChar syn Text => syn AST - > apps = bifoldl1 _App /$/ S.sepBy1 atom S.spaces1 - > - > -- | An expression of our lambda calculus. - > -- - > -- Thanks to 'tuple-morph' we don't have to worry about /* and */ here. - > -- Tuples are reassociated and units are removed by the 'morphed' - > -- isomorphism (applied in /$~ operator). - > expr :: SyntaxChar syn Text => syn AST - > expr = _Abs /$~ S.char '\\' /*/ S.spaces_ - > /*/ name /*/ S.spaces - > /*/ S.string "->" /*/ S.spaces - > /*/ expr - > - > /|/ _Let /$~ S.string "let" /*/ S.spaces1 - > /*/ name /*/ S.spaces - > /*/ S.char '=' /*/ S.spaces - > /*/ expr /*/ S.spaces1 - > /*/ S.string "in" /*/ S.spaces1 - > /*/ expr - > - > /|/ apps - > - > main :: IO () - > main = do - > -- Load the standard input. - > t <- T.getContents - > - > -- Try to parse it. - > case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of - > Left err -> putStrLn err - > Right ast -> do - > -- If parsing succeeded print the AST. - > print ast - > - > -- Try to pretty print it. - > -- (Printing cannot really fail in this example) - > case S.runPrinter expr ast of - > Left err -> putStrLn err - > Right doc -> putStrLn (P.render doc) - > - > return () + * . + Example input: + . + > (\f-> + > (\x + > -> f ((x) x)) (\x + > -> f (x x) + > ) + > (\x -> "test") + > (\y -> y +2.0e13)) + . + Example output: + . + > Abs "f" (App (App (App (Abs "x" (App (Var "f") (App (Var "x") (Var "x")))) (Abs "x" (App (Var "f") (App (Var "x") (Var "x"))))) (Abs "x" (Lit (LitStr "test")))) (Abs "y" (App (Var "y") (Lit (LitNum 2.0e13))))) + > \f -> (\x -> f (x x)) (\x -> f (x x)) (\x -> "test") (\y -> y 2.0e13) + license: MIT license-file: LICENSE author: Paweł Nowak @@ -125,6 +39,6 @@ executable syntax-example main-is: Main.hs build-depends: base >= 4 && < 5, lens, semi-iso >= 0.4, - syntax >= 0.2, syntax-attoparsec >= 0.2, syntax-pretty >= 0.2, - attoparsec, pretty, text, scientific >= 0.3 + syntax >= 0.2, syntax-attoparsec >= 0.2, syntax-printer, + attoparsec, text, scientific >= 0.3 default-language: Haskell2010