[Fix] seq bug (again) : memoization bug (depth kept used the already

generated surf when it was wrong)
remyzorg · Jul 16, 2015 · d25cb73 · d25cb73
1 parent e64f547
commit d25cb73
Show file tree

Hide file tree

Showing 6 changed files with 24 additions and 24 deletions.
diff --git a/examples/basic_mouse_loc/main.ml b/examples/basic_mouse_loc/main.ml
@@ -3,7 +3,7 @@
 let%sync m =
   input btn_up;
   input move;
-  input ex1;
+  input ex;
 
   loop begin
     present btn_up (

diff --git a/generated_trees/test_ppx_m_fg.pdf b/generated_trees/test_ppx_m_fg.pdf
diff --git a/generated_trees/test_ppx_m_interfg.pdf b/generated_trees/test_ppx_m_interfg.pdf
diff --git a/generated_trees/test_ppx_m_interfg2.pdf b/generated_trees/test_ppx_m_interfg2.pdf
diff --git a/src/preproc/grc.ml b/src/preproc/grc.ml
@@ -285,10 +285,7 @@ module Of_ast = struct
 
   type flow_builder = env -> Tagged.t -> Flowgraph.t -> Flowgraph.t -> Flowgraph.t
 
-  let memo_rec :
-    (int, Flowgraph.t) Hashtbl.t ->
-    (flow_builder -> flow_builder) ->
-    flow_builder =
+  let memo_rec =
     fun h f ->
       let open Tagged in
       let rec g env x p e =
@@ -329,11 +326,12 @@ module Of_ast = struct
         @@ exit_node p endp
 
       | Seq (q,r) ->
-        enter_node p @@
-        if env.under_suspend || Ast.Analysis.blocking q then
-          surface env q pause endp
-        else
-          surface env q pause @@ surface env r pause endp
+
+        let surf_r = (surface env r pause @@ exit_node p endp) in
+        Hashtbl.remove h r.id;
+        enter_node p
+        @@ surface env q pause
+        @@ surf_r
 
       | Present (s, q, r) ->
         let end_pres = exit_node p endp in
@@ -684,12 +682,12 @@ module Schedule = struct
 
 
 
-            (* | Finish, fg2 -> Finish *)
-            (* | Pause, fg2 -> Pause *)
+            (* | Finish, fg2 -> fg2 *)
+            (* | Pause, fg2 -> fg2 *)
 
             | (Finish | Pause), fg
             | fg, (Finish | Pause) ->
-              error ~loc:Ast.dummy_loc (Par_leads_to_finish fg1)
+              error ~loc:Ast.dummy_loc (Par_leads_to_finish fg2)
 
             | Test (Signal s, t1, t2), fg2 ->
               if emits fg2 stop s then

diff --git a/tests/ppx/test_ppx.ml b/tests/ppx/test_ppx.ml
@@ -112,22 +112,24 @@ let%sync_ast evenodd =
     pause
   end
 
+let%to_dot_grc loop_pause_atom = (* Bad grc generation : loop that doesn't loop *)
+  input click;
+  input move;
+  loop begin
+    pause;
+    atom (Format.printf "step@\n");
+  end
+
 let%to_dot_grc m = (* Grc.Error  (_, _) *)
   input btn_up;
   input move;
   input ex;
 
-  trap ex begin
-    loop begin
-      present btn_up (atom ())
-    end
-    ||
-    loop begin
-      present ex (exit ex);
-      pause
-    end
-  end;
-  atom ()
+  trap t (
+    loop (
+      present ex (exit t);
+      pause))
+  ; atom (ignore 2)
 
 
 let par_deps ctx = assert_equal