-- 2009-06-13 -- Hazy: a purely functional Lambda Calculator by Jared Updike

module HazyParse ( Prog, VarId, FunId, Exp(..), parseHazy ) where

import Text.ParserCombinators.Parsec hiding (token)

-- Matthew Naylor, HHI
-- http://www-users.cs.york.ac.uk/~mfn/hhi/
-- http://www.haskell.org/sitewiki/images/0/0a/TMR-Issue10.pdf

type Prog = [(FunId, Exp)]
type VarId = String
type FunId = String

data Exp = Ap Exp Exp
         | Lambda VarId Exp  -- only used in Parse, eliminated in AbsElim
         | Var VarId         -- only used in Parse, eliminated in AbsElim
         | Fun FunId         -- only used in AbsElim and Interpret
         | Int Int           -- only used internally in Interpret
         | Lam (Exp -> Exp)  -- only used internally in Interpret

instance Show Exp where
   show (Ap e1 e2) = "("++show e1++" "++show e2++")"
   show (Fun f) = f
   show (Var f) = f
   show (Lambda x e) = "(\\ " ++ x ++ " -> " ++ show e ++ ")"
   show (Int i) = "Int "++show i
   show (Lam f) = "Lam <func>"

-- Helper parsers
use = flip (<?>)
nonEOLspace = try (oneOf "\t ")
eol = use "end of line character" $ do { char '\n'; many nonEOLspace }
open = try $ token $ char '('
close = try $ token $ char ')'
eq = token (char '=')

-- basic parsers
token p = use "zero or more spaces followed by a token" $ try $
           do { many nonEOLspace ; p }
starters = ['a'..'z']++['A'..'Z']++"_"
enders = starters++['0'..'9']++"'"

bslash = try $ token $ char '\\'
rarrow = try $ token $ do { char '-' ; char '>' }

ident = use "identifier" $ do
   c <- oneOf starters
   s <- many $ oneOf enders
   return (c:s)

linear :: (Eq a) => [a] -> Bool
linear [] = True
linear (x:xs) = (and $ map (x /=) xs) && linear xs

-- note this makes the important assumption that args (and function name) do not repeat
equationToLambda []       _   = error "equationToLambda: expected function name and one or more arguments, found []"
equationToLambda (f:args) rhs = (f, eqToLam args rhs)
-- does this: f x y = g    ==>   f = \x -> \y -> g
eqToLam []         rhs = rhs
eqToLam (arg:args) rhs = Lambda arg (eqToLam args rhs)

-- stuff we care about
def = use "a line with a function definition (like 'main = s k i')" $ do
   funPlusArgs <- many1 (token ident)
   token eq
   rhs <- token expr
   let (funid, newRhs) = equationToLambda funPlusArgs rhs
   return [(funid, newRhs)]
atom = use "an atomic expression" $ return . Var =<< token ident
parensExpr = use "a parenthesize expression" $ between open close expr
lambda = do
   bslash
   args <- many1 (token ident)
   rarrow
   e <- token expr
   return $ eqToLam args e
term = use "a term" $ lambda <|> atom <|> parensExpr
expr = use "an expression" $ term `chainl1` return Ap
-- program parser
program = use "a program; function definitions on their own lines" $ do
   defs <- sepBy maybeDef eol
   eof
   return $ concat defs

maybeDef = do
   maybeD <- optionMaybe def
   return $ case maybeD of
      Just x -> x
      Nothing -> []

parseHazy input = parse program "" input