mirror of
https://github.com/pavelchristof/syntax-example.git
synced 2024-09-11 09:55:56 +03:00
Updated the example to semi-iso 0.4
This commit is contained in:
parent
bebffd3add
commit
dbff80580c
64
Main.hs
64
Main.hs
@ -3,14 +3,17 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Control.Lens.Cons
|
||||||
import Control.Lens.SemiIso
|
import Control.Lens.SemiIso
|
||||||
import Control.Lens.TH
|
import Control.Lens.TH
|
||||||
import qualified Data.Attoparsec.Text as AP
|
import qualified Data.Attoparsec.Text as AP
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
import Data.Scientific (Scientific)
|
||||||
import Data.SemiIsoFunctor
|
import Data.SemiIsoFunctor
|
||||||
import Data.Syntax (Syntax)
|
import Data.Syntax (Syntax)
|
||||||
import qualified Data.Syntax as S
|
import qualified Data.Syntax as S
|
||||||
import qualified Data.Syntax.Attoparsec.Text 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.Char as S
|
||||||
import qualified Data.Syntax.Combinator as S
|
import qualified Data.Syntax.Combinator as S
|
||||||
import qualified Data.Syntax.Pretty as S
|
import qualified Data.Syntax.Pretty as S
|
||||||
@ -18,37 +21,68 @@ import Data.Text (Text)
|
|||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import qualified Text.PrettyPrint as P
|
import qualified Text.PrettyPrint as P
|
||||||
|
|
||||||
-- | A simple untyped lambda calculus.
|
-- A simple untyped lambda calculus.
|
||||||
|
|
||||||
|
data Literal = LitStr Text
|
||||||
|
| LitNum Scientific
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
$(makePrisms ''Literal)
|
||||||
|
|
||||||
data AST = Var Text
|
data AST = Var Text
|
||||||
|
| Lit Literal
|
||||||
| App AST AST
|
| App AST AST
|
||||||
| Abs Text AST
|
| Abs Text AST
|
||||||
|
| Let Text AST AST
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
$(makePrisms ''AST)
|
$(makePrisms ''AST)
|
||||||
|
|
||||||
-- | A variable name.
|
-- | A variable name.
|
||||||
name :: Syntax syn Text => syn Text
|
name :: Syntax syn Text => syn Text
|
||||||
name = S.takeWhile1 isAlphaNum
|
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.
|
-- | Encloses a symbol in parentheses.
|
||||||
parens :: Syntax syn Text => syn a -> syn a
|
parens :: SyntaxChar syn seq => syn a -> syn a
|
||||||
parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'
|
parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'
|
||||||
|
|
||||||
-- | An atom is a variable or an expression in parentheses.
|
-- | A literal.
|
||||||
atom :: Syntax syn Text => syn AST
|
literal :: SyntaxChar syn Text => syn Literal
|
||||||
atom = _Var /$/ name
|
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
|
/|/ parens expr
|
||||||
|
|
||||||
-- | Parsers a list of applications.
|
-- | Parses a list of atoms and folds them with the _App prism.
|
||||||
apps :: Syntax syn Text => syn AST
|
apps :: SyntaxChar syn Text => syn AST
|
||||||
apps = bifoldl1 (attemptAp_ _App) /$/ S.sepBy1 atom S.spaces1
|
apps = bifoldl1 _App /$/ S.sepBy1 atom S.spaces1
|
||||||
|
|
||||||
-- | An expression of our lambda calculus.
|
-- | An expression of our lambda calculus.
|
||||||
expr :: Syntax syn Text => syn AST
|
--
|
||||||
expr = _Abs /$/ S.char '\\' /* S.spaces_
|
-- Thanks to 'tuple-morph' we don't have to worry about /* and */ here.
|
||||||
*/ name /* S.spaces
|
-- Tuples are reassociated and units are removed by the 'morphed'
|
||||||
/* S.string "->" /* S.spaces
|
-- isomorphism (applied in /$~ operator).
|
||||||
|
expr :: SyntaxChar syn Text => syn AST
|
||||||
|
expr = _Abs /$~ S.char '\\' /*/ S.spaces_
|
||||||
|
/*/ name /*/ S.spaces
|
||||||
|
/*/ S.string "->" /*/ S.spaces
|
||||||
/*/ expr
|
/*/ expr
|
||||||
|
|
||||||
|
/|/ _Let /$~ S.string "let" /*/ S.spaces1
|
||||||
|
/*/ name /*/ S.spaces
|
||||||
|
/*/ S.char '=' /*/ S.spaces
|
||||||
|
/*/ expr /*/ S.spaces1
|
||||||
|
/*/ S.string "in" /*/ S.spaces1
|
||||||
|
/*/ expr
|
||||||
|
|
||||||
/|/ apps
|
/|/ apps
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
@ -58,7 +92,7 @@ main = do
|
|||||||
|
|
||||||
-- Try to parse it.
|
-- Try to parse it.
|
||||||
case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of
|
case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of
|
||||||
Left err -> putStrLn err
|
Left err -> putStrLn err
|
||||||
Right ast -> do
|
Right ast -> do
|
||||||
-- If parsing succeeded print the AST.
|
-- If parsing succeeded print the AST.
|
||||||
print ast
|
print ast
|
||||||
@ -66,7 +100,7 @@ main = do
|
|||||||
-- Try to pretty print it.
|
-- Try to pretty print it.
|
||||||
-- (Printing cannot really fail in this example)
|
-- (Printing cannot really fail in this example)
|
||||||
case S.runPrinter expr ast of
|
case S.runPrinter expr ast of
|
||||||
Left err -> putStrLn err
|
Left err -> putStrLn err
|
||||||
Right doc -> putStrLn (P.render doc)
|
Right doc -> putStrLn (P.render doc)
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
name: syntax-example
|
name: syntax-example
|
||||||
version: 0.2.0.0
|
version: 0.3.0.0
|
||||||
synopsis: Example application using syntax, a library for abstract syntax descriptions.
|
synopsis: Example application using syntax, a library for abstract syntax descriptions.
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
@ -16,7 +16,7 @@ source-repository head
|
|||||||
|
|
||||||
executable syntax-example
|
executable syntax-example
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
build-depends: base >= 4 && < 5, lens, semi-iso >= 0.3,
|
build-depends: base >= 4 && < 5, lens, semi-iso >= 0.4,
|
||||||
syntax >= 0.1.1, syntax-attoparsec, syntax-pretty,
|
syntax >= 0.2, syntax-attoparsec >= 0.2, syntax-pretty >= 0.2,
|
||||||
attoparsec, pretty, text
|
attoparsec, pretty, text, scientific >= 0.3
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
Loading…
Reference in New Issue
Block a user