diff options
Diffstat (limited to 'src/evaluator.ml')
| -rwxr-xr-x | src/evaluator.ml | 150 |
1 files changed, 0 insertions, 150 deletions
diff --git a/src/evaluator.ml b/src/evaluator.ml deleted file mode 100755 index 05b975f..0000000 --- a/src/evaluator.ml +++ /dev/null @@ -1,150 +0,0 @@ -module D = DataType
-module F = Functions
-
-module Data = struct
-
- (*** Values definitions *)
-
- type 'a value =
- | Bool: D.Bool.t -> D.Bool.t value
- | Num: D.Num.t ScTypes.dataFormat * D.Num.t -> D.Num.t value
- | String: UTF8.t -> UTF8.t value
- | List: 'a ScTypes.dataFormat * 'a list -> 'a list value
- | Matrix: 'a ScTypes.dataFormat * 'a list list -> 'a list list value
-
- (** Extract the type and the content from a value *)
- let get_argument: type a. a value -> a F.typ * a = function
- | Bool b -> F.t_bool, b
- | Num (_, n) -> F.t_int, n
- | String s -> F.t_string, s
- | List (t, l) -> F.t_list (F.typ_of_format t), l
- | Matrix (t, l) -> F.t_list (F.t_list (F.typ_of_format t)), l
-
-end
-
-(** Functions are stored as a mutable catalog. A setter is given *)
-let catalog = ref (F.C.compile F.C.empty)
-
-let set_catalog t = catalog := t
-
-type existencialResult =
- | Result : 'a Data.value -> existencialResult [@@unboxed]
-
-let inject:
-type a. a ScTypes.dataFormat -> a -> existencialResult = fun resultFormat res ->
- begin match resultFormat with
- | ScTypes.Bool -> Result (Data.Bool res)
- | ScTypes.String -> Result (Data.String res)
- | ScTypes.Number -> Result (Data.Num (resultFormat, res))
- | ScTypes.Date -> Result (Data.Num (resultFormat, res))
- end
-
-
-(** Extract the format from a list of results *)
-let build_format_list ll () =
-
- List.map (fun (Result x) ->
- begin match x with
- | Data.Bool _ -> ScTypes.DataFormat.F (ScTypes.Bool)
- | Data.Num (x, _) -> ScTypes.DataFormat.F x
- | Data.String _ -> ScTypes.DataFormat.F (ScTypes.String)
- | Data.List (f, _) -> ScTypes.DataFormat.F f
- | Data.Matrix (f, _) -> ScTypes.DataFormat.F f
- end
- ) ll
-
-(** Call the function with the arguments *)
-let call name args = begin
- let name' = UTF8.to_utf8string name in
- begin try match args with
- | [] ->
- let arg1 = (F.t_unit, ()) in
- let F.C.R(ret, res) = F.C.eval1 !catalog name' arg1 in
- let returnType = ScTypes.DataFormat.guess_format_result ret (fun () -> raise Errors.TypeError) in
- inject returnType res
-
- | (Result p1)::[] ->
- let arg1 = Data.get_argument p1 in
- let F.C.R(ret, res) = F.C.eval1 !catalog name' arg1 in
- let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in
- inject returnType res
-
- | (Result p1)::(Result p2)::[] ->
- let arg1 = Data.get_argument p1
- and arg2 = Data.get_argument p2 in
- let F.C.R(ret, res) = F.C.eval2 !catalog name' arg1 arg2 in
- let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in
- inject returnType res
-
- | (Result p1)::(Result p2)::(Result p3)::[] ->
- let arg1 = Data.get_argument p1
- and arg2 = Data.get_argument p2
- and arg3 = Data.get_argument p3 in
- let F.C.R(ret, res) = F.C.eval3 !catalog name' arg1 arg2 arg3 in
- let returnType = ScTypes.DataFormat.guess_format_result ret (build_format_list args) in
- inject returnType res
-
- | _ -> raise Not_found
- with Not_found ->
- let signature = List.map (fun (Result x) ->
- let formatter = Format.str_formatter in
- Functions.repr formatter (fst @@ Data.get_argument x);
- Format.flush_str_formatter ()) args in
-
- raise (Errors.Undefined (name, signature))
- end
-end
-
-let eval mapper value = begin
-
- (** Extract the value from a raw type.
- If the value is Undefined, raise an exception.
- *)
- let extract_value : ScTypes.result -> existencialResult = begin function
- | ScTypes.Result (ScTypes.Num (f, n)) -> Result (Data.Num (f, n))
- | ScTypes.Result (ScTypes.Bool b) -> Result (Data.Bool b)
- | ScTypes.Result (ScTypes.Str s) -> Result (Data.String s)
- | ScTypes.Error x -> raise x
- end in
-
- (** Extract the value from an expression.
- [extract expr] will evaluate the expression and return it. If the result
- cannot be evaluated (because of references pointing to missing values) a
- default value of type [typ] will be returned.
- *)
- let rec extract = begin function
- (* For a reference to an external we first extract the value pointed *)
- | ScTypes.Ref r -> ScTypes.Refs.(
- begin match ScTypes.Refs.get_content @@ mapper r with
- | Value (format, f) -> begin match format with
- | ScTypes.Date -> Result (Data.Num (format, f))
- | ScTypes.Number -> Result (Data.Num (format, f))
- | ScTypes.String -> Result (Data.String f)
- | ScTypes.Bool -> Result (Data.Bool f)
- end
- | List (format, l) -> Result (Data.List (format, l))
- | Matrix (format, l) -> Result (Data.Matrix (format, l))
- end)
-
- (* Evaluate the expression *)
- | ScTypes.Expression e -> extract e
- | ScTypes.Value v -> extract_value (ScTypes.Result v)
- | ScTypes.Call (name, args) ->
- (* The function is not tail recursive, but I don't think we will have
- more than 100 nested functions here... *)
- let args' = List.map extract args in
- call name args'
- end in
-
- let Result r = extract value in
- begin match r with
- | Data.Bool b -> ScTypes.Result (ScTypes.boolean b)
- | Data.String s -> ScTypes.Result (ScTypes.string s)
- | Data.Num (format, n) ->
- begin match ScTypes.get_numeric_type format with
- | ScTypes.Date -> ScTypes.Result (ScTypes.date n)
- | ScTypes.Number -> ScTypes.Result (ScTypes.number n)
- end
- | _ -> raise Errors.TypeError
- end
-end
|