1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
(** 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
|
