From 112ab4b1c396fc2117191297227d8e411f9b9bb3 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Fri, 19 Jan 2018 11:24:29 +0100
Subject: Better memory management

---
 Makefile                 |   5 +-
 src/evaluator.ml         |  16 ++--
 src/odf/odf.ml           | 122 +----------------------------
 src/odf/odfLoader.ml     | 130 ++++++++++++++++++++++++++++++
 src/scTypes.ml           |  18 ++---
 src/scTypes.mli          |  25 +++---
 src/sheet.ml             | 101 ++++++++++++++----------
 src/sheet.mli            |   6 +-
 src/splay.ml             | 143 ---------------------------------
 src/splay.mli            |  30 -------
 src/tools.ml             |   8 +-
 src/tree/pageMap.ml      | 178 +++++++++++++++++++++++++++++++++++++++++
 src/tree/splay.ml        | 194 +++++++++++++++++++++++++++++++++++++++++++++
 src/tree/splay.mli       |  37 +++++++++
 src/unicode.ml           |  51 ------------
 src/unicode.mli          |  27 -------
 tests/sheet_test.ml      |  76 ++++++++++++++++--
 tests/test.ml            |   1 +
 tests/tree/splay_test.ml | 200 +++++++++++++++++++++++++++++++++++++++++++++++
 19 files changed, 913 insertions(+), 455 deletions(-)
 create mode 100755 src/odf/odfLoader.ml
 delete mode 100644 src/splay.ml
 delete mode 100755 src/splay.mli
 create mode 100755 src/tree/pageMap.ml
 create mode 100644 src/tree/splay.ml
 create mode 100755 src/tree/splay.mli
 delete mode 100755 src/unicode.ml
 delete mode 100755 src/unicode.mli
 create mode 100755 tests/tree/splay_test.ml

diff --git a/Makefile b/Makefile
index f6cb2b5..3df5d6a 100755
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
 OCAMLBUILD ?= ocamlbuild
 PACKAGES=dynlink,curses,camlzip,ezxmlm,text,str,menhirLib,zarith,base
-PATHS=src,src/odf
+PATHS=src,src/odf,src/tree
 
 MENHIR=-use-menhir
 
@@ -25,13 +25,12 @@ byte: stub
 
 native: stub
 	$(OCAMLBUILD) -tags optimize\(3\) -pkgs $(PACKAGES) $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS) main.native
-	#$(OCAMLBUILD) -pkgs $(PACKAGES) $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS) main.native
 
 doc:
 	$(OCAMLBUILD) -pkgs $(PACKAGES) -menhir -Is $(PATHS) licht.docdir/index.html
 
 test.byte: stub
-	$(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests,tests/odf $@
+	$(OCAMLBUILD) -pkgs $(PACKAGES),oUnit -cflag -g -lflag -g $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS),tests,tests/odf,tests/tree $@
 
 %.cmxs: stub
 	$(OCAMLBUILD) -use-ocamlfind -tags optimize\(3\) -pkgs $(PACKAGES) $(MENHIR) -Is $(PATHS) $@
diff --git a/src/evaluator.ml b/src/evaluator.ml
index ed384e6..05b975f 100755
--- a/src/evaluator.ml
+++ b/src/evaluator.ml
@@ -108,33 +108,35 @@ let eval mapper value = begin
   end in
 
   (** Extract the value from an expression.
-      [extract typ expr] will evaluate the expression and return it. If the
-      result cannot be evaluated (because of references pointing to missing
-      values) a default value of type [typ] will be returned.
+      [extract expr] will evaluate the expression and return it. If the result
+      cannot be evaluated (because of references pointing to missing values) a
+      default value of type [typ] will be returned.
    *)
   let rec extract = begin function
     (* For a reference to an external we first extract the value pointed  *)
     | ScTypes.Ref r -> ScTypes.Refs.(
         begin match ScTypes.Refs.get_content @@ mapper r with
-        | C (Value (format, f)) -> begin match format with
+        | Value (format, f) -> begin match format with
             | ScTypes.Date -> Result (Data.Num (format, f))
             | ScTypes.Number -> Result (Data.Num (format, f))
             | ScTypes.String -> Result (Data.String f)
             | ScTypes.Bool -> Result (Data.Bool f)
             end
-        | C (List (format, l)) -> Result (Data.List (format, l))
-        | C (Matrix (format, l)) -> Result (Data.Matrix (format, l))
+        | List (format, l) -> Result (Data.List (format, l))
+        | Matrix (format, l) -> Result (Data.Matrix (format, l))
         end)
 
     (* Evaluate the expression *)
     | ScTypes.Expression e -> extract e
     | ScTypes.Value v -> extract_value (ScTypes.Result v)
     | ScTypes.Call (name, args) ->
+      (* The function is not tail recursive, but I don't think we will have
+         more than 100 nested functions here... *)
       let args' = List.map extract args in
         call name args'
   end in
 
-  let Result r = ((extract[@tailrec]) value) in
+  let Result r = extract value in
   begin match r with
   | Data.Bool b ->  ScTypes.Result (ScTypes.boolean b)
   | Data.String s -> ScTypes.Result (ScTypes.string s)
diff --git a/src/odf/odf.ml b/src/odf/odf.ml
index ae120d9..048be2e 100755
--- a/src/odf/odf.ml
+++ b/src/odf/odf.ml
@@ -1,4 +1,3 @@
-module Xml = Ezxmlm
 module T = Tools
 module NS = Odf_ns
 
@@ -6,125 +5,10 @@ let u = UTF8.from_utf8string
 
 type t
 
