Merge Eval and Env

env.ml

@@ -1,94 +0,0 @@
-type t = {
-  vars : (string, value) Hashtbl.t;
-  parent : t option;
-}
-
-and value =
-  | Int of int
-  | Float of float
-  | String of string
-  | Symbol of string
-  | Function of string list * expr
-  | External of string
-  | Nop (* return of system operations (will be deprecated) *)
-
-and expr = Ast.t
-
-module Type = struct
-  type t =
-    | Int
-    | Float
-    | String
-    | Symbol
-    | Function
-    | External
-
-  let to_string = function
-    | Int -> "int"
-    | Float -> "float"
-    | String -> "string"
-    | Symbol -> "symbol"
-    | Function -> "fun"
-    | External -> "external"
-
-  let supertype = function
-    | Int -> Some Float
-    | _ -> None
-end
-
-module Value = struct
-  type t = value
-
-  let to_string = function
-    | Int n -> string_of_int n
-    | Float n -> string_of_float n
-    | String s -> "\"" ^ s ^ "\""
-    | Symbol s -> "symbol " ^ s
-    | Function (vars, _) ->
-      Printf.sprintf "function with %d arguments" @@ List.length vars
-    | External f -> "external " ^ f
-    | Nop -> "nop"
-
-  let typeof = function
-    | Int _ -> Type.Int
-    | Float _ -> Type.Float
-    | String _ -> Type.String
-    | Symbol _ -> Type.Symbol
-    | Function _ -> Type.Function
-    | External _ -> Type.External
-    | Nop -> failwith "Value.typeof"
-
-  let promote = function
-    | Int n -> Float (float n)
-    | _ -> failwith "Value.promote"
-end
-
-let init_global () = {
-  vars = Hashtbl.create 100;
-  parent = None;
-}
-
-let make parent = {
-  vars = Hashtbl.create 100;
-  parent = Some parent;
-}
-
-exception Not_found
-
-let rec get e name =
-  match Hashtbl.find_opt e.vars name with
-  | None -> begin match e.parent with
-      | None -> raise Not_found
-      | Some p -> get p name
-    end
-  | Some value -> value
-
-let get_opt e name =
-  try Some (get e name)
-  with Not_found -> None
-
-let set e name value =
-  Hashtbl.replace e.vars name value
-
-let add_seq e seq =
-  Hashtbl.add_seq e.vars seq

eval.ml

@@ -1,6 +1,103 @@
 open Ast
-open Env
+
-open Env.Value
+type value =
+  | Int of int
+  | Float of float
+  | String of string
+  | Symbol of string
+  | Function of string list * expr
+  | External of string
+  | Nop (* return of system operations (will be deprecated) *)
+
+and expr = Ast.t
+
+and env = {
+  vars : (string, value) Hashtbl.t;
+  parent : env option;
+}
+
+module Type = struct
+  type t =
+    | Int
+    | Float
+    | String
+    | Symbol
+    | Function
+    | External
+
+  let to_string = function
+    | Int -> "int"
+    | Float -> "float"
+    | String -> "string"
+    | Symbol -> "symbol"
+    | Function -> "fun"
+    | External -> "external"
+
+  let supertype = function
+    | Int -> Some Float
+    | _ -> None
+end
+
+module Value = struct
+  type t = value
+
+  let to_string = function
+    | Int n -> string_of_int n
+    | Float n -> string_of_float n
+    | String s -> "\"" ^ s ^ "\""
+    | Symbol s -> "symbol " ^ s
+    | Function (vars, _) ->
+      Printf.sprintf "function with %d arguments" @@ List.length vars
+    | External f -> "external " ^ f
+    | Nop -> "nop"
+
+  let typeof = function
+    | Int _ -> Type.Int
+    | Float _ -> Type.Float
+    | String _ -> Type.String
+    | Symbol _ -> Type.Symbol
+    | Function _ -> Type.Function
+    | External _ -> Type.External
+    | Nop -> failwith "Value.typeof"
+
+  let promote = function
+    | Int n -> Float (float n)
+    | _ -> failwith "Value.promote"
+end
+
+module Env = struct
+  type t = env
+
+  let init_global () = {
+    vars = Hashtbl.create 100;
+    parent = None;
+  }
+
+  let make parent = {
+    vars = Hashtbl.create 100;
+    parent = Some parent;
+  }
+
+  exception Not_found
+
+  let rec get e name =
+    match Hashtbl.find_opt e.vars name with
+    | None -> begin match e.parent with
+        | None -> raise Not_found
+        | Some p -> get p name
+      end
+    | Some value -> value
+
+  let get_opt e name =
+    try Some (get e name)
+    with Not_found -> None
+
+  let set e name value =
+    Hashtbl.replace e.vars name value
+
+  let add_seq e seq =
+    Hashtbl.add_seq e.vars seq
+end
 
 exception No_operation
 exception No_such_variable of string
