From 2d52075c1d0f1b893d16f3e567fed5bc1e520be7 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sat, 28 Jul 2018 19:14:25 +0200
Subject: Tailcall optimisation

---
 src/sheet.ml | 76 +++++++++++++++++++++++++-----------------------------------
 1 file changed, 31 insertions(+), 45 deletions(-)

(limited to 'src/sheet.ml')

diff --git a/src/sheet.ml b/src/sheet.ml
index cfe299d..b72786e 100755
--- a/src/sheet.ml
+++ b/src/sheet.ml
@@ -62,54 +62,40 @@ module Raw = struct
         None
   end
 
-  exception Cycle of Cell.Set.t * t
+  let traverse (f:(cell -> content -> t -> t option)) content (init, t) = begin
 
-  (** Parse all the successors from an element, apply a function to each of
-      them, and return them.
-
-      The function is too long and should be rewriten… *)
-  let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin
-    try  Cell.Set.fold (successors init f init source) source.sink (init, t)
-    with Cycle (succ, t) -> (succ, t)
-  end
-
-  and successors init f parents source element (succ, t) = begin
-
-    let content = Map.find element t in
-
-    if Cell.Set.mem element parents then (
-
-      (* if the cell has already been visited, mark it in error, and all the
-         descendant *)
-      let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
+    let rec ts visited t next = begin
+      if Cell.Set.is_empty next then
+        Ok (visited, t)
+      else
+        let (id:cell) = Cell.Set.choose next in
 
-      if content.value = cycle_error then (
-        (* The content has already been updated, do not process it again *)
-        (succ, t)
-      ) else (
-        let t = Map.add element { content with value = cycle_error } t
-        and set_error cell content t =
-          if content.value = cycle_error then
-            None
-          else
-            Some (Map.add cell { content with value = cycle_error } t) in
-        let succ, t = traverse set_error source (init, t) in
-        raise (Cycle (succ, t))
-      )
-    ) else (
-      begin match f element content t with
-      | None ->
-        (* The content does not change, we do not update the successors *)
-        (succ, t)
-      | Some t' ->
-        let parents' = Cell.Set.add element parents
-        and succ' = Cell.Set.add element succ in
-        if (Cell.Set.is_empty content.sink) then
-          (succ', t')
+        if Cell.Set.mem id init then
+          Error (visited, t)
         else
-          Cell.Set.fold (successors init f parents' source) content.sink (succ', t')
-      end
-    )
+          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
+    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
   end
 
   (** Remove the cell from the sheet *)
-- 
cgit v1.2.3