Move Value module into Env

ast.ml

@@ -30,6 +30,7 @@ type t =
   | Unary of operator * t
   | Binop of t * operator * t
   | Apply of t * t list (* function application *)
+  (* these will be seperated into (toplevel) directives. *)
   | Set_binop_pre of operator * t
   | Get_binop_pre of operator
   | Set_binop_aso of operator * string
@@ -41,101 +42,14 @@ and operator =
   | Exp (* exponentation *)
   | Negate
 
-exception Invalid_type of Type.t
+let op_to_string = function
-
+  | Add -> "+"
-module Value = struct
+  | Sub -> "-"
-  type expr = t
+  | Mul -> "*"
-
+  | Div -> "/"
-  type t =
+  | Mod -> "%"
-  | Int of int
+  | Exp -> "^"
-  | Float of float
+  | Negate -> "-"
-  | String of string
-  | Function of string list * expr
-  | External of string
-  | Nop (* return of system operations (will be deprecated) *)
-
-  let to_string = function
-    | Int n -> string_of_int n
-    | Float n -> string_of_float n
-    | String s -> "\"" ^ 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
-    | Function _ -> Type.Function
-    | External _ -> Type.External
-    | Nop -> failwith "Value.typeof"
-
-  let promote = function
-    | Int n -> Float (float n)
-    | Float n -> Float n
-    | _ -> failwith "Value.promote"
-end
-
-(* operators *)
-module Operator = struct
-  type t = operator
-
-  exception Unavailable of t
-
-  let to_string = function
-    | Add -> "+"
-    | Sub -> "-"
-    | Mul -> "*"
-    | Div -> "/"
-    | Mod -> "%"
-    | Exp -> "^"
-    | Negate -> "-"
-
-  open Value
-
-  let negate = function
-    | Int n -> Int ~-n
-    | Float n -> Float ~-.n
-    | _ -> failwith "Operator.negate"
-
-  let vi f a b =
-    match a, b with
-    | Int a, Int b -> Int (f a b)
-    | _ -> raise @@ Invalid_type Int
-
-  let vf f a b =
-    match a, b with
-    | Float a, Float b -> Float (f a b)
-    | _ -> raise @@ Invalid_type Float
-
-  let operators =
-    let open Type in
-    let ip = Int, Int and fp = Float, Float in
-    [
-      Add, [ip, vi Int.add; fp, vf Float.add];
-      Sub, [ip, vi Int.sub; fp, vf Float.sub];
-      Mul, [ip, vi Int.mul; fp, vf Float.mul];
-      Div, [ip, vi Int.div; fp, vf Float.div];
-      Mod, [ip, vi Int.rem; fp, vf Float.rem];
-      Exp, [fp, vf Float.pow];
-    ]
-    |> List.to_seq
-    |> Hashtbl.of_seq
-
-  let get_types op =
-    match Hashtbl.find_opt operators op with
-    | None -> raise @@ Unavailable op
-    | Some p -> List.map fst p
-
-  let get_unary = function
-    | Negate -> negate
-    | op -> raise @@ Unavailable op
-
-  let get_binary op typ =
-    Hashtbl.find operators op
-    |> List.assoc_opt typ
-end
 
 let unary op t =
   Unary (op, t)
@@ -159,23 +73,23 @@ let print ast =
     | Let (v, e) ->
       pr "(let %s " v; aux e; pr ")"
     | Unary (op, t) ->
-      let op = Operator.to_string op in
+      let op = op_to_string op in
       pr "(%s " op; aux t; pr ")"
     | Binop (left, op, right) ->
-      let op = Operator.to_string op in
+      let op = op_to_string op in
       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);
+      pr "(set_pre %s " (op_to_string op);
       aux pre;
       pr ")"
     | Get_binop_pre op ->
-      pr "(get_pre %s)" (Operator.to_string op)
+      pr "(get_pre %s)" (op_to_string op)
     | Set_binop_aso (op, aso) ->
-      pr "(set_assoc %s %s)" (Operator.to_string op) aso
+      pr "(set_assoc %s %s)" (op_to_string op) aso
     | Get_binop_aso op ->
-      pr "(get_pre %s)" (Operator.to_string op)
+      pr "(get_pre %s)" (op_to_string op)
   in
   aux ast; pr "\n"

env.ml

@@ -1,10 +1,44 @@
-module Value = Ast.Value
-
 type t = {
-  vars : (string, Value.t) Hashtbl.t;
+  vars : (string, value) Hashtbl.t;
   parent : t option;
 }
 
+and value =
+  | Int of int
+  | Float of float
+  | String of string
+  | Function of string list * expr
+  | External of string
+  | Nop (* return of system operations (will be deprecated) *)
+
+and expr = Ast.t
+
+module Value = struct
+  module Type = Ast.Type
+  type t = value
+
+  let to_string = function
+    | Int n -> string_of_int n
+    | Float n -> string_of_float n
+    | String s -> "\"" ^ 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
+    | 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;

eval.ml

@@ -1,12 +1,65 @@
 open Ast
-open Ast.Value
+open Env
+open Env.Value
 
 exception No_operation
 exception No_such_variable of string
 exception No_such_function of string
+exception Invalid_type of Type.t
 
 exception Too_many_arguments
 
+(* operators *)
+module Operator = struct
+  type t = Ast.operator
+
+  exception Unavailable of t
+
+  let to_string = Ast.op_to_string
+
+  let negate = function
+    | Int n -> Int ~-n
+    | Float n -> Float ~-.n
+    | _ -> failwith "Operator.negate"
+
+  let vi f a b =
+    match a, b with
+    | Int a, Int b -> Int (f a b)
+    | _ -> raise @@ Invalid_type Int
+
+  let vf f a b =
+    match a, b with
+    | Float a, Float b -> Float (f a b)
+    | _ -> raise @@ Invalid_type Float
+
+  let operators =
+    let open Type in
+    let ip = Int, Int and fp = Float, Float in
+    [
+      Add, [ip, vi Int.add; fp, vf Float.add];
+      Sub, [ip, vi Int.sub; fp, vf Float.sub];
+      Mul, [ip, vi Int.mul; fp, vf Float.mul];
+      Div, [ip, vi Int.div; fp, vf Float.div];
+      Mod, [ip, vi Int.rem; fp, vf Float.rem];
+      Exp, [fp, vf Float.pow];
+    ]
+    |> List.to_seq
+    |> Hashtbl.of_seq
+
+  let get_types op =
+    match Hashtbl.find_opt operators op with
+    | None -> raise @@ Unavailable op
+    | Some p -> List.map fst p
+
+  let get_unary = function
+    | Negate -> negate
+    | op -> raise @@ Unavailable op
+
+  let get_binary op typ =
+    Hashtbl.find operators op
+    |> List.assoc_opt typ
+end
+
 let assert_same_length vars args =
   let vl = List.length vars
   and al = List.length args in
@@ -14,7 +67,6 @@ let assert_same_length vars args =
     failwith "assert_same_length"
   else if vl < al then
     raise Too_many_arguments
-  else ()
 
 let resolve_type op tp =
   let optypes = Operator.get_types op in

main.ml

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