Better memory management

13 files changed, 481 insertions, 283 deletions

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/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/splay.ml b/src/tree/splay.ml
index 4bbc3dd..662fc6c 100644
--- a/src/splay.ml
+++ b/src/tree/splay.ml
@@ -11,16 +11,16 @@ end
 
 module Make (El : KEY) = struct
 
-  type 'a elem = 'a El.t
+  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 treeVal =
-    | Leaf : leaf treeVal
-    | Node : _ treeVal * ('a elem * 'a) * _ treeVal -> node treeVal
+  type 'a branch =
+    | Leaf : leaf branch
+    | Node : _ branch * ('a El.t * 'a) * _ branch -> node branch
 
-  type t = T : 'a treeVal ref -> t [@@unboxed]
+  type t = T : 'a branch ref -> t [@@unboxed]
 
   let empty = T (ref Leaf)
 
@@ -28,7 +28,7 @@ module Make (El : KEY) = struct
     | Leaf -> true
     | _ -> false
 
-  let rec splay : type a. a elem -> node treeVal -> node treeVal = fun x t -> begin
+  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
@@ -79,7 +79,7 @@ module Make (El : KEY) = struct
     end
   end
 
-  let member: type a. a elem -> t -> bool = fun x (T t) -> match !t with
+  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
@@ -90,7 +90,7 @@ module Make (El : KEY) = struct
           | _ -> false
         end
 
-  let find: type a. a elem -> t -> a = fun x (T t) -> match !t with
+  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
@@ -101,17 +101,68 @@ module Make (El : KEY) = struct
           | _ -> raise Not_found
         end
 
-  let add: type a. a elem -> a -> t -> t = fun key value (T t) -> match !t with
+  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 root')
+          | 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
@@ -120,7 +171,7 @@ module Make (El : KEY) = struct
         El.repr dest
     end in
 
-    let rec repr': type a b. a El.t -> Format.formatter -> b treeVal -> unit = fun parent formatter -> function
+    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
diff --git a/src/splay.mli b/src/tree/splay.mli
index 41c1a5a..521441c 100755
--- a/src/splay.mli
+++ b/src/tree/splay.mli
@@ -18,12 +18,19 @@ module Make (El : KEY) : sig
   (** Return the element in the tree with the given key *)

   val find: 'a El.t -> t -> 'a

 

-  (** Add one element in the tree *)

+  (** 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

 

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