ce/eval.ml

open Ast
open Ast.Value

exception No_operation

let rec binop op l r =
  let tl = typeof l and tr = typeof r in
  let ty = Type.merge tl tr in
  let rec promote_until t x =
    if typeof x = t
    then x
    else promote_until t (promote x)
  in
  let l = promote_until ty l
  and r = promote_until ty r in
  match Binop.get op ty with
  | None -> begin
      try binop op (promote l) (promote r)
      with _ -> raise No_operation
    end
  | Some f -> f l r

let rec eval = function
  | Value v -> v
  | Binop (l, op, r) ->
    let l = eval l and r = eval r in
    binop op l r
  | Set_binop_pre (op, l) ->
    let l =
      match eval l with
      | Int n -> n
      | v -> raise @@ Invalid_type (typeof v)
    in
    Hashtbl.replace Parser.precedence op l;
    Nop
  | Get_binop_pre op ->
    Int (Hashtbl.find Parser.precedence op)