Update the traversing sheet function

4 files changed, 128 insertions, 62 deletions

diff --git a/src/sheet.ml b/src/sheet.ml
index b72786e..4984bde 100755
--- a/src/sheet.ml
+++ b/src/sheet.ml
@@ -34,70 +34,122 @@ module Raw = struct
 

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

+  module PageMap = PageMap.SplayMap(struct type t = content let default = empty_cell end)

 

-  (** The sheet is a map which always contains evaluated values. When a cell is

+  (** The sheet is a PageMap which always contains evaluated values. When a cell is

       updated, all the cell which references this value are also updated.

     *)

-  type t = Map.t

+  type t = PageMap.t

 

-  let get_expr id t = (Map.find id t).expr

+  let get_expr id t = (PageMap.find id t).expr

 

   (** Update the value for the given cell.

       Evaluate the new expression and compare it with the previous value.

-      @return Some map if the map has been updated

+      @return Some PageMap if the PageMap has been updated

    *)

   let update catalog cell content t = begin

-    let new_val = Expression.eval content.expr catalog (fun id -> (Map.find id t).value) in

+    let new_val = Expression.eval content.expr catalog (fun id -> (PageMap.find id t).value) in

     match content.value with

     | None ->

-      (* If the previous value wasn't defined, update the map *)

-      Some (Map.add cell { content with value = Some new_val } t)

+      (* If the previous value wasn't defined, update the PageMap *)

+      Some (PageMap.add cell { content with value = Some new_val } t)

     | Some old_value ->

       (* If the previous value was defined, update only if result differs *)

       if not (ScTypes.Result.(=) new_val old_value) then

-        Some (Map.add cell { content with value = Some new_val } t)

+        Some (PageMap.add cell { content with value = Some new_val } t)

       else

-        (* If there is no changes, do not update the map *)

+        (* If there is no changes, do not update the PageMap *)

         None

   end

 

-  let traverse (f:(cell -> content -> t -> t option)) content (init, t) = begin

+  let traverse (f:(cell -> content -> t -> t option)) content (id, t) = begin

 

-    let rec ts visited t next = begin

-      if Cell.Set.is_empty next then

-        Ok (visited, t)

+    let module M = Hashtbl.Make(struct

+      type t = cell

+      let equal c1 c2 = c1 = c2

+      let hash (x, y) = (lnot x) + y

+    end) in

+

+    (* Create a table with each cell and it evaluation order.

+       Detect cycles and return None if there is any.

+    *)

+    let rec _order cache level next : cell array option =

+      begin match (Cell.Set.is_empty next) with

+      | true ->

+        (* Nothing more to do, store the values in an array, and return it. *)

+        let arr = Array.make (M.length cache) (0, (0, 0)) in

+        let i = ref 0 in

+        M.iter (fun id (idx, _) ->  Array.set arr (!i) (idx, id); incr i ) cache;

+        Array.sort (fun ((v1:int), _) ((v2:int), _) -> compare v1 v2) arr;

+        Some (Array.map (fun (_, cell) -> cell) arr)

+

+      | false ->

+        let id = Cell.Set.choose next in

+

+        let content = PageMap.find id t in

+

+        let update k = function

+        | None -> None

+        | Some level ->

+          let level' = level + 1 in

+          begin match M.find_opt cache k with

+          | None -> M.add cache k (level', Cell.Set.singleton id);

+            Some level'

+          | Some (depth, pred) ->

+              if (Cell.Set.mem id pred) then

+                (* There is a cycle, break the loop *)

+                None

+              else

+                let pred' = Cell.Set.add id pred in

+                M.replace cache k (level', pred');

+                Some level'

+          end

+        in

+

+        (* Update the cache for each sink in the cell *)

+        match Cell.Set.fold update content.sink level with

+        | None -> None (* There is a cylce, juste stop *)

+        | level' ->

+          (* Then add all the cell to be next set *)

+             Cell.Set.remove id next

+          |> Cell.Set.union content.sink

+          |> _order cache level'

+

+      end in

+

+    let eval (to_update, t) (id) = begin

+      if not (Cell.Set.mem id to_update) then

+        (to_update, t)

       else

-        let (id:cell) = Cell.Set.choose next in

+        let content = PageMap.find id t in

+        match f id content t with

+        | None -> (to_update, t)

+        | Some t' -> (Cell.Set.union content.sink to_update, t')

+      end in

 

-        if Cell.Set.mem id init then

-          Error (visited, t)

+    (** Traverse all the cells to mark them with an error *)

+    let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in

+    let rec set_error t next = begin

+      if Cell.Set.is_empty next then

+        (* Nothing more to do, just return the sheet updated *)

+        t

+      else

+        let id = Cell.Set.choose next in

+        let content = PageMap.find id t in

+        let next' = Cell.Set.remove id next in

+        if content.value = cycle_error then

+          set_error t next'

         else

-          let content = Map.find id t in

-          let next' = Cell.Set.remove id next

-          and visited' = Cell.Set.add id visited in

-

-          begin match f id content t with

-          | None ->

-            (* The content does not change, we do not update the successors *)

-            (ts[@tailcall]) visited' t next'

-          | Some t' ->

-            let delta = Cell.Set.diff content.sink init in

-            let next'' = Cell.Set.union next' delta in

-

-            (ts[@tailcall]) visited' t' next''

-        end

+          let t' = PageMap.add id { content with value = cycle_error } t in

+          set_error t' (Cell.Set.union next' content.sink)

     end in

 

-    begin match ts init t content.sink with

-    | Ok (visited, t) -> (visited, t)

-    | Error (visited, t) ->

-        let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in

-        let setErr cell t : t= Map.add cell { content with value = cycle_error } t in

-        visited, Cell.Set.fold setErr visited t

-    end

+    match _order (M.create 16) (Some 0) (Cell.Set.singleton id) with

+    | None -> Cell.Set.empty, (set_error t (Cell.Set.singleton id))

+    | Some arr -> Array.fold_left eval ((Cell.Set.add id content.sink), t) arr

   end

 

+

   (** Remove the cell from the sheet *)

   let remove_element (id:cell) t : t * content option = begin

 

@@ -105,18 +157,18 @@ module Raw = struct
         If the sources is not referenced anywhere, and is Undefined, remove it

     *)

     let remove_ref cell t = begin

-      try let c = Map.find cell t in

+      try let c = PageMap.find cell t in

         (* Remove all the refs which points to the removed cell *)

         let sink' = Cell.Set.filter ((<>) id) c.sink in

         if Cell.Set.is_empty sink' && not (Expression.is_defined c.expr) then (

-          Map.remove cell t )

