ocamlformatHEADmaster

1 files changed, 64 insertions, 101 deletions

diff --git a/src/tree/pageMap.ml b/src/tree/pageMap.ml
index e18ba6f..967ccfe 100644
--- a/src/tree/pageMap.ml
+++ b/src/tree/pageMap.ml
@@ -18,178 +18,141 @@ along with licht.  If not, see <http://www.gnu.org/licenses/>.
 type cell = int * int

 

 module type T_DEFAULT = sig

-

   type t

 

   val default : t

-

 end

 

-module MapArray(T:T_DEFAULT) = struct

-

+module MapArray (T : T_DEFAULT) = struct

+  type t = int * T.t array array

   (** 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 find (x : int) (y : int) (t : t) : T.t =

     let block = snd t in

     block.(y).(x)

-  end

 

-  let add (x:int) (y:int) (value:T.t) (t:t) : t = begin

+  let add (x : int) (y : int) (value : T.t) (t : t) : t =

     let n, block = t in

-    let n' =

-      if (block.(y).(x) == T.default) then

-        n + 1

-      else

-        n in

+    let n' = if block.(y).(x) == T.default then n + 1 else n in

     block.(y).(x) <- value;

-    n', block

-  end

+    (n', block)

 

-  let remove (x:int) (y:int) (t:t) : t = begin

+  let remove (x : int) (y : int) (t : t) : t =

     let n, block = t in

-    if (block.(y).(x) = T.default) then

-     t

+    if block.(y).(x) = T.default then t

+    else if n = 1 then (* Do not keep empty block in memory *)

+      raise Not_found

     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

+      block.(y).(x) <- T.default;

+      (n - 1, block))

 

-  let create array_size =  begin

-    0, Array.make_matrix array_size array_size T.default

-  end

+  let create array_size = (0, Array.make_matrix array_size array_size T.default)

 

-  let fold_line f y init t = begin

-    let n, block = t

-    and res = ref init in

+  let fold_line f y init t =

+    let n, block = t and res = ref init in

 

     let array_size = Array.length block in

-    for x = 0 to (array_size - 1) do

+    for x = 0 to array_size - 1 do

       let value = block.(y).(x) in

-      if value != T.default then

-        res := f x value !res;

+      if value != T.default then res := f x value !res

     done;

     !res

-  end

-

 end

 

-module SplayMap(T:T_DEFAULT) = struct

-

+module SplayMap (T : T_DEFAULT) = struct

   let array_size = 8

 

-  module PageMap = MapArray(T)

+  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

+    let comp : type a b. a t -> b t -> (a, b) Tools.cmp =

+     fun a b ->

+      match (a, b) with

+      | K (x1, y1), K (x2, y2) ->

+          let res = Stdlib.compare (y1, x1) (y2, x2) in

+          if res < 0 then Tools.Lt else if res > 0 then Tools.Gt else Tools.Eq

 

+    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)

+  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 get_bounded_values (x, y) = (max 0 x, max 0 y)

 

-  let find (id:cell) (t:Map.t) : T.t = begin

+  let find (id : cell) (t : Map.t) : T.t =

     let x, y = get_bounded_values id in

-    let block_x = x / array_size

-    and block_y = y / array_size 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 add (id : cell) (value : T.t) (t : Map.t) : Map.t =

     let x, y = get_bounded_values id in

-    let block_x = x / array_size

-    and block_y = y / array_size 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

+      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 remove (id : cell) (t : Map.t) : Map.t =

     let x, y = get_bounded_values id in

-    let block_x = x / array_size

-    and block_y = y / array_size 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

+        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 -> 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 fold f (t : Map.t) init =

     let res = ref init in

 

-    let call_function column row x value acc = begin

-      f (column + x, row) value acc

-    end in

+    let call_function column row x value acc = f (column + x, row) value acc 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 process_pages block_y acc =

+      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;

-

+        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

+    in

+

+    let fold_blocks (current_row, acc) (Map.C key_val) =

+      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) ]))

+    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