From 3bdff980eaf72ea8be3886e8b4463a45cf4e7dc9 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 2 Nov 2017 13:34:37 +0100 Subject: Add a representation for the splay tree --- evaluator.ml | 76 ++++++++++++++++++++++++++++-------------------------------- 1 file changed, 35 insertions(+), 41 deletions(-) (limited to 'evaluator.ml') 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 + -- cgit v1.2.3