@@ -60,6 +157,27 @@ module Operator = struct
     |> List.assoc_opt typ
 end
 
+module External = struct
+  let rad r =
+    r *. 180. /. Float.pi
+
+  let deg d =
+    d /. 180. *. Float.pi
+
+  let floatfun f = function
+    | Float n -> Float (f n)
+    | v -> raise @@ Invalid_type (Value.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
+end
+
 let assert_same_length vars args =
   let vl = List.length vars
   and al = List.length args in
@@ -85,6 +203,7 @@ let resolve_type op tp =
   aux tp
 
 let rec binop op l r =
+  let open Value in
   let t1 = typeof l and t2 = typeof r in
   let t1, t2 = resolve_type op (t1, t2) in
   let rec promote_until t x =
@@ -101,26 +220,7 @@ let rec binop op l r =
     end
   | Some f -> f l r
 
-let rad r =
+let rec eval env ast : value =
-  r *. 180. /. Float.pi
-
-let deg d =
-  d /. 180. *. Float.pi
-
-let floatfun f = function
-  | Float n -> Float (f n)
-  | v -> raise @@ Invalid_type (typeof v)
-
-let ex_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 rec eval env ast =
   let rec aux = function
     | Nint n -> Int n
     | Nfloat n -> Float n
@@ -153,14 +253,14 @@ let rec eval env ast =
           eval nenv e
         | External f ->
           let args = List.map aux args in
-          ex_apply f args
+          External.apply f args
-        | v -> raise @@ Invalid_type (typeof v)
+        | v -> raise @@ Invalid_type (Value.typeof v)
       end
     | Set_binop_pre (op, l) ->
       let l =
         match aux l with
         | Int n -> n
-        | v -> raise @@ Invalid_type (typeof v)
+        | v -> raise @@ Invalid_type (Value.typeof v)
       in
       Hashtbl.replace Parser.precedence op l;
       Nop

main.ml

@@ -1,4 +1,5 @@
 open Printf
+open Eval
 
 let version = "%%VERSION%%"
 
@@ -8,7 +9,7 @@ let error_to_string e =
   | Lex.Expected c -> sprintf "expected %c" c
   | Parser.Expected t -> sprintf "expected %s" t
   | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
-  | Eval.Invalid_type t -> sprintf "invalid type %s" (Env.Type.to_string t)
+  | Eval.Invalid_type t -> sprintf "invalid type %s" (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
   | Eval.Too_many_arguments -> "applied too many arguments"
@@ -24,7 +25,7 @@ let stdlib = [
   "deg"; "rad";
 ]
   |> List.to_seq
-  |> Seq.map (fun v -> v, Env.External v)
+  |> Seq.map (fun v -> v, External v)
 
 let g =
   let g = Env.init_global () in
@@ -46,12 +47,12 @@ let rep env : unit =
   | Nop -> ()
   | _ ->
     Env.set env "ans" v;
-    printf "%s\n" @@ Env.Value.to_string v
+    printf "%s\n" @@ Value.to_string v
 
 exception Reset_line (* used to indicate ^C is pressed *)
 
 let init_repl () =
-  Env.set g "ans" (Env.Int 0);
+  Env.set g "ans" (Int 0);
   (* treat Ctrl-C as to reset line *)
   let reset_line _ = raise Reset_line in
   Sys.(set_signal sigint (Signal_handle reset_line))