+          PageMap.remove cell t )

         else

-          Map.add cell {c with sink = sink'} t

+          PageMap.add cell {c with sink = sink'} t

       with Not_found -> t

     end in

 

     begin try

-      let c = Map.find id t in

+      let c = PageMap.find id t in

       let t' =

         (** Remove the references from each cell pointed by the expression *)

         let sources = Expression.collect_sources c.expr in

@@ -127,10 +179,10 @@ module Raw = struct
       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

+        PageMap.remove id t', None

       else (

         let c = { empty_cell with sink = sink' } in

-        Map.add id c t', (Some c)

+        PageMap.add id c t', (Some c)

       )

     with Not_found -> t, None

     end

@@ -141,7 +193,7 @@ module Raw = struct
     | t, None -> Cell.Set.empty, t

     | t, Some content ->

         (** Update all the successors *)

-        traverse (update catalog) content (Cell.Set.singleton id, t)

+        traverse (update catalog) content (id, t)

   end

 

   let add_element catalog id content_builder t = begin

@@ -151,10 +203,10 @@ module Raw = struct
     *)

     let add_ref cell t = begin

       let c =

-        try Map.find cell t

+        try PageMap.find cell t

         with Not_found -> empty_cell in

       let c' = { c with sink = Cell.Set.add id c.sink} in

-      Map.add cell c' t

+      PageMap.add cell c' t

     end in

 

     (* Remove the cell and update all the sink. *)

@@ -166,12 +218,12 @@ module Raw = struct
     let content = content_builder cell' t' in

 

     let sources = Expression.collect_sources content.expr in

-    let updated = Map.add id content t'

+    let updated = PageMap.add id content t'

     |> Cell.Set.fold add_ref sources

     in

 

     (** Update the value for each sink already evaluated *)

-    traverse (update catalog) content (Cell.Set.singleton id, updated)

+    traverse (update catalog) content (id, updated)

   end

 

   let add id expression catalog t = begin

@@ -181,7 +233,7 @@ module Raw = struct
       let f cell t = begin

         { cell with

           expr = expression ;

-          value = Some (Expression.eval expression catalog (fun id -> (Map.find id t).value)) }

+          value = Some (Expression.eval expression catalog (fun id -> (PageMap.find id t).value)) }

       end in

       add_element catalog id f t

   end

@@ -191,13 +243,13 @@ module Raw = struct
     let f cell t =

       { cell with

         expr = expr ;

-        value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value))

+        value = Some (Expression.eval expr catalog (fun id -> (PageMap.find id t).value))

       } in

     add_element catalog id f t

   end

 

   let get_sink id t =

