aboutsummaryrefslogtreecommitdiff
path: root/scTypes.ml
diff options
context:
space:
mode:
Diffstat (limited to 'scTypes.ml')
-rwxr-xr-x[-rw-r--r--]scTypes.ml111
1 files changed, 97 insertions, 14 deletions
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