diff options
| -rwxr-xr-x | evaluator.ml | 72 | ||||
| -rwxr-xr-x[-rw-r--r--] | scTypes.ml | 111 | ||||
| -rwxr-xr-x[-rw-r--r--] | scTypes.mli | 21 | ||||
| -rwxr-xr-x | tools.ml | 2 |
4 files changed, 128 insertions, 78 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)
diff --git a/scTypes.ml b/scTypes.ml index ff0af83..f79b4ef 100644..100755 --- a/scTypes.ml +++ b/scTypes.ml @@ -8,8 +8,6 @@ type cell = Cell.t type ident = UTF8.t -type 'a number_format = (float -> 'a, Format.formatter, unit) format - type _ dataFormat = | Date: DataType.Num.t dataFormat (* Date *) | Number: DataType.Num.t dataFormat (* Number *) @@ -53,18 +51,6 @@ let f_number: DataType.Num.t returnType = Num (Some Number) let f_string: DataType.String.t returnType = Str let f_bool: DataType.Bool.t returnType = Bool -type typeContainer = - | Value: 'a types -> typeContainer - -let guess_format_result: - type a. a returnType -> typeContainer list -> (a -> a types) = - fun return params -> begin match return with - | Str -> fun value -> Str value - | Bool -> fun value -> Bool value - | Num (Some x) -> fun value -> Num (x, value) - | Num None -> fun value -> Num (Number, value) -end - type refs = | Cell of cell (** A cell *) | Range of cell * cell (** An area of cells *) @@ -118,6 +104,32 @@ module Type = struct UTF8.Printf.bprintf buffer "%d/%d/%d" y m d end + type t = + | Value: 'a dataFormat * 'a -> t + + let get_content : type a. a types -> t = begin function + | Num (format, data) -> Value (format, data) + | Str s -> Value (String, s) + | Bool b -> Value (Bool, b) + end + + (* + let guess_format_result: + type a. a returnType -> t list -> (a -> a types) = + fun return params -> begin match return with + | Str -> fun value -> Str value + | Bool -> fun value -> Bool value + | Num (Some x) -> fun value -> Num (x, value) + | Num None -> fun value -> Num (Number, value) + end + *) + + let default_value_for: type a. a dataFormat -> a = function + | Date -> DataType.Num.nan + | Number -> DataType.Num.nan + | Bool -> false + | String -> UTF8.empty + end module Refs = struct @@ -178,6 +190,77 @@ module Refs = struct Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t) end + type 'a content = + | Value: 'a dataFormat * 'a -> 'a content + | List: 'a dataFormat * 'a list -> 'a list content + | Matrix: 'a dataFormat * 'a list list -> 'a list list content + + type refContent = + | C: 'a content -> refContent + + type ('a, 'b) equality = Eq : ('a, 'a) equality + + let compare_format: type a b. a dataFormat -> b dataFormat -> (a, b) equality = + fun a b -> begin match a, b with + | Date, Date -> Eq + | String, String -> Eq + | Number, Number -> Eq + | Date, Number -> Eq + | Number, Date -> Eq + | Bool, Bool -> Eq + | _, _ -> raise Errors.TypeError + end + + (** Add one element in a typed list. + + The function will raise Error.TypeError if the elements does not match + with the list type. + *) + let add_elem: type a b. a dataFormat * a list -> result option -> a dataFormat * a list = + fun (format, elements) result -> + begin match result with + | None -> format, (Type.default_value_for format)::elements + | Some (Error x) -> raise x + | Some (Result r) -> + let Type.Value (format', element) = Type.get_content r in + let Eq = compare_format format format' in + let new_format = if (priority format) < (priority format') then + format + else + format' in + new_format, element::elements + end + + let get_content = begin function + | Single None -> raise Errors.TypeError + | Single (Some (Error x)) -> raise x + | Single (Some (Result r)) -> + let Type.Value (format, c) = Type.get_content r in C (Value (format, c)) + | Array1 l -> + (* Get the first element in the list in order to get the format *) + let Type.Value (format, _) = + begin match (Tools.List.find_map (fun x -> x) l) with + | Error x -> raise x + | Result r -> Type.get_content r + end in + (* Then build an unified list (if we can) *) + let format, values = List.fold_left add_elem (format, []) l in + C (List(format, List.rev values)) + | Array2 l -> + (* Get the first element in the list *) + let Type.Value (format, _) = + begin match (Tools.List.find_map2 (fun x -> x) l) with + | Error x -> raise x + | Result r -> Type.get_content r + end in + (* Then build an unified list *) + let format, values = List.fold_left (fun (format, result) elems -> + let format, elems = List.fold_left add_elem (format, []) elems in + (format, List.rev (elems::result)) + )(format, []) l in + C (Matrix(format, List.rev values)) + end + end module Result = struct diff --git a/scTypes.mli b/scTypes.mli index 5e5b378..de0d6f2 100644..100755 --- a/scTypes.mli +++ b/scTypes.mli @@ -6,8 +6,6 @@ type cell = (int * int) * (bool * bool) type ident = UTF8.t
-type 'a number_format = (float -> 'a, Format.formatter, unit) format
-
type 'a dataFormat =
| Date: DataType.Num.t dataFormat (* A date in julian day *)
| Number: DataType.Num.t dataFormat (* Number *)
@@ -35,9 +33,6 @@ val string: DataType.String.t -> DataType.String.t types val boolean: DataType.Bool.t -> DataType.Bool.t types
val date: DataType.Num.t -> DataType.Num.t types
-type typeContainer =
- | Value: 'a types -> typeContainer
-
(** Numeric (any format) *)
val f_num: DataType.Num.t returnType
@@ -72,6 +67,8 @@ type result = module Type : sig
+ type t = Value: 'a dataFormat * 'a -> t
+
val (=) : 'a types -> 'b types -> bool
val show: UTF8.Buffer.buffer -> 'a types -> unit
@@ -91,6 +88,20 @@ module Refs : sig val shift: (int * int) -> refs -> refs
+ type 'a content =
+ | Value: 'a dataFormat * 'a -> 'a content
+ | List: 'a dataFormat * 'a list -> 'a list content
+ | Matrix: 'a dataFormat * 'a list list -> 'a list list content
+
+ type refContent =
+ | C: 'a content -> refContent
+
+ (** extract the content from a range.
+
+ May raise Errors.TypeError if the range cannot be unified.
+ *)
+ val get_content : result option range -> refContent
+
end
val show_expr: UTF8.Buffer.buffer -> expression -> unit
@@ -143,7 +143,7 @@ module List = struct | [] -> raise Not_found | hd::tl -> begin match f hd with | Some x -> x - | None -> find_map f tl + | None -> (find_map[@tailrec]) f tl end end |