-(** Map for storing all the attributes *)
-module AttributesMap = Map.Make (struct
-  type t = string * string
-  let compare = Pervasives.compare
-end)
-
-let get_attr map key = begin
-  try Some (AttributesMap.find key map) with
-  Not_found -> None
-end
-
-let load_formula formula =
-  let lineBuffer = Lexing.from_string formula in
-  try
-    Expression.Formula (
-      Expression.Expression (
-        Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
-  with e ->
-    print_endline formula;
-    raise e
-
-
-let load_content content = begin function
-  | "float" -> Expression.Basic (
-      ScTypes.number (
-        DataType.Num.of_float (float_of_string content)
-      ))
-  | "date"  -> Expression.Basic (
-      ScTypes.date (
-        DataType.Num.of_float (float_of_string content)
-      ))
-  | _ -> Expression.Basic (
-      ScTypes.string (
-        UTF8.from_utf8string content))
-end
-
-(** Load the content from a cell *)
-let load_cell sheet cell_num row_num changed (attrs, cell) = begin
-
-  (* Load all the attributes from the xml element *)
-  let add_attr map (key, value) = AttributesMap.add key value map in
-  let attributes = List.fold_left add_attr AttributesMap.empty attrs in
-
-  (* Check if the content is repeated *)
-  let repetition = match get_attr attributes NS.number_columns_repeat_attr with
-  | None -> 1
-  | Some x -> int_of_string x
-
-  (* cell width *)
-  and cell_width = match get_attr attributes NS.number_columns_spanned_attr with
-  | None -> 1
-  | Some x -> int_of_string x in
-
-  let vtype =
-    try List.assoc NS.ovalue_type_attr attrs
-    with Not_found -> "" in
-
-  let formula = get_attr attributes NS.formula_attr
-  and value   = get_attr attributes NS.value_attr in
-
-  let expression, update = begin match formula, value with
-  | Some x, _ -> load_formula x, true
-  | _, Some x ->
-      (load_content x vtype) , true
-  | _ ->
-    begin try
-          Xml.member "p" cell
-       |> Xml.data_to_string
-       |> fun x -> (load_content x vtype, true)
-    with Xml.Tag_not_found _ -> Expression.Undefined, false
-    end
-  end in
-
-  if update then (
-    for i = 1 to repetition do
-      cell_num := !cell_num + cell_width;
-      sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) (Expression.load_expr expression) !sheet
-    done
-  ) else (
-    cell_num := !cell_num + (repetition * cell_width )
-  );
-  changed || update
-end
-
-let load_row sheet row_num (attrs, row) = begin
-
-  let repetition =
-    try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attrs
-    with Not_found -> 1 in
-
-  let cells = Xml.members_with_attr "table-cell" row in
-
-  try
-    for i = 1 to repetition do
-      incr row_num;
-      let cell_num = ref 0 in
-      if not (List.fold_left (load_cell sheet cell_num row_num) false cells) then
-        (* No changes on the whole row. Do not repeat, and break the loop *)
-        raise Not_found
-    done
-  with Not_found -> row_num := !row_num + repetition - 1
-end
-
 let load_xml input = begin
-
-  let sheet = ref Sheet.Raw.empty in
-  let row_num = ref 0 in
-
-  let xml =
-      Xmlm.make_input ~enc:(Some `UTF_8) (`Channel input)
-      |> Xml.from_input
-      |> snd in
-  let rows = Xml.member "document-content" (xml::[])
-    |> Xml.member "body"
-    |> Xml.member "spreadsheet"
-    |> Xml.member "table"
-    |> Xml.members_with_attr "table-row" in
-  List.iter (fun x -> (load_row sheet row_num) x) rows;
-  !sheet
+  let source = Xmlm.make_input ~enc:(Some `UTF_8) (`Channel input) in
+  let sheet = OdfLoader.load source in
+  sheet
 end
 
 
diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml
new file mode 100755
index 0000000..9420fdd
--- /dev/null
+++ b/src/odf/odfLoader.ml
@@ -0,0 +1,130 @@
+module NS = Odf_ns
+
+type tree =
+  | Data of string
+  | Cell of {repetition: int; cell_width: int; expression: Expression.t}
+  | Unit
+
+let memoization cache key f = begin
+  try
+    Hashtbl.find cache key
+  with Not_found ->
+    let value = f key in
+    Hashtbl.add cache key value;
+    value
+end
+
+let load_content cache content = begin function
+  | "float" -> Expression.Basic (
+      ScTypes.number (
+        DataType.Num.of_float (float_of_string content)
+      ))
+  | "date"  -> Expression.Basic (
+      ScTypes.date (
+        DataType.Num.of_float (float_of_string content)
+      ))
+  | _ ->
+    (* If the same text is present many times, use the same string instead of creating a new one *)
+    memoization cache content (fun content ->
+      Expression.Basic (
+            ScTypes.string (
+              UTF8.from_utf8string content)))
+end
+
+let load_formula formula =
+  let lineBuffer = Lexing.from_string formula in
+  try
+    Expression.Formula (
+      Expression.Expression (
+        Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer))
+  with e ->
+    print_endline formula;
+    raise e
+
+
+let build_cell cache (attributes:Xmlm.attribute list) (childs:tree list) = begin
+
+  (* Check if the content is repeated *)
+  let repetition =
+    try int_of_string @@ List.assoc NS.number_columns_repeat_attr attributes
+    with Not_found -> 1
+
+  (* cell width *)
+  and cell_width =
+    try int_of_string @@ List.assoc NS.number_columns_spanned_attr attributes
+    with Not_found -> 1
+
+  and expression =
+    try
+      load_formula @@ List.assoc NS.formula_attr attributes
+    with Not_found -> (
+      let vtype =
+        try List.assoc NS.ovalue_type_attr attributes
+        with Not_found -> "" in
+
+      try
+        load_content cache (List.assoc NS.value_attr attributes) vtype
+      with Not_found -> (
+        (* This is not a formula, neither a value ? *)
+        try
+          let value = Tools.List.find_map (function | Data x -> Some x | _ -> None) childs in
+          load_content cache value vtype
+        with Not_found -> Expression.Undefined
+      )
+    ) in
+
+  Cell {repetition; cell_width; expression}
+
+end
+
+let build_p (attributes:Xmlm.attribute list) = begin function
+  | Data x::_ -> Data x
+  | _ -> Data ""
+end
+
+
+let build_row (sheet:Sheet.Raw.t ref) (row_num:int ref) (attributes:Xmlm.attribute list) (childs:tree list) = begin
+
+  let repetition =
+    try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attributes
+    with Not_found -> 1 in
+
+  for i = 1 to repetition do
+    let cell_num = ref 1 in
+    List.iter (function
+    | Cell cell ->
+      for i = 1 to cell.repetition do
+        sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) cell.expression !sheet;
+        cell_num := !cell_num + cell.cell_width
+      done;
+    | _ -> ()
+    ) childs;
+    incr row_num
+  done;
+  Unit
+end
+
+let data str = Data str
+
+let load source = begin
+
+  (* Mutable datas *)
+  let sheet = ref Sheet.Raw.empty in
+  let cache = Hashtbl.create 10 in
+
+  let table = Base.String_dict.of_alist_exn [
+    ((NS.text ^ "p"), build_p);
+    ((NS.table ^ "table-cell"), build_cell cache);
+    ((NS.table ^ "table-row"), build_row sheet (ref 1))
+  ] in
+
+  let el (((ns, name), attributes):Xmlm.tag) childs = begin
+    match Base.String_dict.find table (ns ^ name) with
+    | Some f -> f attributes childs
+    | None -> Unit
+  end in
+
+  match Xmlm.input_doc_tree ~el ~data source with
+  | _, Unit -> !sheet
+  | _ -> raise Not_found
+end
diff --git a/src/scTypes.ml b/src/scTypes.ml
index 48e4d3c..fc6dd1f 100755
--- a/src/scTypes.ml
+++ b/src/scTypes.ml
@@ -234,13 +234,10 @@ 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 [@@unboxed]
+  type content =
+    | Value: 'a dataFormat * 'a -> content
+    | List: 'a dataFormat * 'a list -> content
+    | Matrix: 'a dataFormat * 'a list list -> content
 
   (** Add one element in a typed list.
 
@@ -266,7 +263,8 @@ module Refs = struct
   | 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))
