test.hs

data Expression = Var Char | Func String Expression | Appl [Expression] deriving (Show, Eq);showExpr x = case x of (Var c) -> [c]; (Func head body) -> "(\\" ++ head ++ "." ++ (showExpr body) ++ ")"; (Appl xs) -> foldl (++) [] $ map showExpr xs;
_split_on s1 (c:s2) x = if c == x then (s1, s2) else _split_on (s1++[c]) s2 x;split_closing_paren' n before (c:rest) = if c == ')' then if n==0 then (reverse before, rest) else split_closing_paren' (n-1) before rest else if c=='(' then split_closing_paren' (n+1) before rest else split_closing_paren' n (c:before) rest;tokenize exprs str = case str of ""->exprs; '\\':rest -> let (head, body) = _split_on "" rest '.' in if ' ' `elem` body then let (body', rest') = _split_on "" body ' ' in tokenize ((Func head $ parse body'):exprs) rest' else tokenize ((Func head $ parse body):exprs) ""; '(':rest -> let (inner, after) = (split_closing_paren' 0 "" rest) in tokenize ((parse inner): exprs) after; ' ':rest -> tokenize exprs rest; x:rest -> tokenize (Var x:exprs) rest;
parse = Appl . reverse . tokenize [];replaceArg c e expr = case expr of var@(Var x) -> if c==x then e else var; func@(Func head body) -> if c `elem` head then func else Func head (replaceArg c e body); (Appl exprs) -> Appl $ map (replaceArg c e) exprs;beta = showExpr . reduce . parse;
reduce x = case x of (Appl [x]) -> reduce x; (Appl ((Func [] body):rest)) -> reduce $ Appl (body:rest); (Appl ((Func [param] body):arg:arg_rest)) -> reduce $ Appl (replaceArg param arg body:arg_rest); (Appl ((Func (param1:param_rest) body):arg1:arg_rest)) -> reduce $ Appl (Func param_rest (replaceArg param1 arg1 body):arg_rest); (Appl exprs) -> reduce $ Appl $ map reduce exprs; (Func head body) -> Func head $ reduce body; _ -> x;