Commits

Matthew Hammer  committed b6d8480

using graph output, confirmed that re-evaluated nodes are (incorrectly) marked filthy; obsolete ownership info is to blame; next: track ownership info accurately..

  • Participants
  • Parent commits 02c0560
  • Branches nominal

Comments (0)

Files changed (3)

File Source/AdaptonZoo/Adapton.ml

       id          : int ;
       symbol      : Symbol.t option ;
       key         : Key.t option ;
+      mutable repair_seqno : int ; (* when we last visited the node for repair. *)
+      mutable eval_seqno_before: int ; (* when we last decided to re/evaluated the node; updated beforehand. *)
+      mutable eval_seqno_after : int ; (* when we last decided to re/evaluated the node; updated afterwards. *)
       mutable check_seqno  : int ; (* when we last checked the node's value. *)
-      mutable repair_seqno : int ; (* when we last visited the node for repair. *)
       mutable arg_string   : unit -> string ;
       mutable val_string   : unit -> string ;
       mutable is_filthy    : unit -> bool ;
            is_filthy=(fun _ -> failwith "is_filthy");
            arg_string=(fun _ -> "?");
            val_string=(fun _ -> "?");
+           repair_seqno=(-1);
+           eval_seqno_before=(-1);
+           eval_seqno_after=(-1);
            check_seqno=(-1);
-           repair_seqno=(-1);
          }
          ELSE () END)
 
                       let check_result =
                         d.receipt.check begin fun c ->
                           if c then (incr Statistics.Counts.clean; repair_deps ds)
-                          else cont (evaluate ())
+                          else begin
+
+                            IFDEF ADAPTON_LOG THEN (
+                              if thunk.meta.debug.eval_seqno_before <> !global_seqno then (
+                                thunk.meta.debug.eval_seqno_before <- !global_seqno ;
+                                Log.usr_hooks.Log.output_graph () ;
+                              )
+                              else failwith "detected redundant re-evaluation"
+                            ) END ;
+
+                            let evaluate_result = evaluate () in
+
+                            IFDEF ADAPTON_LOG THEN (
+                              if thunk.meta.debug.eval_seqno_after <> !global_seqno then (
+                                thunk.meta.debug.eval_seqno_after <- !global_seqno ;
+                                Log.usr_hooks.Log.output_graph () ;
+                              )
+                              else failwith "detected redundant re-evaluation"
+                            ) END ;
+
+                            cont evaluate_result
+                          end
                         end
                       in
                       IFDEF ADAPTON_LOG THEN (
     fun ?(filename="") (thunk:'a thunk) -> IFDEF ADAPTON_LOG THEN(
       let module Colors = struct
         (* http://www.graphviz.org/doc/info/colors.html *)
-        let blue    = "lavender" (*"lightblue"*) (*"cornflowerblue"*)
-        let green   = "palegreen"
-        let red     = "lightpink" (*"red"*)
+        let hi_blue  = "lavender"    (*"lightblue"*) (*"cornflowerblue"*)
+        let lo_blue  = "cornflowerblue"
+        let lo_green = "palegreen4"
+        let hi_green = "palegreen"
+        let red     = "lightpink"   (*"red"*)
         let redgrey = "lightpink4"
         let grey    = "grey"
         let purple  = "mediumorchid1"
           let compare (d1:debug) (d2:debug) = d1.id - d2.id
         end )
       in
-      let out = if filename <> "" then
-        open_out filename
-      else
-        open_out (Printf.sprintf "dcg-%03d-%03d.dot" (!global_seqno) (!graph_seqno))
+      let filename =
+        if filename <> "" then filename
+        else (Printf.sprintf "dcg-%03d-%03d.dot" (!global_seqno) (!graph_seqno))
       in
+      let out =  open_out filename in
       incr graph_seqno ;
       let stack : S.t = List.fold_right S.add
         (List.map (fun (meta,_,_) -> meta.debug) (!lazy_stack))
         if S.mem node visited then visited
         else (
           let visited = S.add node visited in
-          Printf.fprintf out "  n%d [label=\"%d %s\\n%s %s\\n%s\" color=%s];\n"
-            node.id node.id
-            (match node.key with None -> "" | Some k -> Key.string k)
-            (match node.symbol with None -> "" | Some s -> s)
-            (node.arg_string ())
-            (node.val_string ())
+          let label =
+            if false (* true means "very descriptive label" *) then
+              Printf.sprintf "%d %s\\n%s %s\\n%s"
+                node.id
+                (match node.key with None -> "" | Some k -> Key.string k)
+                (match node.symbol with None -> "" | Some s -> s)
+                (node.arg_string ())
+                (node.val_string ())
+            else
+              Printf.sprintf "%d" node.id
+          in
+          Printf.fprintf out "  n%d [label=\"%s\" color=%s];\n"
+            node.id label
             ( if node.is_filthy () && not (S.mem node stack) then Colors.red
-              else if node.is_filthy () && (S.mem node stack) then Colors.redgrey
+              else if node.is_filthy () && (S.mem node stack) then Colors.redgrey (* _Both_ filthy and stacked: Should never see this case. *)
               else if S.mem node stack then Colors.grey
-              else if node.check_seqno == !global_seqno then Colors.green
-              else if node.repair_seqno == !global_seqno then Colors.purple
-              else Colors.blue )
+              else if node.check_seqno        = !global_seqno then Colors.hi_green
+              else if node.eval_seqno_after   = !global_seqno then Colors.lo_green
+              else if node.eval_seqno_before  = !global_seqno then Colors.lo_blue
+              else if node.repair_seqno       = !global_seqno then Colors.purple
+              else Colors.hi_blue )
           ;
           (* dump force and mutation targets of the node: *)
           List.iter begin fun ((tgt:debug), edge_is_dirty) ->
         )
       in
       Printf.fprintf out "digraph dcg_%d {\n" (!global_seqno) ;
+      Printf.fprintf out "  labelloc=\"t\";\n" ;
+      Printf.fprintf out "  label=\"%s\";\n" filename ;
       Printf.fprintf out "  node [fontname=\"sans-serif\"];\n" ;
       Printf.fprintf out "  node [shape=box style=\"rounded,filled\"];\n" ;
       let visited = S.empty in

File Test/nominaladaptontest.ml

 
     let label = 2
     let list = [4; -8; -3; -2; -7; -4]
-    let edits = 
+    let edits =
       [[(true, -9, -1)];
        [(true, 8, -2); (false, 6, -4); (true, 0, -2); (true, -8, 0);
         (false, -5, -3); (true, 9, 8); (true, -3, -6); (false, -4, -7)
        [(false, -6, 4); (false, -8, -7); (false, 3, -9); (true, -6, 6)];
        [(false, -6, 1); (true, -4, 2); (true, 3, -10); (false, -3, -1);
         (true, 6, -3); (true, 1, -6)
-       ]; 
+       ];
 *)
       ]
   end

File display-dot.sh

 echo "generating PDFs from dot..(be patient).."
-for i in *.dot ; do dot -Tpdf $i > $i.pdf ; done ; open *.dot.pdf
+for i in *.dot ; do 
+    dot -Tpdf $i > $i.pdf ; echo "generated $i.pdf"
+done ; 
+open *.dot.pdf