X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Feval.ml;h=59ebc03e8783f7f25ad6aa0f1cd816e103a1069a;hp=76d9153fb969e915c04c927642fd92ad1805558c;hb=67121f5969c723a6cdb7a638fae344dc14f20751;hpb=974dacbf4f625bfd8ea83db69d6b346050141fea diff --git a/src/eval.ml b/src/eval.ml index 76d9153..59ebc03 100644 --- a/src/eval.ml +++ b/src/eval.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) INCLUDE "utils.ml" @@ -50,12 +50,23 @@ END let fc = T.first_child tree node in let ns = T.next_sibling tree node in let tag = T.tag tree node in - let states0 = get cache tree node in - let trans0 = Ata.get_trans auto tag auto.Ata.states in + let config0 = + let c = get cache tree node in + if c == Cache.N1.dummy cache then + Ata.Config.make + { c.Ata.Config.node with Ata.todo = Ata.get_trans auto tag auto.Ata.states } + else c + in + let () = - TRACE(Html.trace (T.preorder tree node) _i "Pre States: %a
Pre Trans: %a
" - StateSet.print states0 (Ata.TransList.print ~sep:"
") trans0) + TRACE( + let config0 = config0.Ata.node in + Html.trace (T.preorder tree node) _i "Config0
sat: %a
unsat: %a
todo: %a
" + StateSet.print config0.Ata.sat + StateSet.print config0.Ata.unsat + (Ata.TransList.print ~sep:"
") config0.Ata.todo) in + let ps = get cache tree parent in let fcs = get cache tree fc in let nss = get cache tree ns in @@ -65,41 +76,57 @@ END and has_right = ns != T.nil and kind = T.kind tree node in - let trans1, states1 = - Ata.eval_trans auto trans0 - fcs nss ps states0 + let config1 = + Ata.eval_trans auto fcs nss ps config0 is_left is_right has_left has_right kind in let () = - TRACE(Html.trace (T.preorder tree node) _i "TD States: %a
TD Trans: %a
" StateSet.print states1 (Ata.TransList.print ~sep:"
") trans1) + TRACE( + let config1 = config1.Ata.node in + Html.trace (T.preorder tree node) _i "Config1
sat: %a
unsat: %a
todo: %a
" + StateSet.print config1.Ata.sat + StateSet.print config1.Ata.unsat + (Ata.TransList.print ~sep:"
") config1.Ata.todo) in - if states1 != states0 then set cache tree node states1; + if config0 != config1 then set cache tree node config1; let () = loop fc in let fcs1 = get cache tree fc in - let trans2, states2 = - Ata.eval_trans auto trans1 - fcs1 nss ps states1 + let config2 = + Ata.eval_trans auto + fcs1 nss ps config1 is_left is_right has_left has_right kind in let () = - TRACE(Html.trace (T.preorder tree node) _i "Left BU States: %a
Left BU Trans: %a
" StateSet.print states2 (Ata.TransList.print ~sep:"
") trans2) + TRACE( + let config2 = config2.Ata.node in + Html.trace (T.preorder tree node) _i "Config2
sat: %a
unsat: %a
todo: %a
" + StateSet.print config2.Ata.sat + StateSet.print config2.Ata.unsat + (Ata.TransList.print ~sep:"
") config2.Ata.todo) in - if states2 != states1 then set cache tree node states2; + + if config1 != config2 then set cache tree node config2; let () = loop ns in - let _trans3, states3 = - Ata.eval_trans auto trans2 - fcs1 (get cache tree ns) ps states2 + let config3 = + Ata.eval_trans auto + fcs1 (get cache tree ns) ps config2 is_left is_right has_left has_right kind in let () = - TRACE(Html.trace (T.preorder tree node) _i "Right BU States: %a
Right BU Trans: %a
" StateSet.print states3 (Ata.TransList.print ~sep:"
") _trans3) + TRACE( + let config3 = config3.Ata.node in + Html.trace (T.preorder tree node) _i "Config3
sat: %a
unsat: %a
todo: %a
" + StateSet.print config3.Ata.sat + StateSet.print config3.Ata.unsat + (Ata.TransList.print ~sep:"
") config3.Ata.todo) in - if states3 != states2 then set cache tree node states3; - (*if states0 != states3 && (not !redo) then redo := true *) - if (not !redo) - && not (Ata.TransList.nil == _trans3) - && (states1 != states3) - && not (StateSet.intersect states3 auto.Ata.selection_states) + if config2 != config3 then set cache tree node config3; + (* We do set the redo flat if : *) + if not ( + !redo (* already set *) + || (Ata.TransList.nil == config3.Ata.Config.node.Ata.todo) (* no more transition to check *) + || (config0 == config3) (* did not gain any new information *) + ) then redo := true end in @@ -113,7 +140,7 @@ END let acc0 = loop (T.next_sibling tree node) acc in let acc1 = loop (T.first_child tree node) acc0 in - if StateSet.intersect (get cache tree node) auto.Ata.selection_states then + if StateSet.intersect (get cache tree node).Ata.Config.node.Ata.sat auto.Ata.selection_states then node::acc1 else acc1 @@ -121,7 +148,11 @@ END loop node [] let eval auto tree node = - let cache = Cache.N1.create StateSet.empty in + let cache = Cache.N1.create + (Ata.Config.make { Ata.sat = StateSet.empty; + Ata.unsat = StateSet.empty; + Ata.todo = Ata.TransList.nil }) + in let redo = ref true in let iter = ref 0 in Ata.reset auto; @@ -132,7 +163,7 @@ END done; at_exit (fun () -> eprintf "INFO: %i iterations\n" !iter); let r = get_results auto tree node cache in - TRACE(Html.gen_trace (module T : Tree.Sig.S with type t = T.t) (tree)); + TRACE(Html.gen_trace (module T : Tree.S with type t = T.t) (tree)); r end