#use "ass12.ml"

(* Perform all possible beta-reductions on an expression until the normal form
 * has been reached *)
let rec eval exp =
    let eval_monop = function
          (Neg, Num i) -> Num (-i)
        | (Not, Bool b) -> Bool (not b)
        | _ -> raise (Failure "Unknown unary operator")
    in
    let eval_binop = function
          (op, Num a, Num b) ->
            (* Arithmethic or relational operation is possible on numbers *)
            (match op with
              Add -> Num (a + b)
            | Sub -> Num (a - b)
            | Mul -> Num (a * b)
            | Div -> Num (a / b)
            | Mod -> Num (a mod b)
            | Eq -> Bool (a = b)
            | Ne -> Bool (a != b)
            | Lt -> Bool (a < b)
            | Le -> Bool (a <= b)
            | Gt -> Bool (a > b)
            | Ge -> Bool (a >= b)
            | _ -> raise (Failure "Unknown arithmetic/relational operator"))
        | (op, Bool a, Bool b) ->
            (* Locical operation is possible on booleans *)
            (match op with
              And -> Bool (a && b)
            | Or -> Bool (a || b)
            | _ -> raise (Failure "Unknown locical operator"))
        | (op, e1, e2) -> BinopAp (op, eval e1, eval e2)
    in
    match exp with
      MonopAp (op, e) -> eval_monop (op, eval e)
    | BinopAp (op, e1, e2) -> eval_binop (op, e1, e2)
    | Fun (x, e) -> Fun (x, eval e)
    | FunAp (Fun (x, Var y), a) when y = x -> eval a (* identity function *)
    | FunAp (Fun (y, e), a) -> (* prevent recursion *)
        let result = (subs e y a) in
        if result = exp then result else eval result
    | FunAp (e1, e2) -> (* prevent recursion *)
        let result = FunAp (eval e1, eval e2) in
        if result = exp then result else eval result
    | Cond (cond, e1, e2) ->
        (* If the condition evaluates to a boolean, choose the corresponding
         * conditional expression *)
        (match eval cond with
          Bool b -> if b then eval e1 else eval e2
        | c -> Cond (c, eval e1, eval e2))
    | Let (x, e1, e2) -> eval (subs e2 x e1)
    | LetRec (x, e1, e2) -> LetRec (x, eval e1, eval e2)
    | _ -> exp
