aboutsummaryrefslogtreecommitdiff
path: root/evaluator.ml
diff options
context:
space:
mode:
Diffstat (limited to 'evaluator.ml')
-rwxr-xr-xevaluator.ml72
1 files changed, 14 insertions, 58 deletions
diff --git a/evaluator.ml b/evaluator.ml
index 46123cb..0d8c0f7 100755
--- a/evaluator.ml
+++ b/evaluator.ml
@@ -29,8 +29,7 @@ let typ_of_format: type a. a ScTypes.dataFormat -> a typ = function
| ScTypes.String -> String
| ScTypes.Bool -> Bool
-let rec compare_typ:
-type a b. a typ -> b typ -> (a, b) T.cmp =
+let rec compare_typ: type a b. a typ -> b typ -> (a, b) T.cmp =
begin fun a b ->
match a, b with
| Unit, Unit -> T.Eq
@@ -56,13 +55,6 @@ fun printer typ -> match typ with
| List t -> Format.fprintf printer "List[%a]"
print_typ t
-let default_format_for_type: type a. a typ -> a ScTypes.dataFormat = function
- | Num -> ScTypes.Date
- | String -> ScTypes.String
- | Bool -> ScTypes.Bool
- | List _ -> raise Errors.TypeError
- | Unit -> raise Errors.TypeError
-
type 'a returnType = 'a ScTypes.returnType
let specialize_result: type a. a ScTypes.returnType -> a ScTypes.dataFormat -> a ScTypes.returnType =
@@ -127,7 +119,7 @@ fun init_typ currentResult value ->
| Bool b -> ScTypes.Bool
| String s -> ScTypes.Str
| Num (f, v) -> specialize_result currentResult f
- (* There is no possibility to get init_typ as List typ*)
+ (* There is no possibility to get init_typ as List typ *)
| List (f, v) -> raise Errors.TypeError
| Matrix (f, v) -> raise Errors.TypeError
end
@@ -244,25 +236,6 @@ let repr mapper value = begin
| ScTypes.Error x -> raise x
end in
- let add_elem: type a. a Data.typ -> a list * a Data.dataFormat -> ScTypes.result option -> a list * a Data.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
- | Data.Num -> Result (Data.Num (ScTypes.Number, D.Num.nan))
- | Data.Bool -> Result (Data.Bool false)
- | Data.String -> Result (Data.String (UTF8.empty))
- | Data.List x -> Result (Data.List ((Data.default_format_for_type x), []))
- | Data.Unit -> raise Errors.TypeError
- end in
- begin match Data.compare_typ type_of (Data.type_of_value r) with
- | T.Eq ->
- let l' = (Data.get_value_content r)::result in
- l' , (Data.most_generic_format (Data.format_of_value r) format_of)
- | _ -> raise Errors.TypeError
- end
- end in
-
(** Extract the value from an expression.
[extract typ expr] will evaluate the expression and return it. If the
result cannot be evaluated (because of references pointing to missing
@@ -270,44 +243,27 @@ let repr mapper value = begin
*)
let rec extract = begin function
(* For a reference to an external we first extract the value pointed *)
- | ScTypes.Ref r ->
- begin match mapper r with
- | ScTypes.Refs.Single v ->
- begin match v with
- | None -> raise Errors.TypeError
- | Some v -> extract_value v
+ | ScTypes.Ref r -> ScTypes.Refs.(
+ begin match ScTypes.Refs.get_content @@ mapper r with
+ | C (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
- | ScTypes.Refs.Array1 l ->
- (* Guess the list type from it's first defined element *)
- let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in
- let format_of = Data.format_of_value r
- and type_of = Data.type_of_value r in
- (* Build the list with all the elements *)
- let elems, format = List.fold_left (add_elem type_of) ([], format_of) l in
- Result (Data.List (format, elems))
- | ScTypes.Refs.Array2 l ->
- (* Guess the list type from it's first defined element *)
- let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in
-
- let format_of = Data.format_of_value r
- and type_of = Data.type_of_value r in
- (* Build the list with all the elements *)
- let elems, format = List.fold_left (fun (result, format_of) elems ->
- let elems, format = List.fold_left (add_elem type_of) ([], format_of) elems in
- elems::result, (Data.most_generic_format format_of format)
- ) ([], format_of) l in
- Result (Data.Matrix (format, elems))
- end
+ | C (List (format, l)) -> Result (Data.List (format, l))
+ | C (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) ->
- let args' = List.map extract args in
+ let args' = List.map extract args in
call name args'
end
in
- let Result r = (extract value) in
+ let Result r = ((extract[@tailrec]) value) in
begin match r with
| Data.Bool b -> ScTypes.Result (ScTypes.boolean b)
| Data.String s -> ScTypes.Result (ScTypes.string s)