From c33fd366ee0927f5ffcd2b9e38c6148e82b71466 Mon Sep 17 00:00:00 2001
From: Hyeonung Baek <wiserlix@gmail.com>
Date: Sat, 29 Jan 2022 20:01:48 +0900
Subject: [PATCH] Add basic function evaluation

---
 ast.ml    | 18 +++++++++---------
 eval.ml   | 27 +++++++++++++++++++++++++++
 main.ml   |  1 +
 parser.ml | 26 +++++++++++++++++++++++---
 4 files changed, 60 insertions(+), 12 deletions(-)

diff --git a/ast.ml b/ast.ml
index 4955cb3..7901781 100644
--- a/ast.ml
+++ b/ast.ml
@@ -111,6 +111,7 @@ type t =
   | Let of string * t
   | Unary of Operator.t * t
   | Binop of t * Operator.t * t
+  | Apply of t * t list
   | Set_binop_pre of Operator.t * t
   | Get_binop_pre of Operator.t
   | Set_binop_aso of Operator.t * string
@@ -132,17 +133,16 @@ let print ast =
     | Value n -> pv n
     | Var v -> pr "%s" v
     | Let (v, e) ->
-      pr "(let %s " v;
-      aux e;
-      pr ")"
-    | Unary (op, t) -> begin
+      pr "(let %s " v; aux e; pr ")"
+    | Unary (op, t) ->
         let op = Operator.to_string op in
-        pr "(%s " op; aux t; pr ")";
-      end
-    | Binop (left, op, right) -> begin
+        pr "(%s " op; aux t; pr ")"
+    | Binop (left, op, right) ->
         let op = Operator.to_string op in
-        pr "(%s " op; aux left; pr " "; aux right; pr ")";
-      end
+        pr "(%s " op; aux left; pr " "; aux right; pr ")"
+    | Apply (f, args) ->
+      pr "("; List.iter aux @@ f::args; pr ")"
+
     | Set_binop_pre (op, pre) ->
       pr "(set_pre %s " (Operator.to_string op);
       aux pre;
diff --git a/eval.ml b/eval.ml
index 54e8211..10347e5 100644
--- a/eval.ml
+++ b/eval.ml
@@ -3,6 +3,7 @@ open Ast.Value
 
 exception No_operation
 exception No_such_variable of string
+exception No_such_function of string
 
 let resolve_type op tp =
   let optypes = Operator.get_types op in
@@ -37,6 +38,25 @@ let rec binop op l r =
     end
   | Some f -> f l r
 
+let deg r =
+  r *. 180. /. Float.pi
+
+let rad d =
+  d /. 180. *. Float.pi
+
+let floatfun f = function
+  | Float n -> Float (f n)
+  | v -> raise @@ Invalid_type (typeof v)
+
+let apply f args =
+  match f, args with
+  | "sin", [n] -> floatfun Float.sin n
+  | "cos", [n] -> floatfun Float.cos n
+  | "tan", [n] -> floatfun Float.tan n
+  | "deg", [n] -> floatfun deg n
+  | "rad", [n] -> floatfun rad n
+  | _ -> raise @@ No_such_function f
+
 let eval vars ast =
   let rec aux = function
     | Value v -> v
@@ -55,6 +75,13 @@ let eval vars ast =
       let v = aux e in
       Hashtbl.replace vars var v;
       v
+    | Apply (v, args) ->
+      let args = List.map aux args in
+      begin match v with
+        | Var id -> apply id args
+        | _ -> assert false
+      end
+
     | Set_binop_pre (op, l) ->
       let l =
         match aux l with
diff --git a/main.ml b/main.ml
index 16866f0..6b2f113 100644
--- a/main.ml
+++ b/main.ml
@@ -10,6 +10,7 @@ let error_to_string e =
   | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
   | Ast.Invalid_type t -> sprintf "invalid type %s" (Ast.Type.to_string t)
   | Eval.No_such_variable v -> sprintf "no such variable %s" v
+  | Eval.No_such_function f -> sprintf "no such function \"%s\"" f
   | Failure f -> sprintf "error on %s" f
   | Division_by_zero -> "cannot divide by zero"
   | _ -> raise e
diff --git a/parser.ml b/parser.ml
index 40f7374..12d2331 100644
--- a/parser.ml
+++ b/parser.ml
@@ -117,13 +117,28 @@ let oneof fs seq =
   in
   aux fs
 
+let either f g = fun seq ->
+  try f seq with _ -> g seq
+
 let (@>) f g = fun seq ->
   let a, seq = f seq in
   g a seq
 
+let more f seq =
+  let rec aux xs seq =
+    try
+      let x, seq = f seq in
+      aux (x::xs) seq
+    with
+    | _ -> xs, seq
+  in
+  let xs, seq = aux [] seq in
+  List.rev xs, seq
+
 (* expr := level
  *       | assoc
  *       | let
+ *       | apply
  *       | value binop_right
 *)
 let rec expr pre seq =
@@ -131,9 +146,8 @@ let rec expr pre seq =
     level;
     assoc;
     let_value;
-    (* TODO: merge these two *)
-    unary @> binop pre;
-    value @> binop pre;
+    apply;
+    (either unary value) @> binop pre;
   ]
 
 (* level := "level" {"get" | "set"} [op] *)
@@ -170,6 +184,12 @@ and let_value seq =
   let e, seq = expr min_int seq in
   Let (id, e), seq
 
+(* apply := ident [value]* *)
+and apply seq =
+  let id, seq = any_ident seq in
+  let args, seq = more value seq in
+  Apply (Var id, args), seq
+
 (* unary := - value *)
 and unary seq =
   let op, seq =