├── .gitignore ├── README.md ├── examples ├── ex1.lam ├── ex2.lam ├── ex3.lam ├── ex4.lam ├── ex5.lam └── ex6.lam ├── lambda.cabal └── src ├── AlexToken.x ├── Eval.hs ├── Expr.hs ├── HappyParser.y ├── Main.hs └── ParsecParser.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Demonstrate how to write a basic parser for the untyped lambda 2 | calculus in Haskell, using the two seemingly most-popular options 3 | available: Parsec and Happy/Alex. 4 | 5 | To build: 6 | 7 | ``` 8 | cabal configure 9 | cabal build 10 | ``` 11 | 12 | To run 13 | 14 | ``` 15 | ./dist/build/lambda/lambda < examples/ex1.lam 16 | ``` 17 | 18 | This will run each of the parsers and print the AST and evaluation. 19 | 20 | These parsers were created because I could not find an example of how 21 | to parse expressions with an implicit "juxtaposition" operator -- 22 | i.e., an expression formed by two expressions side-by-side, e.g., 23 | function application in ML-like languages. It turns out to be pretty easy. 24 | 25 | Note that these parsers _should_ accept exactly the same grammar and 26 | generate identical ASTs... but that is a difficult thing to check, so 27 | no guarantees! In fact, if you can spot a way in which they are 28 | different, I would be very curious to know about it. 29 | 30 | I do not claim or expect that these parsers are efficient. 31 | -------------------------------------------------------------------------------- /examples/ex1.lam: -------------------------------------------------------------------------------- 1 | # Example expression 2 | (\x -> \y -> x * y) 3 5 3 | -------------------------------------------------------------------------------- /examples/ex2.lam: -------------------------------------------------------------------------------- 1 | let x = 5 in 2 | let y = 3 in 3 | x + y 4 | -------------------------------------------------------------------------------- /examples/ex3.lam: -------------------------------------------------------------------------------- 1 | let id = \x -> x in id 3 * id 4 + id 5 2 | -------------------------------------------------------------------------------- /examples/ex4.lam: -------------------------------------------------------------------------------- 1 | let f = \x -> x + 1 in f 3 + f 4 * f 5 2 | -------------------------------------------------------------------------------- /examples/ex5.lam: -------------------------------------------------------------------------------- 1 | let add = \x -> \y -> x + y in 2 | let add5 = add 5 in 3 | add5 3 4 | -------------------------------------------------------------------------------- /examples/ex6.lam: -------------------------------------------------------------------------------- 1 | # Simple test of operator precedence 2 | # Should parse as 5-(1*2)+(3*4) 3 | 5-1*2+3*4 4 | -------------------------------------------------------------------------------- /lambda.cabal: -------------------------------------------------------------------------------- 1 | Name: haskell-parsers 2 | Version: 0.2 3 | Cabal-Version: >= 1.2 4 | License: BSD3 5 | Author: Geoff Hulette 6 | Synopsis: Simple untyped lambda-calculus interpreter demonstrating different parsers 7 | Build-Type: Simple 8 | 9 | Executable lambda 10 | Main-Is: Main.hs 11 | Other-modules: AlexToken,HappyParser 12 | Hs-Source-Dirs: src 13 | Build-Depends: base >= 4,parsec >= 3,array 14 | GHC-Options: -Wall 15 | 16 | -- Executable lambda-happy-alex 17 | -- Main-Is: Main.hs 18 | 19 | -- Hs-Source-Dirs: src 20 | -- Build-Depends: base >= 4, array, containers, mtl, regex-compat 21 | -- Build-Tools: alex, happy 22 | -- GHC-Options: -Wall 23 | -------------------------------------------------------------------------------- /src/AlexToken.x: -------------------------------------------------------------------------------- 1 | { 2 | {-# OPTIONS_GHC -w #-} 3 | module AlexToken (Token(..),scanTokens) where 4 | import Expr 5 | } 6 | 7 | %wrapper "basic" 8 | 9 | $digit = 0-9 10 | $alpha = [a-zA-Z] 11 | $eol = [\n] 12 | 13 | tokens :- 14 | 15 | $eol ; 16 | $white+ ; 17 | "#".* ; 18 | let { \s -> TokenLet } 19 | in { \s -> TokenIn } 20 | $digit+ { \s -> TokenNum (read s) } 21 | "->" { \s -> TokenArrow } 22 | \= { \s -> TokenEq } 23 | \\ { \s -> TokenLambda } 24 | [\+] { \s -> TokenAdd } 25 | [\-] { \s -> TokenSub } 26 | [\*] { \s -> TokenMul } 27 | \( { \s -> TokenLParen } 28 | \) { \s -> TokenRParen } 29 | $alpha [$alpha $digit \_ \']* { \s -> TokenSym s } 30 | 31 | { 32 | 33 | data Token = TokenLet 34 | | TokenIn 35 | | TokenLambda 36 | | TokenNum Int 37 | | TokenSym String 38 | | TokenArrow 39 | | TokenEq 40 | | TokenAdd 41 | | TokenSub 42 | | TokenMul 43 | | TokenLParen 44 | | TokenRParen 45 | deriving (Eq,Show) 46 | 47 | scanTokens = alexScanTokens 48 | 49 | } 50 | -------------------------------------------------------------------------------- /src/Eval.hs: -------------------------------------------------------------------------------- 1 | module Eval (Val(..),eval) where 2 | 3 | import Expr 4 | 5 | data Val = FunVal Env Id Expr 6 | | NumVal Int 7 | 8 | instance Show Val where 9 | show (FunVal _ _ _) = "" 10 | show (NumVal n) = show n 11 | 12 | type Env = Id -> Val 13 | 14 | extend :: Env -> Id -> Val -> Env 15 | extend e x v = \y -> if x == y then v else e y 16 | 17 | empty :: Env 18 | empty = \_ -> error "Not found!" 19 | 20 | evalOp :: Op -> (Int -> Int -> Int) 21 | evalOp Add = (+) 22 | evalOp Sub = (-) 23 | evalOp Mul = (*) 24 | 25 | evalIn :: Env -> Expr -> Val 26 | evalIn env (Abs x e) = FunVal env x e 27 | evalIn env (App e1 e2) = 28 | case evalIn env e1 of 29 | FunVal env' x e3 -> 30 | let v2 = evalIn env e2 in 31 | evalIn (extend env' x v2) e3 32 | _ -> error "Cannot apply value" 33 | evalIn env (Var x) = env x 34 | evalIn _ (Num n) = NumVal n 35 | evalIn env (Binop op e1 e2) = 36 | let v1 = evalIn env e1 37 | v2 = evalIn env e2 38 | x = evalOp op in 39 | case (v1,v2) of 40 | (NumVal n1,NumVal n2) -> NumVal (n1 `x` n2) 41 | _ -> error "Not a number" 42 | 43 | eval :: Expr -> Val 44 | eval = evalIn empty 45 | -------------------------------------------------------------------------------- /src/Expr.hs: -------------------------------------------------------------------------------- 1 | module Expr where 2 | 3 | type Id = String 4 | 5 | data Op = Add | Sub | Mul deriving (Eq,Show) 6 | 7 | data Expr = Abs Id Expr 8 | | App Expr Expr 9 | | Var Id 10 | | Num Int 11 | | Binop Op Expr Expr 12 | deriving (Eq,Show) 13 | 14 | source :: Expr -> String 15 | source expr = case expr of 16 | (Abs x e) -> parens $ "\\" ++ x ++ " -> " ++ source e 17 | (App e1 e2) -> parens $ source e1 ++ " " ++ source e2 18 | (Binop op e1 e2) -> parens $ source e1 ++ sourceOp op ++ source e2 19 | (Var x) -> x 20 | (Num n) -> show n 21 | where sourceOp Add = " + " 22 | sourceOp Sub = " - " 23 | sourceOp Mul = " * " 24 | parens s = "(" ++ s ++ ")" 25 | 26 | addExpr :: Expr -> Expr -> Expr 27 | addExpr = Binop Add 28 | 29 | subExpr :: Expr -> Expr -> Expr 30 | subExpr = Binop Sub 31 | 32 | mulExpr :: Expr -> Expr -> Expr 33 | mulExpr = Binop Mul 34 | -------------------------------------------------------------------------------- /src/HappyParser.y: -------------------------------------------------------------------------------- 1 | { 2 | module HappyParser where 3 | 4 | import AlexToken 5 | import Expr 6 | } 7 | 8 | %name expr 9 | %tokentype { Token } 10 | %error { parseError } 11 | 12 | %token 13 | let { TokenLet } 14 | in { TokenIn } 15 | NUM { TokenNum $$ } 16 | VAR { TokenSym $$ } 17 | '\\' { TokenLambda } 18 | '->' { TokenArrow } 19 | '=' { TokenEq } 20 | '+' { TokenAdd } 21 | '-' { TokenSub } 22 | '*' { TokenMul } 23 | '(' { TokenLParen } 24 | ')' { TokenRParen } 25 | 26 | %left '+' '-' 27 | %left '*' 28 | %% 29 | 30 | Expr : let VAR '=' Expr in Expr { App (Abs $2 $6) $4 } 31 | | '\\' VAR '->' Expr { Abs $2 $4 } 32 | | Form { $1 } 33 | 34 | Form : Form '+' Form { Binop Add $1 $3 } 35 | | Form '-' Form { Binop Sub $1 $3 } 36 | | Form '*' Form { Binop Mul $1 $3 } 37 | | Juxt { $1 } 38 | 39 | Juxt : Juxt Atom { App $1 $2 } 40 | | Atom { $1 } 41 | 42 | Atom : '(' Expr ')' { $2 } 43 | | NUM { Num $1 } 44 | | VAR { Var $1 } 45 | 46 | { 47 | parseError :: [Token] -> a 48 | parseError _ = error "Parse error" 49 | 50 | parseExpr :: String -> Expr 51 | parseExpr = expr . scanTokens 52 | } 53 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | import qualified ParsecParser 2 | import qualified HappyParser 3 | import Eval 4 | import Expr 5 | 6 | runEvalWith :: (String -> Expr) -> String -> IO () 7 | runEvalWith parseExpr input = do 8 | let ast = parseExpr input 9 | putStrLn $ "AST: " ++ (show ast) 10 | putStrLn $ "Source: " ++ (source ast) 11 | putStrLn $ "Eval: " ++ (show (eval ast)) 12 | 13 | main :: IO () 14 | main = do 15 | input <- getContents 16 | putStrLn "Input:" 17 | putStrLn input 18 | putStrLn "Using Parsec:" 19 | runEvalWith ParsecParser.parseExpr input 20 | putStrLn "\nUsing Happy:" 21 | runEvalWith HappyParser.parseExpr input 22 | -------------------------------------------------------------------------------- /src/ParsecParser.hs: -------------------------------------------------------------------------------- 1 | module ParsecParser (parseExpr) where 2 | 3 | import Expr 4 | import Text.Parsec 5 | import Text.Parsec.Expr 6 | import Text.Parsec.String (Parser) 7 | import Text.Parsec.Language (emptyDef) 8 | import qualified Text.Parsec.Token as Token 9 | 10 | 11 | -- Lexer 12 | 13 | lexer :: Token.TokenParser () 14 | lexer = Token.makeTokenParser style 15 | where style = emptyDef { 16 | Token.reservedOpNames = ["->","\\","+","*","-","="], 17 | Token.reservedNames = ["let","in"], 18 | Token.commentLine = "#" } 19 | 20 | natural :: Parser Integer 21 | natural = Token.natural lexer 22 | 23 | parens :: Parser a -> Parser a 24 | parens = Token.parens lexer 25 | 26 | reserved :: String -> Parser () 27 | reserved = Token.reserved lexer 28 | 29 | reservedOp :: String -> Parser () 30 | reservedOp = Token.reservedOp lexer 31 | 32 | identifier :: Parser String 33 | identifier = Token.identifier lexer 34 | 35 | 36 | -- Parser 37 | 38 | variable :: Parser Expr 39 | variable = Var `fmap` identifier 40 | 41 | number :: Parser Expr 42 | number = (Num . fromIntegral) `fmap` natural 43 | 44 | letin :: Parser Expr 45 | letin = do 46 | reserved "let" 47 | x <- identifier 48 | reservedOp "=" 49 | e1 <- expr 50 | reserved "in" 51 | e2 <- expr 52 | return (App (Abs x e2) e1) 53 | 54 | lambda :: Parser Expr 55 | lambda = do 56 | reservedOp "\\" 57 | x <- identifier 58 | reservedOp "->" 59 | e <- expr 60 | return (Abs x e) 61 | 62 | expr :: Parser Expr 63 | expr = letin <|> lambda <|> formula 64 | 65 | formula :: Parser Expr 66 | formula = buildExpressionParser [[mulOp],[addOp,subOp]] juxta "formula" 67 | where addOp = Infix (reservedOp "+" >> return addExpr) AssocLeft 68 | subOp = Infix (reservedOp "-" >> return subExpr) AssocLeft 69 | mulOp = Infix (reservedOp "*" >> return mulExpr) AssocLeft 70 | 71 | juxta :: Parser Expr 72 | juxta = (foldl1 App) `fmap` (many1 atom) 73 | 74 | atom :: Parser Expr 75 | atom = variable <|> number <|> parens expr "atom" 76 | 77 | allOf :: Parser a -> Parser a 78 | allOf p = do 79 | Token.whiteSpace lexer 80 | r <- p 81 | eof 82 | return r 83 | 84 | parseExpr :: String -> Expr 85 | parseExpr t = 86 | case parse (allOf expr) "stdin" t of 87 | Left err -> error (show err) 88 | Right ast -> ast 89 | --------------------------------------------------------------------------------