From 041426ccc1b8c46578de38cd5a816a38158a51db Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 1 Nov 2017 20:06:02 +0100 Subject: Moved range extraction function in ScTypes.ml --- evaluator.ml | 72 ++++++++------------------------------ scTypes.ml | 111 +++++++++++++++++++++++++++++++++++++++++++++++++++-------- scTypes.mli | 21 ++++++++--- tools.ml | 2 +- 4 files changed, 128 insertions(+), 78 deletions(-) mode change 100644 => 100755 scTypes.ml mode change 100644 => 100755 scTypes.mli 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 old mode 100644 new mode 100755 index ff0af83..f79b4ef --- 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 old mode 100644 new mode 100755 index 5e5b378..de0d6f2 --- 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 diff --git a/tools.ml b/tools.ml index 45c9bab..53b1c15 100755 --- a/tools.ml +++ b/tools.ml @@ -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 -- cgit v1.2.3