From 282fbfa7386bd6ee13c5664540985e5648785bb0 Mon Sep 17 00:00:00 2001 From: Hyeonung Baek Date: Fri, 28 Jan 2022 00:56:24 +0900 Subject: [PATCH] Merge Binop and Unary to Operator --- ast.ml | 60 ++++++++++++++++++++++++------------------------------- eval.ml | 6 +++--- parser.ml | 4 ++-- 3 files changed, 31 insertions(+), 39 deletions(-) diff --git a/ast.ml b/ast.ml index 843cf65..4955cb3 100644 --- a/ast.ml +++ b/ast.ml @@ -41,31 +41,13 @@ module Value = struct | _ -> failwith "Value.promote" end -module Unary = struct - type t = - | Negate - - let to_string = function - | Negate -> "-" - - let negate = function - | Value.Int n -> Value.Int ~-n - | Float n -> Value.Float ~-.n - | _ -> failwith "Unary.negate" - - let get op _typ = - match op with - | Negate -> negate - -end - -(* binary operator *) -(* binary operator has type 'a -> 'a -> 'b. *) -module Binop = struct +(* operators *) +module Operator = struct type t = | Add | Sub | Mul | Div (* arithmetics *) | Mod (* modular operation *) | Exp (* exponentation *) + | Negate exception Unavailable of t @@ -76,6 +58,12 @@ module Binop = struct | Div -> "/" | Mod -> "%" | Exp -> "^" + | Negate -> "-" + + let negate = function + | Value.Int n -> Value.Int ~-n + | Float n -> Value.Float ~-.n + | _ -> failwith "Operator.negate" let vi f a b = let open Value in @@ -108,7 +96,11 @@ module Binop = struct | None -> raise @@ Unavailable op | Some p -> List.map fst p - let get op typ = + let get_unary = function + | Negate -> negate + | op -> raise @@ Unavailable op + + let get_binary op typ = Hashtbl.find operators op |> List.assoc_opt typ end @@ -117,12 +109,12 @@ type t = | Value of Value.t | Var of string | Let of string * t - | Unary of Unary.t * t - | Binop of t * Binop.t * t - | Set_binop_pre of Binop.t * t - | Get_binop_pre of Binop.t - | Set_binop_aso of Binop.t * string - | Get_binop_aso of Binop.t + | Unary of Operator.t * t + | Binop of t * Operator.t * t + | Set_binop_pre of Operator.t * t + | Get_binop_pre of Operator.t + | Set_binop_aso of Operator.t * string + | Get_binop_aso of Operator.t let value v = Value v @@ -144,22 +136,22 @@ let print ast = aux e; pr ")" | Unary (op, t) -> begin - let op = Unary.to_string op in + let op = Operator.to_string op in pr "(%s " op; aux t; pr ")"; end | Binop (left, op, right) -> begin - let op = Binop.to_string op in + let op = Operator.to_string op in pr "(%s " op; aux left; pr " "; aux right; pr ")"; end | Set_binop_pre (op, pre) -> - pr "(set_pre %s " (Binop.to_string op); + pr "(set_pre %s " (Operator.to_string op); aux pre; pr ")" | Get_binop_pre op -> - pr "(get_pre %s)" (Binop.to_string op) + pr "(get_pre %s)" (Operator.to_string op) | Set_binop_aso (op, aso) -> - pr "(set_assoc %s %s)" (Binop.to_string op) aso + pr "(set_assoc %s %s)" (Operator.to_string op) aso | Get_binop_aso op -> - pr "(get_pre %s)" (Binop.to_string op) + pr "(get_pre %s)" (Operator.to_string op) in aux ast; pr "\n" diff --git a/eval.ml b/eval.ml index f7cfc43..54e8211 100644 --- a/eval.ml +++ b/eval.ml @@ -5,7 +5,7 @@ exception No_operation exception No_such_variable of string let resolve_type op tp = - let optypes = Binop.get_types op in + let optypes = Operator.get_types op in let q = Queue.create () in let rec aux (t1, t2) = if List.mem (t1, t2) optypes then @@ -30,7 +30,7 @@ let rec binop op l r = in let l = promote_until t1 l and r = promote_until t2 r in - match Binop.get op (t1, t2) with + match Operator.get_binary op (t1, t2) with | None -> begin try binop op (promote l) (promote r) with _ -> raise No_operation @@ -46,7 +46,7 @@ let eval vars ast = end | Unary (op, t) -> let t = aux t in - let op = Unary.get op (Value.typeof t) in + let op = Operator.get_unary op in op t | Binop (l, op, r) -> let l = aux l and r = aux r in diff --git a/parser.ml b/parser.ml index d4df9b1..40f7374 100644 --- a/parser.ml +++ b/parser.ml @@ -1,5 +1,5 @@ open Ast -open Ast.Binop +open Ast.Operator module S = Set.Make(String) @@ -177,7 +177,7 @@ and unary seq = | Seq.Nil -> raise End_of_tokens | Seq.Cons (x, seq) -> if x = Minus - then Unary.Negate, seq + then Negate, seq else expected "minus" in let v, seq = value seq in