ce/eval.ml

open Ast

exception Invalid_type

let arith intf floatf a b =
  match a, b with
  | Int a, Int b -> begin
      try Int (intf a b)
      with Exit -> Float (floatf (float a) (float b))
    end
  | Float a, Int b -> Float (floatf a (float b))
  | Int a, Float b -> Float (floatf (float a) b)
  | Float a, Float b -> Float (floatf a b)
  | _ -> raise Invalid_type

let binop_to_func = function
  | Add -> arith Int.add Float.add
  | Sub -> arith Int.sub Float.sub
  | Mul -> arith Int.mul Float.mul
  | Div -> arith Int.div Float.div
  | Mod -> arith Int.rem Float.rem
  | Exp -> arith (fun _ _ -> raise Exit) Float.pow

let rec eval = function
  | Value v -> v
  | Binop (l, op, r) ->
    let f = binop_to_func op in
    f (eval l) (eval r)
  | Set_binop_pre (op, l) ->
    let l = match eval l with Int n -> n | _ -> raise Invalid_type in
    Hashtbl.replace Parser.precedence op l;
    Unit
  | Get_binop_pre op ->
    Int (Hashtbl.find Parser.precedence op)