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
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
|
type cell = int * int
type search = [
| `Pattern of ScTypes.Result.t option
| `Next
| `Previous
]
module Raw = struct
type content = {
expr : Expression.t; (** The expression *)
value : ScTypes.Result.t option; (** The content evaluated *)
sink : Cell.Set.t; (** All the cell which references this one *)
}
(** An empty cell which does contains nothing *)
let empty_cell = {
expr = Expression.Undefined;
value = None;
sink = Cell.Set.empty;
}
(** Internaly, we use an array to store the data. Each array as a fixed size
of 8×8 cells, and each array is stored in a tree. *)
module Map = PageMap.SplayMap(struct type t = content let default = empty_cell end)
type t = Map.t
(** The sheet is a map which always contains evaluated values. When a cell is
updated, all the cell which references this value are also updated.
*)
let empty = Map.empty
let get_value id t = (Map.find id t).value
let get_expr id t = (Map.find id t).expr
(** Update the value for the given cell.
Evaluate the new expression and compare it with the previous value.
@return Some map if the map has been updated
*)
let update catalog cell content t = begin
let new_val = Expression.eval content.expr catalog (fun id -> get_value id t) in
match content.value with
| None ->
(* If the previous value wasn't defined, update the map *)
Some (Map.add cell { content with value = Some new_val } t)
| Some old_value ->
(* If the previous value was defined, update only if result differs *)
if not (ScTypes.Result.(=) new_val old_value) then
Some (Map.add cell { content with value = Some new_val } t)
else
(* If there is no changes, do not update the map *)
None
end
exception Cycle of Cell.Set.t * t
(** Parse all the successors from an element, apply a function to each of
them, and return them.
The function is too long and should be rewriten… *)
let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin
try Cell.Set.fold (successors init f init source) source.sink (init, t)
with Cycle (succ, t) -> (succ, t)
end
and successors init f parents source element (succ, t) = begin
let content = Map.find element t in
if Cell.Set.mem element parents then (
(* if the cell has already been visited, mark it in error, and all the
descendant *)
let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
if content.value = cycle_error then (
(* The content has already been updated, do not process it again *)
(succ, t)
) else (
let t = Map.add element { content with value = cycle_error } t
and set_error cell content t =
if content.value = cycle_error then
None
else
Some (Map.add cell { content with value = cycle_error } t) in
let succ, t = traverse set_error source (init, t) in
raise (Cycle (succ, t))
)
) else (
begin match f element content t with
| None ->
(* The content does not change, we do not update the successors *)
(succ, t)
| Some t' ->
let parents' = Cell.Set.add element parents
and succ' = Cell.Set.add element succ in
if (Cell.Set.is_empty content.sink) then
(succ', t')
else
Cell.Set.fold (successors init f parents' source) content.sink (succ', t')
end
)
end
(** Remove the cell from the sheet *)
let remove_element (id:cell) t : t * content option = begin
(** Remove the references from each sources.
If the sources is not referenced anywhere, and is Undefined, remove it
*)
let remove_ref cell t = begin
try let c = Map.find cell t in
(* Remove all the refs which points to the removed cell *)
let sink' = Cell.Set.filter ((<>) id) c.sink in
if Cell.Set.is_empty sink' && not (Expression.is_defined c.expr) then (
Map.remove cell t )
else
Map.add cell {c with sink = sink'} t
with Not_found -> t
end in
begin try
let c = Map.find id t in
let t' =
(** Remove the references from each cell pointed by the expression *)
let sources = Expression.collect_sources c.expr in
Cell.Set.fold remove_ref sources t in
(* Removing the references to itself, keep all the other references
pointing to it (they are not affected) *)
let sink' = Cell.Set.filter ((<>) id) c.sink in
(** If there is no more references on the cell, remove it *)
if Cell.Set.is_empty sink' then
Map.remove id t', None
else (
let c = { empty_cell with sink = sink' } in
Map.add id c t', (Some c)
)
with Not_found -> t, None
end
end
let remove id catalog t = begin
match remove_element id t with
| t, None -> Cell.Set.empty, t
| t, Some content ->
(** Update all the successors *)
traverse (update catalog) content (Cell.Set.singleton id, t)
end
let add_element catalog id content_builder t = begin
(** Add the references in each sources.
If the sources does not exists, create it.
*)
let add_ref cell t = begin
let c =
try Map.find cell t
with Not_found -> empty_cell in
let c' = { c with sink = Cell.Set.add id c.sink} in
Map.add cell c' t
end in
(* Remove the cell and update all the sink. *)
let t', cell = remove_element id t in
let cell' = match cell with
| None -> empty_cell
| Some x -> x in
let content = content_builder cell' t' in
let sources = Expression.collect_sources content.expr in
let updated = Map.add id content t'
|> Cell.Set.fold add_ref sources
in
(** Update the value for each sink already evaluated *)
traverse (update catalog) content (Cell.Set.singleton id, updated)
end
let add id expression catalog t = begin
if not (Expression.is_defined expression) then
(Cell.Set.empty, t)
else
let f cell t = begin
{ cell with
expr = expression ;
value = Some (Expression.eval expression catalog (fun id -> get_value id t)) }
end in
add_element catalog id f t
end
let paste catalog id shift content t = begin
let expr = Expression.shift shift content.expr in
let f cell t =
{ cell with
expr = expr ;
value = Some (Expression.eval expr catalog (fun id -> get_value id t))
} in
add_element catalog id f t
end
let search pattern t = begin
let exception Found of (int * int) in
let _search key content () =
if content.value = pattern then raise (Found key) in
try
(* Iteration*)
Map.fold _search t ();
None
with Found key -> Some key
end
let get_sink id t =
try (Map.find id t).sink
with Not_found -> Cell.Set.empty
(** Fold over each defined value *)
let fold f a t = begin
Map.fold (fun key content a ->
match content.value with
| None -> a
| Some x ->
f a key (content.expr, x)
) t a
end
end
type yank = cell * Raw.content
type history = ((cell * Expression.t) list) list
type t = {
selected: Selection.t; (* The selected cell *)
data: Raw.t;
history: history; (* Unlimited history *)
yank: yank list;
catalog: Functions.C.t;
}
let undo t = begin
match t.history with
| [] -> None
| hd::tl ->
let data = List.fold_left (
fun data (id, expression) ->
if Expression.is_defined expression then
snd @@ Raw.add id expression t.catalog data
else
snd @@ Raw.remove id t.catalog data
) t.data hd in
Some { t with data = data; history = tl}
end
let move direction t =
let position = Selection.extract t.selected in
let position' = begin match direction with
| Actions.Left quant -> Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position
| Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position
| Actions.Up quant -> Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position
| Actions.Down quant -> Tools.Tuple2.replace2 ((snd position) + quant) position
| Actions.Absolute (x, y) -> (x, y)
end in
if position = position' then
None
else
Some {t with selected = Selection.create position'}
let delete t = begin
let catalog = t.catalog in
let history = Selection.fold (fun acc id -> (id, Raw.get_expr id t.data)::acc) [] t.selected in
let count, data' = Selection.fold (fun (count, c) t ->
(count + 1, snd @@ Raw.remove t catalog c)) (0, t.data) t.selected in
let t' = { t with
data = data';
history = history::t.history
} in
t', count
end
let yank t = begin
let shift = Selection.shift t.selected in
let origin = shift (0, 0) in
let _yank (count, extracted) cell = begin
let content =
try let content = (Raw.Map.find cell t.data) in
{ content with Raw.expr = Expression.shift origin content.Raw.expr }
with Not_found -> Raw.empty_cell in
count + 1, (shift cell,content)::extracted
end in
let count, yanked = Selection.fold _yank (0, []) t.selected in
let t' = { t with yank = List.rev yanked; } in
t', count
end
let paste t = begin
let catalog = t.catalog in
(* Origin of first cell *)
let (shift_x, shift_y) as shift = Selection.extract t.selected in
let history' = List.map (fun ((x, y), content) ->
let id = shift_x + x, shift_y + y in
id, Raw.get_expr id t.data) t.yank in
let _paste (count, t) ((x, y), content) = begin
count + 1, snd @@ Raw.paste catalog (shift_x + x, shift_y + y) shift content t
end in
let count, data' = List.fold_left _paste (0, t.data) t.yank in
let t' = { t with data = data'; history = history'::t.history } in
t', count
end
let add expression t = begin
let id = Selection.extract t.selected in
let prev_expression = Raw.get_expr id t.data in
let cells, data' = Raw.add id expression t.catalog t.data in
cells, { t with data = data'; history = [id, prev_expression]::t.history }
end
let search action t = begin match action with
| `Pattern pattern ->
begin match Raw.search pattern t.data with
| None -> None
| Some x -> Some {t with selected = Selection.create x}
end
| _ -> None
end
let create catalog data = {
data = data;
selected = Selection.create (1, 1);
history = [];
yank = [];
catalog = catalog
}
|