diff options
Diffstat (limited to 'evaluator.ml')
| -rwxr-xr-x | evaluator.ml | 74 |
1 files changed, 41 insertions, 33 deletions
diff --git a/evaluator.ml b/evaluator.ml index 3adf7fa..490ab43 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -1,8 +1,6 @@ module D = DataType
module T = Tools
-let u = UTF8.from_utf8string
-
exception RegisteredFunction
(** Data format *)
@@ -392,32 +390,25 @@ let repr mapper value = begin | ScTypes.Bool b -> Result (Bool b)
| ScTypes.Date d -> Result (Num (Date, (D.Num.of_num d)))
| ScTypes.Str s -> Result (String s)
- | ScTypes.Undefined -> raise Errors.TypeError
end in
- (** Extract the value from a raw type.
- If the value is Undefined, provide a default result.
- *)
- let guess_value: type a. a typ -> ScTypes.types -> existencialResult = fun typ value -> begin
- try extract_value value with Errors.TypeError ->
- match typ with
+ let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types option -> a list * a dataFormat =
+ begin fun type_of (result, format_of) next ->
+ let Result r = match next with
+ | Some x -> extract_value x
+ | None -> begin match type_of with
| Num -> Result (Num (Number, (D.Num.nan)))
| Bool -> Result (Bool false)
- | String -> Result (String (u""))
+ | String -> Result (String (UTF8.empty))
| List x -> Result (List ((default_format_for_type x), []))
| Unit -> raise Errors.TypeError
- end in
-
-
- let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types -> a list * a dataFormat =
- begin fun type_of (result, format_of) next ->
- let Result r = guess_value type_of next in
- begin match compare_typ type_of (type_of_value r) with
- | T.Eq ->
- let l' = (get_value_content r)::result in
- l' , (most_generic_format (format_of_value r) format_of)
- | _ -> raise Errors.TypeError
- end
+ end in
+ begin match compare_typ type_of (type_of_value r) with
+ | T.Eq ->
+ let l' = (get_value_content r)::result in
+ l' , (most_generic_format (format_of_value r) format_of)
+ | _ -> raise Errors.TypeError
+ end
end in
(* Return the result for any expression as an ScTypes.types result *)
@@ -449,11 +440,14 @@ let repr mapper value = begin (* For a reference to an external we first extract the value pointed *)
| ScTypes.Ref r ->
begin match mapper r with
- | ScTypes.Refs.Single v -> extract_value v
+ | ScTypes.Refs.Single v ->
+ begin match v with
+ | None -> raise Errors.TypeError
+ | Some v -> extract_value v
+ end
| ScTypes.Refs.Array1 l ->
-
(* Guess the list type from it's first defined element *)
- let Result r = extract_value (List.find ((!=) ScTypes.Undefined) l) in
+ let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in
let format_of = format_of_value r in
let type_of = type_of_value r in
(* Build the list with all the elements *)
@@ -461,7 +455,8 @@ let repr mapper value = begin Result (List (format, elems))
| ScTypes.Refs.Array2 l ->
(* Guess the list type from it's first defined element *)
- let Result r = extract_value (Tools.List.find2 ((!=) ScTypes.Undefined) l) in
+ let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in
+
let format_of = format_of_value r in
let type_of = type_of_value r in
(* Build the list with all the elements *)
@@ -526,14 +521,17 @@ let () = begin let module CompareNum = MAKE(D.Num) in
CompareNum.register t_int;
- register0 "rand" f_number D.Num.rnd;
- 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;
+ register0 "rand" f_number D.Num.rnd;
- register1 "abs" t_int f_number D.Num.abs;
+ 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;
+
+ 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));
@@ -553,4 +551,14 @@ let () = begin let module CompareString = MAKE(D.String) in
CompareString.register t_string;
+ (* Build a date *)
+ register3 "date" (t_int, t_int, t_int) f_date (
+ fun year month day ->
+ Tools.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
+ )
+
end
|