expr.hs

data Expr = Var String | Val Double | Expr :+ Expr | Expr :- Expr | IfZero Expr Expr Expr | Call String [Expr]

data Fun = Fun String [String] Expr

type VarEnv = [(String, Double)]

type FunEnv = [(String, [Double] -> Double)]

(!) :: Eq k => [(k, v)] -> k -> v
(!) m k = let Just x = lookup k m in x

run :: [Fun] -> Expr -> Double
run fundefs expr =
  let funs = compileFun funs <$> fundefs
   in compileExpr (funs, []) expr

compileFun :: FunEnv -> Fun -> (String, [Double] -> Double)
compileFun funs (Fun name vars body) = (name, \vals -> compileExpr (funs, zip vars vals) body)

compileExpr :: (FunEnv, VarEnv) -> Expr -> Double
compileExpr (funs, vars) = go
  where
    go (Var v) = vars ! v
    go (Val x) = x
    go (a :+ b) = go a + go b
    go (a :- b) = go a - go b
    go (IfZero a b c) = if go a == 0 then go b else go c
    go (Call f args) = (funs ! f) (go <$> args)

plus, odd', even' :: Fun
plus = Fun "plus" ["a", "b"] (IfZero (Var "a") (Var "b") (Val 1 :+ Call "plus" [Var "a" :- Val 1, Var "b"]))
odd' = Fun "odd" ["x"] (IfZero (Var "x") (Val 0) (Call "even" [Var "x" :- Val 1]))
even' = Fun "even" ["x"] (IfZero (Var "x") (Val 1) (Call "odd" [Var "x" :- Val 1]))

main = do
  print $ run [plus] (Call "plus" [Val 10, Val 2])
  print $ run [odd', even'] (Call "odd" [Val 10])
  print $ run [odd', even'] (Call "even" [Val 10])