+    let Type.Value (format, c) = Type.get_content r in
+    Value (format, c)
   | Array1 l ->
     (* Get the first element in the list in order to get the format *)
     let Type.Value (format, _) =
@@ -276,7 +274,7 @@ module Refs = struct
       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))
+    List(format, List.rev values)
   | Array2 l ->
     (* Get the first element in the list *)
     let Type.Value (format, _) =
@@ -289,7 +287,7 @@ module Refs = struct
         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))
+    Matrix(format, List.rev values)
   end
 
 end
diff --git a/src/scTypes.mli b/src/scTypes.mli
index 348f4fe..46b48c6 100755
--- a/src/scTypes.mli
+++ b/src/scTypes.mli
@@ -12,11 +12,6 @@ type 'a dataFormat =
   | String: DataType.String.t dataFormat (* String *)
   | Bool: DataType.Bool.t dataFormat   (* 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 *)
-
 type numericType =
   | Date
   | Number
@@ -33,6 +28,8 @@ val string: DataType.String.t -> DataType.String.t types
 val boolean: DataType.Bool.t -> DataType.Bool.t types
 val date: DataType.Num.t -> DataType.Num.t types
 
+(** Private type for an internal representation of return format *)
+type 'a returnType 
 
 (** Numeric (any format) *)
 val f_num: DataType.Num.t returnType
@@ -92,25 +89,25 @@ module Refs : sig
     | Array1 of 'a list
     | Array2 of 'a list list
 
+  (* Collect all the cells defined by a range. The cell are defined by their
+     coordinates *)
   val collect: refs -> (int * int) range
 
   val map: ('a -> 'b) -> 'a range -> 'b range
-  
+ 
   val shift: (int * int) -> refs -> refs
 
-  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 [@@unboxed]
+  (** Each content from a reference contains a format and the appropriate value. *)
+  type content =
+    | Value: 'a dataFormat * 'a -> content
+    | List: 'a dataFormat * 'a list -> content
+    | Matrix: 'a dataFormat * 'a list list -> content
 
   (** extract the content from a range.
 
       May raise Errors.TypeError if the range cannot be unified.
   *)
-  val get_content : result option range -> refContent
+  val get_content : result option range -> content
 
 end
 
