ref: 6b925d234d3c62667127dca76b91fea5ec03204e
parent: cc10399b3b05fc3fcda7f04afe9b34fffa7f743a
author: smazga <smazga@greymanlabs.com>
date: Thu Aug 6 09:37:22 EDT 2020
added core.ml
--- /dev/null
+++ b/core.ml
@@ -1,0 +1,63 @@
+module T = Types.Types
+
+let base = Env.make None
+
+let number_compare t f =
+ Types.proc (function
+ | [ T.Number a; T.Number b ] -> t (f a.value b.value)
+ | _ -> raise (Invalid_argument "not a number"))
+;;
+
+let simple_compare t f =
+ Types.proc (function
+ | [ T.Number a; T.Number b ] -> t (f a b)
+ | _ -> raise (Invalid_argument "incomparable"))
+;;
+
+let mk_num x = Types.number x
+let mk_bool x = T.Bool x
+
+let init env =
+ Env.set env (Types.symbol "+") (number_compare mk_num ( +. ));
+ Env.set env (Types.symbol "-") (number_compare mk_num ( -. ));
+ Env.set env (Types.symbol "*") (number_compare mk_num ( *. ));
+ Env.set env (Types.symbol "/") (number_compare mk_num ( /. ));
+ Env.set env (Types.symbol "<") (simple_compare mk_bool ( < ));
+ Env.set env (Types.symbol "<=") (simple_compare mk_bool ( <= ));
+ Env.set env (Types.symbol ">") (simple_compare mk_bool ( > ));
+ Env.set env (Types.symbol ">=") (simple_compare mk_bool ( >= ));
+ Env.set
+ env
+ (Types.symbol "number?")
+ (Types.proc (function
+ | [ T.Number _ ] -> T.Bool true
+ | _ -> T.Bool false));
+ Env.set env (Types.symbol "list") (Types.proc (function xs -> Types.list xs));
+ Env.set
+ env
+ (Types.symbol "list?")
+ (Types.proc (function
+ | [ T.List _ ] -> T.Bool true
+ | _ -> T.Bool false));
+ Env.set env (Types.symbol "vector") (Types.proc (function xs -> Types.vector xs));
+ Env.set
+ env
+ (Types.symbol "vector?")
+ (Types.proc (function
+ | [ T.Vector _ ] -> T.Bool true
+ | _ -> T.Bool false));
+ Env.set
+ env
+ (Types.symbol "empty?")
+ (Types.proc (function
+ | [ T.List { T.value = [] } ] -> T.Bool true+ | [ T.Vector { T.value = [] } ] -> T.Bool true+ | _ -> T.Bool false));
+ Env.set
+ env
+ (Types.symbol "count")
+ (Types.proc (function
+ | [ T.List { T.value = xs } ] | [ T.Vector { T.value = xs } ] ->+ Types.number (float_of_int (List.length xs))
+ | _ -> Types.number 0.))
+;;