Add proper parsing of applications (using a bifold!).

This commit is contained in:
Paweł Nowak 2014-10-30 16:36:55 +01:00
parent c6a3dc09a6
commit c1b7f370da
3 changed files with 13 additions and 6 deletions

13
Main.hs
View File

@ -3,6 +3,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Applicative import Control.Applicative
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
@ -11,6 +12,7 @@ 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 qualified Data.Syntax.Char as S 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.Pretty as S
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.IO as T import qualified Data.Text.IO as T
@ -37,14 +39,17 @@ atom :: Syntax syn Text => syn AST
atom = _Var /$/ name atom = _Var /$/ name
/|/ parens expr /|/ parens expr
-- | Parsers a list of applications.
apps :: Syntax syn Text => syn AST
apps = bifoldl1 (attemptAp_ _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 :: Syntax syn Text => syn AST
expr = _App /$/ atom /* S.spaces1 /*/ atom expr = _Abs /$/ S.char '\\' /* S.spaces_
/|/ _Abs /$/ S.char '\\' /* S.spaces_
*/ name /* S.spaces */ name /* S.spaces
/* S.string "->" /* S.spaces /* S.string "->" /* S.spaces
/*/ expr /*/ expr
/|/ atom /|/ apps
main :: IO () main :: IO ()
main = do main = do

View File

@ -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, build-depends: base >= 4 && < 5, lens, semi-iso >= 0.3,
syntax, syntax-attoparsec, syntax-pretty, syntax >= 0.1.1, syntax-attoparsec, syntax-pretty,
attoparsec, pretty, text attoparsec, pretty, text
default-language: Haskell2010 default-language: Haskell2010

View File

@ -3,3 +3,5 @@
-> f (x x)) (\x -> f (x x)) (\x
-> f (x x) -> f (x x)
) )
(\x -> x)
(\y -> y y)