-    try (Map.find id t).sink

+    try (PageMap.find id t).sink

     with Not_found -> Cell.Set.empty

 

 end

@@ -245,7 +297,7 @@ let yank selected t = begin
   let origin = shift (0, 0) in

   let _yank (count, extracted) cell = begin

     let content =

-    try let content = (Raw.Map.find cell (!t).data) in

+    try let content = (Raw.PageMap.find cell (!t).data) in

     { content with Raw.expr = Expression.shift origin content.Raw.expr }

     with Not_found ->  Raw.empty_cell in

 

@@ -288,7 +340,7 @@ let add ~history expression id t = begin
 end

 

 let create catalog = ref {

-  data = Raw.Map.empty;

+  data = Raw.PageMap.empty;

   history = [];

   yank = [];

   catalog = catalog

@@ -296,7 +348,7 @@ let create catalog = ref {
 

 (** Fold over each defined value *)

 let fold f a t = begin

-  Raw.Map.fold (fun key content a ->

+  Raw.PageMap.fold (fun key content a ->

     match content.Raw.value with

     | None -> a

     | Some x ->

@@ -305,6 +357,6 @@ let fold f a t = begin
 end

 

 let get_cell id t = begin

-  let cell = Raw.Map.find id (!t).data in

+  let cell = Raw.PageMap.find id (!t).data in

   cell.expr, cell.value, cell.sink

 end

diff --git a/src/tree/splay.ml b/src/tree/splay.ml
index de7d441..dd1f65d 100644
--- a/src/tree/splay.ml
+++ b/src/tree/splay.ml
@@ -180,6 +180,11 @@ module Make (El : KEY) = struct
     _fold [] init !t
   end
 
+  let choose (T tree) = begin match (_subtree_minimum !tree) with
+  | Leaf -> raise Not_found
+  | Node (left, (key, value), right) -> C (key, value)
+  end
+
   let repr formatter (T t) = begin
 
     let repr_edge from formatter dest = begin
diff --git a/src/tree/splay.mli b/src/tree/splay.mli
index a640075..60d067b 100755
--- a/src/tree/splay.mli
+++ b/src/tree/splay.mli
@@ -48,6 +48,11 @@ module Make (El : KEY) : sig
 

   val fold: ('a -> container -> 'a) -> 'a -> t -> 'a

 

+  (** Return one element of the given tree, or raise Not_found if the tree is

+  empty. Which element is chosen is unspecified, but equal elements will be

+  chosen for equal trees. *) 

+  val choose: t -> container

+

   (** Represent the content in dot syntax *)

   val repr: Format.formatter -> t -> unit

 

diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml
index db09f37..7c5da64 100755
--- a/tests/sheet_test.ml
+++ b/tests/sheet_test.ml
@@ -75,7 +75,7 @@ let test_create_direct_cycle ctx = begin
   ignore @@ Sheet.add ~history:false (Expression.load @@ u"=B2 + 1") (2,2) s;
 
   let _, result, _ = Sheet.get_cell (2, 2) s in
-  let expected = Some (ScTypes.Result.Error Errors.TypeError) in
+  let expected = Some (ScTypes.Result.Error Errors.Cycle) in
 
   assert_equal
     ~msg:(_msg ~expected ~result)
@@ -165,7 +165,7 @@ let test_update_succs1 ctx = begin
   let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in
 
   (* All the cells are updated by the change *)
-  let expected = Cell.Set.of_list [(1,1); (1, 2); (2,2)] in
+  let expected = Cell.Set.of_list [(1, 2); (1, 1); (2, 2)] in
 
   let msg = Printf.sprintf "Expected %s but got %s"
     (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected)
@@ -186,9 +186,13 @@ let test_update_succs2 ctx = begin
   let result = Sheet.add ~history:false (Expression.load @@ u"=2") (1,1) s in
 
   (* Only (1, 1) is updated ; (2, 2) does not change, neither (2, 2) *)
-  let expected = Cell.Set.of_list [(1,1)] in
+  let expected = Cell.Set.of_list [(1,2); (1,1)] in
 
-  assert_equal
+  let msg = Printf.sprintf "Expected %s but got %s"
+    (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb expected)
+    (UTF8.raw_encode @@ Tools.String.print_buffer Cell.Set.printb result) in
+
+  assert_equal ~msg
     expected
     result
 end
@@ -232,10 +236,10 @@ let tests = "sheet_test">::: [
   "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_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_update_succs2"  >:: test_update_succs2;
   "test_paste_undo"     >:: test_paste_undo;
  ]