diff options
Diffstat (limited to 'evaluator.ml')
| -rwxr-xr-x | evaluator.ml | 76 |
1 files changed, 35 insertions, 41 deletions
diff --git a/evaluator.ml b/evaluator.ml index 46bbab7..8862b3a 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -7,13 +7,6 @@ module Data = struct type 'a dataFormat = 'a ScTypes.dataFormat
-let most_generic_format: type a. a dataFormat -> a dataFormat -> a dataFormat =
- begin fun a b -> match a, b with
- | ScTypes.Number, x -> x
- | x, ScTypes.Number -> x
- | x, _ -> x
-end
-
(*** Type definitions *)
type _ typ =
@@ -45,7 +38,7 @@ begin fun a b -> | x, y -> if (T.Ex x) > (T.Ex y) then T.Gt else T.Lt
end
-let rec print_typ:
+let rec repr:
type a. Format.formatter -> a typ -> unit =
fun printer typ -> match typ with
| Unit -> Format.fprintf printer "Unit"
@@ -53,7 +46,7 @@ fun printer typ -> match typ with | Num -> Format.fprintf printer "Num"
| String -> Format.fprintf printer "String"
| List t -> Format.fprintf printer "List[%a]"
- print_typ t
+ repr t
type 'a returnType = 'a ScTypes.returnType
@@ -94,13 +87,6 @@ let type_of_value: type a. a value -> a typ = function | List (t, l) -> List (typ_of_format t)
| Matrix (t, l) -> List (List (typ_of_format t))
-let format_of_value: type a. a value -> a ScTypes.dataFormat = function
- | Bool b -> ScTypes.Bool
- | Num (f, _) -> f
- | String s -> ScTypes.String
- | List (t, l) -> raise Errors.TypeError
- | Matrix (t, l) -> raise Errors.TypeError
-
let inject':
type a. a ScTypes.returnType -> (unit -> a ScTypes.dataFormat) -> a -> a value =
fun resultFormat f res -> begin match resultFormat, res with
@@ -144,8 +130,14 @@ end module C = Catalog.Make(Data)
+
+type t = C.t
+
let (catalog:C.t ref) = ref C.empty
+let get_catalog () = !catalog
+
+let repr = C.repr
type existencialResult =
| Result : 'a Data.value -> existencialResult [@@unboxed]
@@ -217,14 +209,14 @@ let call name args = begin with Not_found ->
let signature = List.map (fun (Result x) ->
let formatter = Format.str_formatter in
- Data.print_typ formatter (Data.type_of_value x);
+ Data.repr formatter (Data.type_of_value x);
Format.flush_str_formatter ()) args in
raise (Errors.Undefined (name, signature))
end
end
-let repr mapper value = begin
+let eval mapper value = begin
(** Extract the value from a raw type.
If the value is Undefined, raise an exception.
@@ -331,31 +323,27 @@ let if_: type a. bool -> a -> a -> a = fun a b c -> if a then b else c let () = begin
+ (* Build a date *)
+ register3 "date" (t_int, t_int, t_int) f_date (
+ fun year month day ->
+ Date.get_julian_day
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num year)
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num month)
+ (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num day)
+ |> D.Num.of_num
+ );
+
let module CompareNum = Make_Compare(D.Num) in
Data.(
CompareNum.register t_int;
register0 "rand" f_number D.Num.rnd;
- register1 "+" t_int f_num (fun x -> x);
- register1 "-" t_int f_num D.Num.neg; (* Unary negation *)
- register2 "+" (t_int, t_int) f_num D.Num.add;
- register2 "-" (t_int, t_int) f_num D.Num.sub;
- register2 "*" (t_int, t_int) f_number D.Num.mult;
- register2 "/" (t_int, t_int) f_number D.Num.div;
- register2 "^" (t_int, t_int) f_number D.Num.pow;
-
register3 "if" (t_bool, t_int, t_int) f_number if_;
register3 "if" (t_bool, t_bool, t_bool) f_bool if_;
register3 "if" (t_bool, t_string, t_string) f_string if_;
register1 "abs" t_int f_number D.Num.abs;
- fold "sum" t_int f_number D.Num.add (D.Num.of_num (Num.num_of_int 0));
- fold "product" t_int f_number D.Num.mult (D.Num.of_num (Num.num_of_int 1));
-
- reduce "min" t_int f_num D.Num.min; (* Minimum value from a list *)
- reduce "max" t_int f_num D.Num.max; (* Maximum value from a list *)
-
let module CompareBool = Make_Compare(D.Bool) in
CompareBool.register t_bool;
register0 "true" f_bool (fun () -> D.Bool.true_);
@@ -368,15 +356,21 @@ let () = begin let module CompareString = Make_Compare(D.String) in
CompareString.register t_string;
- (* Build a date *)
- register3 "date" (t_int, t_int, t_int) f_date (
- fun year month day ->
- Date.get_julian_day
- (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num year)
- (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num month)
- (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num day)
- |> D.Num.of_num
- )
+ reduce "min" t_int f_num D.Num.min; (* Minimum value from a list *)
+ reduce "max" t_int f_num D.Num.max; (* Maximum value from a list *)
+
+ fold "sum" t_int f_number D.Num.add (D.Num.of_num (Num.num_of_int 0));
+ fold "product" t_int f_number D.Num.mult (D.Num.of_num (Num.num_of_int 1));
+
+ register1 "+" t_int f_num (fun x -> x);
+ register1 "-" t_int f_num D.Num.neg; (* Unary negation *)
+ register2 "^" (t_int, t_int) f_number D.Num.pow;
+ register2 "+" (t_int, t_int) f_num D.Num.add;
+ register2 "-" (t_int, t_int) f_num D.Num.sub;
+ register2 "*" (t_int, t_int) f_number D.Num.mult;
+ register2 "/" (t_int, t_int) f_number D.Num.div;
+
)
end
+
|