aboutsummaryrefslogtreecommitdiff
path: root/scTypes.ml
diff options
context:
space:
mode:
Diffstat (limited to 'scTypes.ml')
-rwxr-xr-xscTypes.ml104
1 files changed, 73 insertions, 31 deletions
diff --git a/scTypes.ml b/scTypes.ml
index 869df8b..f8c3d38 100755
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -8,36 +8,79 @@ type cell = Cell.t
type ident = UTF8.t
-type types =
- | Num of Num.num * (UTF8.t option) (** A number *)
- | Str of UTF8.t (** A string *)
- | Date of Num.num (** A date in julian day *)
- | Bool of bool (** A boolean *)
+type 'a number_format = (float -> 'a, Format.formatter, unit) format
+
+type _ dataFormat =
+ | Date: DataType.Num.t dataFormat (* Date *)
+ | Number: DataType.Num.t dataFormat (* Number *)
+ | String: DataType.String.t dataFormat (* String result, there is only one representation *)
+ | Bool: DataType.Bool.t dataFormat (* Boolean result *)
+
+type numericType =
+ | Date
+ | Number
+
+let get_numeric_type: DataType.Num.t dataFormat -> numericType = function
+ | Date -> Date
+ | Number -> Number
+
+let priority: type a. a dataFormat -> int = function
+ | Date -> 1
+ | Number -> 0
+ | String -> 0
+ | Bool -> 0
+
+type 'a types =
+ | Num : DataType.Num.t dataFormat * DataType.Num.t -> DataType.Num.t types (** A number *)
+ | Str : DataType.String.t -> DataType.String.t types (** A string *)
+ | Bool : DataType.Bool.t -> DataType.Bool.t types (** A boolean *)
+
+type 'a returnType =
+ | Num : DataType.Num.t dataFormat option -> DataType.Num.t returnType (** A number *)
+ | Str : DataType.String.t returnType (** A string *)
+ | Bool : DataType.Bool.t returnType (** A boolean *)
+
+let f_num: DataType.Num.t returnType = Num None
+let f_date: DataType.Num.t returnType = Num (Some Date)
+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 *)
+ | Cell of cell (** A cell *)
+ | Range of cell * cell (** An area of cells *)
type expression =
- | Value of types (** A direct value *)
- | Ref of refs (** A reference to another cell *)
- | Call of ident * expression list (** A call to a function *)
- | Expression of expression (** An expression *)
+ | Value : 'a types -> expression (** A direct value *)
+ | Ref : refs -> expression (** A reference to another cell *)
+ | Call : ident * expression list -> expression (** A call to a function *)
+ | Expression : expression -> expression (** An expression *)
(** Result from a computation *)
type result =
- | Result of types
- | Error of exn
+ | Result : 'a types -> result
+ | Error : exn -> result
module Type = struct
(* Required because Num.Big_int cannot be compared with Pervasives.(=) *)
- let (=) t1 t2 =
+ let (=) : type a b. a types -> b types -> bool = fun t1 t2 ->
match t1, t2 with
- | Num (n1,_), Num (n2,_) -> Num.eq_num n1 n2
- | Date n1, Date n2 -> Num.eq_num n1 n2
- | Num _, Date n2 -> false
- | Date n1, Num _ -> false
- | _, _ -> t1 = t2
+ | Num (_, n1), Num (_, n2) -> DataType.Num.eq n1 n2
+ | Bool b1, Bool b2 -> b1 = b2
+ | Str s1, Str s2 -> s1 = s2
+ | _, _ -> false
(** Show a list of elements
*)
@@ -52,20 +95,19 @@ module Type = struct
show_list printer buffer tl
end
- and show buffer = begin function
- | Num (n,x) ->
- begin match x with
- | Some value -> UTF8.Buffer.add_string buffer value
- | None ->
- if Num.is_integer_num n then
- UTF8.Buffer.add_string buffer @@ u(Num.string_of_num n)
- else
- UTF8.Printf.bprintf buffer "%.*f" 2 (Num.float_of_num n)
- end
+ and show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function
| Str x -> UTF8.Buffer.add_string buffer x
| Bool b -> UTF8.Printf.bprintf buffer "%B" b
- | Date n ->
- let y, m, d = Tools.Date.date_from_julian_day n in
+ | Num (Number, n) ->
+ let n = DataType.Num.to_num n in
+ if Num.is_integer_num n then
+ UTF8.Buffer.add_string buffer @@ u(Num.string_of_num n)
+ else
+ let to_b = UTF8.Format.formatter_of_buffer buffer in
+ ignore @@ UTF8.Format.fprintf to_b "%.2f" (Num.float_of_num n);
+ Format.pp_print_flush to_b ()
+ | Num (Date, n) ->
+ let y, m, d = Date.date_from_julian_day (DataType.Num.to_num n) in
UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
end