diff --git a/src/sheet.ml b/src/sheet.ml
index 67b1ee1..3dc83a0 100755
--- a/src/sheet.ml
+++ b/src/sheet.ml
@@ -10,22 +10,12 @@ type search = [
 
 module Raw = struct
 
-  module Map = Map.Make(struct
-    type t = cell
-    let compare (x1, y1) (x2, y2) = Pervasives.compare (y1, x1) (y2, x2)
-  end)
-
   type content = {
     expr    : Expression.t; (** The expression *)
     value   : ScTypes.result option; (** The content evaluated *)
     sink    : Cell.Set.t;   (** All the cell which references this one *)
   }
 
-  (** 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.
-    *)
-  and t = content Map.t
-
   (** An empty cell which does contains nothing *)
   let empty_cell = {
     expr = Expression.Undefined;
@@ -33,17 +23,21 @@ module Raw = struct
     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 = begin
-    try (Map.find id t).value
-    with Not_found ->  None
-  end
+  let get_value id t = (Map.find id t).value
 
-  let get_expr id t = begin
-    try (Map.find id t).expr
-    with Not_found -> empty_cell.expr
-  end
+  let get_expr id t = (Map.find id t).expr
 
   (** Extract a value from a reference.
       This function is given to the evaluator for getting the values from a reference.
@@ -75,7 +69,9 @@ module Raw = struct
   end
 
   (** Parse all the successors from an element, apply a function to each of
-      them, and return them *)
+      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
 
     let exception Cycle of Cell.Set.t * t in
@@ -130,7 +126,6 @@ module Raw = struct
     *)
     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 (
@@ -143,15 +138,18 @@ module Raw = struct
     begin try
       let c = Map.find id t in
       let t' =
-        (** Remove the references from each sources *)
+        (** 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
 
-      (** If there is no references on the cell, remove it *)
-      if Cell.Set.is_empty c.sink then (
-        Map.remove id t', None)
+      (* 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 = c.sink } in
+        let c = { empty_cell with sink = sink' } in
         Map.add id c t', (Some c)
       )
     with Not_found -> t, None
@@ -166,7 +164,7 @@ module Raw = struct
         traverse update content (Cell.Set.singleton id, t)
   end
 
-  let add_element id f t = begin
+  let add_element id content_builder t = begin
 
     (** Add the references in each sources.
         If the sources does not exists, create it.
@@ -179,12 +177,13 @@ module Raw = struct
       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 = f cell' t' in
+    let content = content_builder cell' t' in
 
     let sources = Expression.collect_sources content.expr in
     let updated = Map.add id content t'
@@ -199,10 +198,11 @@ module Raw = struct
     if not (Expression.is_defined expression) then
       (Cell.Set.empty, t)
     else
-      let f cell t = { cell with
-        expr = expression ;
-        value = Some (Expression.eval expression (get_ref id t))
-      } in
+      let f cell t = begin
+        { cell with
+          expr = expression ;
+          value = Some (Expression.eval expression (get_ref id t)) }
+      end in
       add_element id f t
   end
 
@@ -219,9 +219,12 @@ module Raw = struct
   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
+    let _search key content () =
+      if content.value = pattern then raise (Found key) in
+
     try
-      Map.iter _search t;
+      (* Iteration*)
+      Map.fold _search t ();
       None
     with Found key -> Some key
   end
@@ -243,17 +246,27 @@ module Raw = struct
 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: t list;          (* Unlimited history *)
-  yank: (cell * Raw.content) list
+  history: history;    (* Unlimited history *)
+  yank: yank list
 }
 
-let undo t = begin match t.history with
+let undo t = begin
+  match t.history with
   | [] -> None
-  | hd::tl -> Some { hd with selected = t.selected }
+  | hd::tl ->
+    let data = List.fold_left (
+    fun data (id, expression) ->
+      if Expression.is_defined expression then
+        snd @@ Raw.add id expression data
+      else
+        snd @@ Raw.remove id data
+    ) t.data hd in
+    Some { t with data = data; history = tl}
 end
 
 let move direction t =
@@ -263,7 +276,7 @@ let move direction t =
   | 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)
+  | Actions.Absolute (x, y) -> (x, y)
   end in
   if position = position' then
     None
@@ -271,11 +284,12 @@ let move direction t =
     Some {t with selected = Selection.create position'}
 
 let delete t = begin
+  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 c)) (0, t.data) t.selected in
   let t' = { t with
     data = data';
-    history = t::t.history
+    history = history::t.history
   } in
   t', count
 end
@@ -302,19 +316,24 @@ let paste t = begin
   (* 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 (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 = t::t.history } 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.data in
-  cells, { t with data = data'; history = t::t.history}
+  cells, { t with data = data'; history = [id, prev_expression]::t.history }
 end
 
 let search action t = begin match action with
diff --git a/src/sheet.mli b/src/sheet.mli
index 11881cc..d768b8f 100755
--- a/src/sheet.mli
+++ b/src/sheet.mli
@@ -31,11 +31,12 @@ module Raw: sig
 end
 
 type yank
+type history
 
 type t = {
   selected: Selection.t;    (* The selected cell *)
   data: Raw.t;
-  history: t list;          (* Unlimited history *)
+  history: history;    (* Unlimited history *)
   yank: yank list           (* All the selected cells *)
 }
 
@@ -68,6 +69,9 @@ val search: search -> t -> t option
 
 val paste: t -> t * int
 
+(** Add or update the sheet.
+    The expression is added at current selection.
+    @return A set containing all updated cells, and the tree updated. *)
 val add: Expression.t -> t -> Cell.Set.t * t
 
 (** Create an empty sheet *)
diff --git a/src/splay.ml b/src/splay.ml
deleted file mode 100644
index 4bbc3dd..0000000
--- a/src/splay.ml
+++ /dev/null
@@ -1,143 +0,0 @@
-module type KEY = sig
-
-  type 'a t
-
-  (** Parametrized comparator *)
-  val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
-
-  val repr: Format.formatter -> 'a t -> unit
-
-end
-
-module Make (El : KEY) = struct
-
-  type 'a elem = 'a El.t
-
-  type leaf (** Fantom type for typing the tree *)
-  type node (** Fantom type for typing the tree *)
-
-  type 'a treeVal =
-    | Leaf : leaf treeVal
-    | Node : _ treeVal * ('a elem * 'a) * _ treeVal -> node treeVal
-
-  type t = T : 'a treeVal ref -> t [@@unboxed]
-
-  let empty = T (ref Leaf)
-
-  let isEmpty (T tree) = match !tree with
-    | Leaf -> true
-    | _ -> false
-
-  let rec splay : type a. a elem -> node treeVal -> node treeVal = fun x t -> begin
-    let Node (l, y, r) = t in
-    begin match El.comp x (fst y)  with
-      | Tools.Eq -> t
-      | Tools.Lt ->
-        begin match l with
-          | Leaf -> t
-          | Node (ll, z, rr) ->
-            begin match El.comp x (fst z)  with
-              | Tools.Eq -> Node (ll, z, Node (rr, y, r))
-              | Tools.Lt ->
-                begin match ll with
-                  | Leaf -> Node (ll, z, Node (rr, y, r))
-                  | Node _ as ll ->
-                    let Node (newL, newV, newR) = splay x ll
-                    in Node (newL, newV, Node (newR, z, Node (rr, y, r)))
-                end
-              | Tools.Gt ->
-                begin match rr with
-                  | Leaf -> Node (ll, z, Node (rr, y, r))
-                  | Node _ as rr ->
-                    let Node (newL, newV, newR) = splay x rr
-                    in Node (Node (ll, z, newL), newV, Node (newR, y, r))
-                end
-            end
-        end
-      | Tools.Gt ->
-        begin match r with
-          | Leaf -> t
-          | Node (ll, z, rr) ->
-            begin match El.comp x (fst z)  with
-              | Tools.Eq -> Node (Node (l, y, ll), z, rr)
-              | Tools.Lt ->
-                begin match ll with
-                  | Leaf -> Node (Node (l, y, ll), z, rr)
-                  | Node _ as ll ->
-                    let Node (newL, newV, newR) = splay x ll
-                    in Node (Node (l, y, newL), newV, Node (newR, z, rr))
-                end
-              | Tools.Gt ->
-                begin match rr with
-                  | Leaf -> Node (Node (l, y, ll), z, rr)
-                  | Node _ as rr ->
-                    let Node (newL, newV, newR) = splay x rr
-                    in Node (Node (Node(l, y, ll), z, newL), newV, newR)
-                end
-            end
-        end
-    end
-  end
-
-  let member: type a. a elem -> t -> bool = fun x (T t) -> match !t with
-    | Leaf -> false
-    | Node _ as root ->
-        let root' = splay x root in
-        t := root';
-        let Node (_, c', _) = root' in
-        begin match El.comp (fst c') x  with
-          | Tools.Eq -> true
-          | _ -> false
-        end
-
-  let find: type a. a elem -> t -> a = fun x (T t) -> match !t with
-    | Leaf -> raise Not_found
-    | Node _ as root ->
-        let root' = splay x root in
-        t := root';
-        let Node (_, c', _) = root' in
-        begin match El.comp (fst c') x with
-          | Tools.Eq -> snd c'
-          | _ -> raise Not_found
-        end
-
-  let add: type a. a elem -> a -> t -> t = fun key value (T t) -> match !t with
-    | Leaf -> T (ref (Node (Leaf, (key, value), Leaf)))
-    | Node _ as root ->
-        let root' = splay key root in
-        let Node (l, y, r) = root' in
-        begin match El.comp key (fst y)  with
-          | Tools.Eq -> T (ref root')
-          | Tools.Lt -> T (ref (Node (l, (key, value), Node (Leaf, y, r))))
-          | Tools.Gt -> T (ref (Node (Node (l, y, Leaf), (key, value), r)))
-        end
-
-  let repr formatter (T t) = begin
-
-    let repr_edge from formatter dest = begin
-      Format.fprintf formatter "\"%a\" -> \"%a\"\n"
-        El.repr from
-        El.repr dest
-    end in
-
-    let rec repr': type a b. a El.t -> Format.formatter -> b treeVal -> unit = fun parent formatter -> function
-    | Leaf -> ()
-    | Node (l, c, r) ->
-        let key = fst c in
-        Format.fprintf formatter "%a%a%a"
-        (repr_edge parent) key
-        (repr' key) l
-        (repr' key) r in
-
-    begin match !t with
-    | Leaf -> Format.fprintf formatter "digraph G {}"
-    | Node (l, c, r) ->
-      let key = fst c in
-      Format.fprintf formatter "digraph G {\n%a%a}"
-        (repr' key) l
-        (repr' key) r
-    end
-
-  end
-
-end
diff --git a/src/splay.mli b/src/splay.mli
deleted file mode 100755
index 41c1a5a..0000000
--- a/src/splay.mli
+++ /dev/null
@@ -1,30 +0,0 @@
-module type KEY = sig
-
-    type 'a t
-
-    val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
-
-    val repr: Format.formatter -> 'a t -> unit
-
-end
-
-module Make (El : KEY) : sig
-
-  type t
-
-  (** Create an empty tree *)
-  val empty: t
-
-  (** Return the element in the tree with the given key *)
-  val find: 'a El.t -> t -> 'a
-
-  (** Add one element in the tree *)
-  val add: 'a El.t -> 'a -> t -> t
-
-  (** Check if the key exists *)
-  val member: 'a El.t -> t -> bool
-
-  (** Represent the content in dot syntax *)
-  val repr: Format.formatter -> t -> unit
-
-end
diff --git a/src/tools.ml b/src/tools.ml
index 6dfe564..7f500bf 100755
--- a/src/tools.ml
+++ b/src/tools.ml
@@ -18,6 +18,12 @@ module Option = struct
   | None -> v
   | Some x -> x
 
+  let test f v = begin
+  match f v with
+  | Some x -> x
+  | None -> v
+  end
+
 
 end
 
@@ -97,7 +103,7 @@ module List = struct
   | [] -> raise Not_found
   | hd::tl -> begin match f hd with
               | Some x -> x
-              | None -> (find_map[@tailrec]) f tl
+              | None -> (find_map[@tailcall]) f tl
               end
   end
 
diff --git a/src/tree/pageMap.ml b/src/tree/pageMap.ml
new file mode 100755
index 0000000..38bbe42
--- /dev/null
+++ b/src/tree/pageMap.ml
@@ -0,0 +1,178 @@
+type cell = int * int
+
+module type T_DEFAULT = sig
+
+  type t
+
+  val default : t
+
+end
+
+module MapArray(T:T_DEFAULT) = struct
+
+  (** The type is composed by the number of defined cell in the page, and the page itself *)
+  type t = int * (T.t array array)
+
+  let find (x:int) (y:int) (t:t) : T.t = begin
+    let block = snd t in
+    block.(y).(x)
+  end
+
+  let add (x:int) (y:int) (value:T.t) (t:t) : t = begin
+    let n, block = t in
+    let n' =
+      if (block.(y).(x) == T.default) then
+        n + 1
+      else
+        n in
+    block.(y).(x) <- value;
+    n', block
+  end
+
+  let remove (x:int) (y:int) (t:t) : t = begin
+    let n, block = t in
+    if (block.(y).(x) = T.default) then
+     t
+    else (
+      if n = 1 then
+        (* Do not keep empty block in memory *)
+        raise Not_found
+      else (
+        block.(y).(x) <- T.default;
+        (n -1, block)
+      )
+    )
+  end
+
+  let create array_size =  begin
+    0, Array.make_matrix array_size array_size T.default
+  end
+
+  let fold_line f y init t = begin
+    let n, block = t
+    and res = ref init in
+
+    let array_size = Array.length block in
+    for x = 0 to (array_size - 1) do
+      let value = block.(y).(x) in
+      if value != T.default then
+        res := f x value !res;
+    done;
+    !res
+  end
+
+end
+
+module SplayMap(T:T_DEFAULT) = struct
+
+  let array_size = 8
+
+  module PageMap = MapArray(T)
+
+  (** Module for the keys *)
+  module K = struct
+
+    type 'a t = K : (int * int) -> PageMap.t t [@@unboxed]
+
+    let comp:type a b. a t -> b t -> (a, b) Tools.cmp = fun a b -> begin
+      match a, b with K (x1, y1), K (x2, y2) ->
+        let res = Pervasives.compare (y1, x1) (y2, x2) in
+        if res < 0 then
+          Tools.Lt
+        else if res > 0 then
+          Tools.Gt
+        else
+          Tools.Eq
+    end
+
+    let repr: type a. Format.formatter -> a t -> unit = fun formatter (K (x, y)) ->
+      Format.fprintf formatter "%d, %d" x y
+
+  end
+
+  module Map = Splay.Make(K)
+
+  type t = Map.t
+
+  (* Values are always positive *)
+  let get_bounded_values (x, y) = (max 0 x), (max 0 y)
+
+  let find (id:cell) (t:Map.t) : T.t = begin
+    let x, y = get_bounded_values id in
+    let block_x = x / array_size
+    and block_y = y / array_size in
+    try
+      let block = Map.find (K (block_x, block_y)) t in
+      PageMap.find (x mod array_size) (y mod array_size) block
+    with Not_found -> T.default
+  end
+
+  let add (id:cell) (value:T.t) (t:Map.t) : Map.t = begin
+    let x, y = get_bounded_values id in
+    let block_x = x / array_size
+    and block_y = y / array_size in
+    let block =
+      try Map.find (K (block_x, block_y)) t
+      with Not_found -> PageMap.create array_size in
+    let page = PageMap.add (x mod array_size) (y mod array_size) value block in
+    Map.add (K (block_x, block_y)) page t
+  end
+
+  let remove (id:cell) (t:Map.t) : Map.t = begin
+    let x, y = get_bounded_values id in
+    let block_x = x / array_size
+    and block_y = y / array_size in
+    try
+      let block = Map.find (K (block_x, block_y)) t in
+      try
+        let block' = PageMap.remove (x mod array_size) (y mod array_size) block in
+        Map.add (K (block_x, block_y)) block' t
+      with Not_found ->
+        Map.remove (K (block_x, block_y)) t
+    with Not_found -> t
+  end
+
+  (** Empty map *)
+  let empty = Map.empty
+
+  (** Fold over the elements in the Map.*)
+  let fold f (t:Map.t) init = begin
+    let res = ref init in
+
+    let call_function column row x value acc = begin
+      f (column + x, row) value acc
+    end in
+
+    (* Call process_line for each block on the same row *)
+    let process_pages block_y acc = begin
+      let blocks = List.rev acc
+      and row_index = block_y * array_size in
+      for y = 0 to (array_size - 1) do
+        let row = row_index + y in
+        res := List.fold_left (fun init (column, block) ->
+          PageMap.fold_line (call_function column row) y init block
+        ) !res blocks;
+
+      done
+    end in
+
+    let fold_blocks (current_row, acc) (Map.C key_val) = begin
+      match key_val with ((K.K (block_x, block_y)), (block:PageMap.t)) ->
+      (* As long as the page lay in the same row, accumulate it *)
+      if current_row = block_y then
+        current_row, (block_x * array_size, block)::acc
+      else (
+        (* We apply the function for each accumulated block in the row *)
+        process_pages current_row acc;
+        block_y, (block_x, block)::[]
+      )
+    end in
+
+    let row_number, acc = Map.fold fold_blocks (1, []) t in
+    (* Apply the function to the last row *)
+    process_pages row_number acc;
+    !res
+  end
+
+
+end
diff --git a/src/tree/splay.ml b/src/tree/splay.ml
new file mode 100644
index 0000000..662fc6c
--- /dev/null
+++ b/src/tree/splay.ml
@@ -0,0 +1,194 @@
+module type KEY = sig
+
+  type 'a t
+
+  (** Parametrized comparator *)
+  val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
+
+  val repr: Format.formatter -> 'a t -> unit
+
+end
+
+module Make (El : KEY) = struct
+
+  type container = C : ('a El.t * 'a) -> container [@@unboxed]
+
+  type leaf (** Fantom type for typing the tree *)
+  type node (** Fantom type for typing the tree *)
+
+  type 'a branch =
+    | Leaf : leaf branch
+    | Node : _ branch * ('a El.t * 'a) * _ branch -> node branch
+
+  type t = T : 'a branch ref -> t [@@unboxed]
+
+  let empty = T (ref Leaf)
+
+  let isEmpty (T tree) = match !tree with
+    | Leaf -> true
+    | _ -> false
+
+  let rec splay : type a. a El.t -> node branch -> node branch = fun x t -> begin
+    let Node (l, y, r) = t in
+    begin match El.comp x (fst y)  with
+      | Tools.Eq -> t
+      | Tools.Lt ->
+        begin match l with
+          | Leaf -> t
+          | Node (ll, z, rr) ->
+            begin match El.comp x (fst z)  with
+              | Tools.Eq -> Node (ll, z, Node (rr, y, r))
+              | Tools.Lt ->
+                begin match ll with
+                  | Leaf -> Node (ll, z, Node (rr, y, r))
+                  | Node _ as ll ->
+                    let Node (newL, newV, newR) = splay x ll
+                    in Node (newL, newV, Node (newR, z, Node (rr, y, r)))
+                end
+              | Tools.Gt ->
+                begin match rr with
+                  | Leaf -> Node (ll, z, Node (rr, y, r))
+                  | Node _ as rr ->
+                    let Node (newL, newV, newR) = splay x rr
+                    in Node (Node (ll, z, newL), newV, Node (newR, y, r))
+                end
+            end
+        end
+      | Tools.Gt ->
+        begin match r with
+          | Leaf -> t
+          | Node (ll, z, rr) ->
+            begin match El.comp x (fst z)  with
+              | Tools.Eq -> Node (Node (l, y, ll), z, rr)
+              | Tools.Lt ->
+                begin match ll with
+                  | Leaf -> Node (Node (l, y, ll), z, rr)
+                  | Node _ as ll ->
+                    let Node (newL, newV, newR) = splay x ll
+                    in Node (Node (l, y, newL), newV, Node (newR, z, rr))
+                end
+              | Tools.Gt ->
+                begin match rr with
+                  | Leaf -> Node (Node (l, y, ll), z, rr)
+                  | Node _ as rr ->
+                    let Node (newL, newV, newR) = splay x rr
+                    in Node (Node (Node(l, y, ll), z, newL), newV, newR)
+                end
+            end
+        end
+    end
+  end
+
+  let member: type a. a El.t -> t -> bool = fun x (T t) -> match !t with
+    | Leaf -> false
+    | Node _ as root ->
+        let root' = splay x root in
+        t := root';
+        let Node (_, c', _) = root' in
+        begin match El.comp (fst c') x  with
+          | Tools.Eq -> true
+          | _ -> false
+        end
+
+  let find: type a. a El.t -> t -> a = fun x (T t) -> match !t with
+    | Leaf -> raise Not_found
+    | Node _ as root ->
+        let root' = splay x root in
+        t := root';
+        let Node (_, c', _) = root' in
+        begin match El.comp (fst c') x with
+          | Tools.Eq -> snd c'
+          | _ -> raise Not_found
+        end
+
+  let add: type a. a El.t -> a -> t -> t = fun key value (T t) -> match !t with
+    | Leaf -> T (ref (Node (Leaf, (key, value), Leaf)))
+    | Node _ as root ->
+        let root' = splay key root in
+        let Node (l, y, r) = root' in
+        begin match El.comp key (fst y)  with
+          | Tools.Eq -> T (ref (Node(l, (key, value), r)))
+          | Tools.Lt -> T (ref (Node (l, (key, value), Node (Leaf, y, r))))
+          | Tools.Gt -> T (ref (Node (Node (l, y, Leaf), (key, value), r)))
+        end
+
+  let rec _subtree_maximum:type a. a branch -> a branch = fun t -> begin match t with
+  | Leaf -> Leaf
+  | Node (_, _, (Node (_, _, _) as x)) -> _subtree_maximum x
+  | Node (_, (key, value), Leaf) -> splay key t
+  end
+
+  let rec _subtree_minimum: type a. a branch -> a branch = fun t -> begin match t with
+  | Leaf -> Leaf
+  | Node ((Node (_, _, _) as x), _, _) -> _subtree_minimum x
+  | Node (Leaf, (key, value), _) -> splay key t
+  end
+
+  let remove: type a. a El.t -> t -> t = fun key (T t) -> begin match !t with
+    | Leaf -> empty
+    | Node _ as root ->
+      let root' = splay key root in
+      let Node (l, c', r) = root' in
+      begin match El.comp (fst c') key with
+        | Tools.Eq -> begin match _subtree_maximum l with
+          | Node(l, c, Leaf) -> T (ref (Node(l, c, r)))
+          | Node(l, c, _) -> raise Not_found
+          | Leaf -> begin match _subtree_minimum r with
+            | Leaf -> empty
+            | Node(Leaf, c, r) -> T (ref (Node(l, c, r)))
+            | Node(_, c, r) -> raise Not_found
+          end
+        end
+        (* The key is not present, return the splayed tree *)
+        | _ -> T (ref root')
+      end
+  end
+
+  (** Existencial type for the branches *)
+  type exBranch = Branch : _ branch -> exBranch [@@unboxed]
+
+  let fold f init (T t) = begin
+    let rec _fold : type b. (container * exBranch) list -> 'a -> b branch -> 'a = begin
+      fun acc v -> function
+    (* We have a node : we accumulate the right part, and process the left branch *)
+    | Node (left, (key, value), right) ->
+        let c = C (key, value) in
+        (_fold [@tailcall]) ((c, Branch right)::acc) v left
+    (* We have nothing left, we process the values delayed *)
+    | Leaf -> begin match acc with
+      | [] -> v
+      | (c, (Branch right))::tl -> (_fold [@tailcall]) tl (f v c) right
+      end
+    end in
+    _fold [] init !t
+  end
+
+  let repr formatter (T t) = begin
+
+    let repr_edge from formatter dest = begin
+      Format.fprintf formatter "\"%a\" -> \"%a\"\n"
+        El.repr from
+        El.repr dest
+    end in
+
+    let rec repr': type a b. a El.t -> Format.formatter -> b branch -> unit = fun parent formatter -> function
+    | Leaf -> ()
+    | Node (l, c, r) ->
+        let key = fst c in
+        Format.fprintf formatter "%a%a%a"
+        (repr_edge parent) key
+        (repr' key) l
+        (repr' key) r in
+
+    begin match !t with
+    | Leaf -> Format.fprintf formatter "digraph G {}"
+    | Node (l, c, r) ->
+      let key = fst c in
+      Format.fprintf formatter "digraph G {\n%a%a}"
+        (repr' key) l
+        (repr' key) r
+    end
+
+  end
+
+end
diff --git a/src/tree/splay.mli b/src/tree/splay.mli
new file mode 100755
index 0000000..521441c
--- /dev/null
+++ b/src/tree/splay.mli
@@ -0,0 +1,37 @@
+module type KEY = sig
+
+    type 'a t
+
+    val comp: 'a t -> 'b t -> ('a, 'b) Tools.cmp
+
+    val repr: Format.formatter -> 'a t -> unit
+
+end
+
+module Make (El : KEY) : sig
+
+  type t
+
+  (** Create an empty tree *)
+  val empty: t
+
+  (** Return the element in the tree with the given key *)
+  val find: 'a El.t -> t -> 'a
+
+  (** Add one element in the tree, if the element is already present, it is replaced. *)
+  val add: 'a El.t -> 'a -> t -> t
+
+  (** Check if the key exists *)
+  val member: 'a El.t -> t -> bool
+
+  val remove: 'a El.t -> t -> t
+
+  (** This type is used in the fold function as existencial type *)
+  type container = C : ('a El.t * 'a) -> container [@@unboxed]
+
+  val fold: ('a -> container -> 'a) -> 'a -> t -> 'a
+
+  (** Represent the content in dot syntax *)
+  val repr: Format.formatter -> t -> unit
+
+end
diff --git a/src/unicode.ml b/src/unicode.ml
deleted file mode 100755
index cc8c087..0000000
--- a/src/unicode.ml
+++ /dev/null
@@ -1,51 +0,0 @@
-type t = Uchar.t array
-
-type decoder_encoding = Uutf.decoder_encoding
-
-let array_from_rev_list l = begin
-  let length = (List.length l) - 1 in
-  let arr = Array.make (length + 1) (Obj.magic 0) in
-  List.iteri (fun i elem -> Array.set arr (length - i) elem)  l;
-  arr
-end
-
-
-let decode ?encoding str = begin
-  let decoder = Uutf.decoder ?encoding (`String str) in
-  let rec loop buf = begin match Uutf.decode decoder with
-  | `Uchar u -> loop (u::buf)
-  | `Malformed _ -> loop (Uutf.u_rep::buf)
-  | `Await -> assert false
-  | `End -> (
-    array_from_rev_list buf
-  )
-  end in
-  loop []
-end
-
-let to_utf8 (t:t) = begin
-  let buf = Buffer.create 512 in
-  Array.iter (Uutf.Buffer.add_utf_8 buf) t;
-  Buffer.contents buf
-end
-
-let length = Array.length
-
-let get t i = Uchar.of_int @@ Array.get t i
-
-let make i v = Array.make i @@ Uchar.to_int v
-
-let init s f = Array.init s (fun x -> Uchar.to_int @@ f x)
-
-let sub = Array.sub
-
-let blit = Array.blit
-
-let concat = Array.concat
-
-let iter f t = Array.iter (fun x -> f @@ Uchar.of_int x) t
-
-
-let to_list t =
-    Array.map Uchar.of_int t
- |> Array.to_list
diff --git a/src/unicode.mli b/src/unicode.mli
deleted file mode 100755
index 9a48807..0000000
--- a/src/unicode.mli
+++ /dev/null
@@ -1,27 +0,0 @@
-type t
-
-type decoder_encoding = [ `ISO_8859_1 | `US_ASCII | `UTF_16 | `UTF_16BE | `UTF_16LE | `UTF_8 ] 
-
-val decode : ?encoding:[< decoder_encoding ] -> string -> t
-
-val to_utf8: t -> string
-
-(** String functions *)
-
-val length : t -> int
-
-val get : t -> int -> Uchar.t
-
-val make : int -> Uchar.t -> t
-
-val init : int -> (int -> Uchar.t) -> t
-
-val sub : t -> int -> int -> t
-
-val blit : t -> int -> t -> int -> int -> unit
-
-val concat : t list -> t
-
-val iter : (Uchar.t -> unit) -> t -> unit
-
-val to_list : t -> Uchar.t list
diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml
index 9218134..3960c4b 100755
--- a/tests/sheet_test.ml
+++ b/tests/sheet_test.ml
@@ -66,6 +66,22 @@ let test_create_direct_cycle ctx = begin
     result
 end
 
+(** Overide the value after a cycle. *)
+let test_recover_from_cycle ctx = begin
+
+  let s = Sheet.Raw.empty
+       |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=B2 + 1"
+       |> snd |> Sheet.Raw.add (2,2) @@ Expression.load @@ u"=6"
+       |> snd in
+  let result = (Sheet.Raw.get_value (2, 2) s) in
+  let expected = Some (ScTypes.Result (build_num (6))) in
+
+  assert_equal
+    ~msg:(_msg ~expected ~result)
+    expected
+    result
+end
+
 let test_create_indirect_cycle ctx = begin
 
   let s = Sheet.Raw.empty
@@ -160,13 +176,57 @@ let test_update_succs2 ctx = begin
     result
 end
 
+let test_paste_undo ctx = begin
+
+  let empty = Sheet.create Sheet.Raw.empty in
+
+  (* The expected result for the whole test *)
+  let expected = Some (ScTypes.Result (ScTypes.number (DataType.Num.of_int 6))) in
+
+  let sheet = empty
+      |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1))
+      |> Sheet.add (Expression.load @@ u"=6")
+      |> snd
+      |> Tools.Option.test @@ Sheet.move (Actions.Absolute (1, 1))
+      |> Sheet.add (Expression.load @@ u"=B1")
+      |> snd in
+  let result = Sheet.Raw.get_value (1, 1) sheet.Sheet.data in
+
+  (* Ensure the value is correctly evaluated *)
+  assert_equal
+    ~msg:(_msg ~expected ~result)
+    expected
+    result;
+
+  let sheet2 =
+    (* Copy the cell *)
+       fst @@ Sheet.yank sheet
+    |> Tools.Option.test @@ Sheet.move (Actions.Absolute (2, 1))
+    (* Paste it on another value *)
+    |> Sheet.paste
+    |> fst
+    (* Undo the paste *)
+    |> Tools.Option.test @@ Sheet.undo in
+
+  let result = Sheet.Raw.get_value (1, 1) sheet2.Sheet.data in
+
+  (* The value should be the same as the first evaluation *)
+  assert_equal
+    ~msg:(_msg ~expected ~result)
+    expected
+    result
+
+end
+
 let tests = "sheet_test">::: [
-    "test_ref1"     >:: test_create_ref_1;
-    "test_ref2"     >:: test_create_ref_2;
-    "test_cycle1"   >:: test_create_direct_cycle;
-    "test_cycle2"   >:: test_create_indirect_cycle;
-    "test_cycle3"   >:: test_check_cycle3;
-    "test_delete"   >:: test_delete;
-    "test_update_succs1"   >:: test_update_succs1;
-    "test_update_succs2"   >:: test_update_succs2;
+  "test_ref1"           >:: test_create_ref_1;
+  "test_ref2"           >:: test_create_ref_2;
+  "test_cycle1"         >:: test_create_direct_cycle;
+  "test_recover_cycle"  >:: test_recover_from_cycle;
+  "test_cycle2"         >:: test_create_indirect_cycle;
+  "test_cycle3"         >:: test_check_cycle3;
+  "test_delete"         >:: test_delete;
+  "test_update_succs1"  >:: test_update_succs1;
+  "test_update_succs2"  >:: test_update_succs2;
+  "test_paste_undo"     >:: test_paste_undo;
  ]
diff --git a/tests/test.ml b/tests/test.ml
index 2d881ca..ee71cb0 100755
--- a/tests/test.ml
+++ b/tests/test.ml
@@ -9,6 +9,7 @@ let () =
     Expression_test.tests;
     Sheet_test.tests;
     Odf_ExpressionParser_test.tests;
+    Splay_test.tests;
   ]
   in OUnit2.run_test_tt_main tests
 
diff --git a/tests/tree/splay_test.ml b/tests/tree/splay_test.ml
new file mode 100755
index 0000000..3f5fa96
--- /dev/null
+++ b/tests/tree/splay_test.ml
@@ -0,0 +1,200 @@
+open OUnit2
+
+(** Module for the keys *)
+module K = struct
+
+  type 'a t = Int : int -> int t [@@unboxed]
+
+  let comp:type a b. a t -> b t -> (a, b) Tools.cmp = fun a b -> begin
+    match a, b with Int a, Int b ->
+
+    if a < b then
+      Tools.Lt
+    else if a > b then
+      Tools.Gt
+    else
+      Tools.Eq
+  end
+
+  let repr: type a. Format.formatter -> a t -> unit = fun formatter (Int a) ->
+    Format.fprintf formatter "%d" a
+
+end
+
+module SplayTest = Splay.Make(K)
+
+let test_add ctx = begin
+
+  let tree =
+     SplayTest.empty
+  |> SplayTest.add (K.Int 1) (-1)
+  |> SplayTest.add (K.Int 3) 2
+  |> SplayTest.add (K.Int 5) 2
+  |> SplayTest.add (K.Int 4) 1 in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {\n\
+    \"4\" -> \"3\"\n\
+    \"3\" -> \"1\"\n\
+    \"4\" -> \"5\"\n\
+    }" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+let test_removeLeaf ctx = begin
+
+  let tree =
+     SplayTest.empty
+  |> SplayTest.remove (K.Int 4)
+  in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {}" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+let test_removeTop ctx = begin
+
+  let tree =
+     SplayTest.empty
+  |> SplayTest.add (K.Int 1) (-1)
+  |> SplayTest.add (K.Int 3) 2
+  |> SplayTest.add (K.Int 5) 2
+  |> SplayTest.add (K.Int 4) 1
+  |> SplayTest.remove (K.Int 4)
+  in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {\n\
+    \"3\" -> \"1\"\n\
+    \"3\" -> \"5\"\n\
+    }" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+let test_removeLeft ctx = begin
+  let tree =
+     SplayTest.empty
+  |> SplayTest.add (K.Int 1) (-1)
+  |> SplayTest.add (K.Int 3) 2
+  |> SplayTest.add (K.Int 5) 2
+  |> SplayTest.add (K.Int 4) 1
+  |> SplayTest.remove (K.Int 3)
+  in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {\n\
+    \"1\" -> \"4\"\n\
+    \"4\" -> \"5\"\n\
+    }" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+(** Remove a value not present in the tree.
+  The tree shall be rebalanced. *)
+let test_removeOutMax ctx = begin
+  let tree =
+     SplayTest.empty
+  |> SplayTest.add (K.Int 1) (-1)
+  |> SplayTest.add (K.Int 3) 2
+  |> SplayTest.add (K.Int 5) 2
+  |> SplayTest.add (K.Int 4) 1
+  |> SplayTest.remove (K.Int 6)
+  in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {\n\
+    \"5\" -> \"4\"\n\
+    \"4\" -> \"3\"\n\
+    \"3\" -> \"1\"\n\
+    }" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+(** Remove the maximum value in the tree *)
+let test_removeMax ctx = begin
+  let tree =
+     SplayTest.empty
+  |> SplayTest.add (K.Int 1) (-1)
+  |> SplayTest.add (K.Int 3) 2
+  |> SplayTest.add (K.Int 5) 2
+  |> SplayTest.add (K.Int 4) 1
+  |> SplayTest.remove (K.Int 5)
+  in
+
+  let formatter = Format.str_formatter in
+  SplayTest.repr formatter tree;
+  let str = Format.flush_str_formatter () in
+
+  let expected = "digraph G {\n\
+    \"4\" -> \"3\"\n\
+    \"3\" -> \"1\"\n\
+    }" in
+  let result = str in
+
+  let msg = Printf.sprintf "Expected %s, but got %s." expected result in
+
+  assert_equal
+    ~msg
+    expected
+    result
+end
+
+let tests = "splay_test">::: [
+  "add"           >:: test_add;
+  "removeLeaf"    >:: test_removeLeaf;
+  "removeTop"     >:: test_removeTop;
+  "removeLeft"    >:: test_removeLeft;
+  "removeMax"     >:: test_removeMax;
+  "removeOutMax"  >:: test_removeOutMax;
+]
-- 
cgit v1.2.3