(** All the types used in the spreadsheet. *) let u = UTF8.from_utf8string exception Error 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 refs = | 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 *) (** Result from a computation *) type result = | Result of types | Error of exn module Type = struct (* Required because Num.Big_int cannot be compared with Pervasives.(=) *) let (=) 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 (** Show a list of elements *) let rec show_list printer buffer = begin function | [] -> () | hd::[] -> UTF8.Printf.bprintf buffer "%a" printer hd | hd::tl -> UTF8.Printf.bprintf buffer "%a, " printer hd; 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 | 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 UTF8.Printf.bprintf buffer "%d/%d/%d" y m d end end module Refs = struct type 'a range = | Single of 'a | Array1 of 'a list | Array2 of 'a list list let collect = function | Cell x -> Single (Pervasives.fst x) | Range (fst, snd) -> let (x1, y1) = Pervasives.fst fst and (x2, y2) = Pervasives.fst snd in let min_x = min x1 x2 and max_x = max x1 x2 and min_y = min y1 y2 and max_y = max y1 y2 in if (min_x = max_x) || (min_y = max_y) then ( (* There is only a one dimension array *) let elms = ref [] in for x = min_x to max_x do for y = min_y to max_y do elms := (x, y)::!elms done done; Array1 (!elms) ) else ( (* This a two-dimension array *) let elmx = ref [] in for x = min_x to max_x do let elmy = ref [] in for y = min_y to max_y do elmy := (x, y)::!elmy done; elmx := !elmy::!elmx done; Array2 (!elmx) ) let map f = function | Single coord -> Single (f coord) | Array1 values -> Array1 (List.map f values) | Array2 values -> Array2 (List.map (List.map f) values) let shift (vector_x, vector_y) ref = let _shift ((x, y), (fixed_x, fixed_y)) = let x' = if fixed_x then x else x + vector_x and y' = if fixed_y then y else y + vector_y in (x', y'), (fixed_x, fixed_y) in match ref with | Cell x -> Cell (_shift x) | Range (fst, snd) -> Range (_shift fst, _shift snd) let show buffer = begin function | Cell r -> UTF8.Buffer.add_string buffer @@ Cell.to_string r | Range (f,t) -> Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t) end end module Result = struct let (=) t1 t2 = match t1, t2 with | Result v1, Result v2 -> Type.(=) v1 v2 | _, _ -> t1 = t2 let show = begin function | Error x -> (* let buffer = Buffer.create 16 in let b = Format.formatter_of_buffer buffer in Errors.printf b x; Format.pp_print_flush b (); u(Buffer.contents buffer) *) u"#Error" | Result v -> let buffer = UTF8.Buffer.create 16 in Type.show buffer v; UTF8.Buffer.contents buffer end end (** Represent an expression. *) let rec show_expr buffer : expression -> unit = begin function | Value (Str x) -> (** Print the value with quotes *) UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string x) | Value v -> Type.show buffer v | Ref r -> Refs.show buffer r | Call (ident, params) -> let utf8ident = UTF8.to_utf8string ident in begin match utf8ident with | "+" | "*" | "-" | "/" | "^" | "=" | "<>" | "<=" | ">=" | "<" | ">" -> begin match params with | v1::[] -> UTF8.Printf.bprintf buffer "%s%a" utf8ident show_expr v1 | v1::v2::[] -> UTF8.Printf.bprintf buffer "%a%s%a" show_expr v1 utf8ident show_expr v2 | _ -> UTF8.Buffer.add_string buffer ident; Tools.List.printb ~sep:(u";") show_expr buffer params end | _ -> UTF8.Buffer.add_string buffer ident; Tools.List.printb ~sep:(u";") show_expr buffer params end | Expression expr -> UTF8.Printf.bprintf buffer "(%a)" show_expr expr end