60 lines
1.5 KiB
OCaml
60 lines
1.5 KiB
OCaml
open Ast
|
|
open Ast.Value
|
|
|
|
exception No_operation
|
|
exception No_such_variable of string
|
|
|
|
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 eval vars ast =
|
|
let rec aux = function
|
|
| Value v -> v
|
|
| Var v -> begin match Hashtbl.find_opt vars v with
|
|
| None -> raise @@ No_such_variable v
|
|
| Some v -> v
|
|
end
|
|
| Unary (op, t) ->
|
|
let t = aux t in
|
|
let op = Unary.get op (Value.typeof t) in
|
|
op t
|
|
| Binop (l, op, r) ->
|
|
let l = aux l and r = aux r in
|
|
binop op l r
|
|
| Let (var, e) ->
|
|
let v = aux e in
|
|
Hashtbl.replace vars var v;
|
|
v
|
|
| Set_binop_pre (op, l) ->
|
|
let l =
|
|
match aux 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)
|
|
| Set_binop_aso (op, a) ->
|
|
Hashtbl.replace Parser.oper_assoc op @@ Parser.assoc_of_string a;
|
|
Nop
|
|
| Get_binop_aso op ->
|
|
match Hashtbl.find_opt Parser.oper_assoc op with
|
|
| None -> String "left"
|
|
| Some a -> String (Parser.assoc_to_string a)
|
|
in
|
|
aux ast
|