gistfile1.hs

module Main where
import System.Environment
import Text.ParserCombinators.Parsec hiding (token, (<|>), many)
import Control.Applicative

data Expr = Symbol Char
					| Apply  Expr Expr
          | Lambda Expr Expr deriving (Show)

main :: IO ()
main = do
  as <- getArgs
  if length as < 1
	 then
		putStrLn "you fail"
	 else
		putStrLn $ parser (as !! 0)

battle :: String -> String -> String
battle a b = parser a ++ "\n" ++ parser b

eval :: Expr -> Expr
eval (Symbol s)             = Symbol s
eval (Lambda a b)           = Lambda a b
eval (Apply (Lambda a b) c) = eval $ apply (Lambda a b) c
eval (Apply a            b) = Apply (eval a) (eval b) 

apply :: Expr -> Expr -> Expr
apply (Lambda (Symbol a) b) (Symbol c)  = if a == c then b else Symbol c
apply (Lambda (Symbol a) b) (Apply c d) = apply (apply (Lambda (Symbol a) b) c) (apply (Lambda (Symbol a) c) d)
apply (Lambda (Symbol a) b) c           = Apply (Lambda (Symbol a) b) c


-- PARSER

parser :: String -> String
parser s = case parse (spaces *> expr <* eof) "lambda calculus" s of
  Left  e -> "parsing error: " ++ show e
  Right v -> show $ eval v

expr :: Parser Expr
expr = app

term :: Parser Expr
term = paren <|> lambda <|> symbol

app :: Parser Expr
app = foldl Apply <$> term <*> many term

lambda :: Parser Expr
lambda = Lambda <$> (token (char '\\') *> symbol) <*> (token (char '.') *> expr)

symbol :: Parser Expr
symbol = Symbol <$> token letter

paren :: Parser Expr
paren = token (char '(') *> expr <* token (char ')')

token :: Parser a -> Parser a
token p = p <* spaces