37 lines
838 B
OCaml
37 lines
838 B
OCaml
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)
|