From: Kim Nguyễn Date: Wed, 13 Mar 2013 18:06:10 +0000 (+0100) Subject: Staturate the set of state of the current node to avoid some traversal. X-Git-Tag: v0.1~123 X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=4e07643b4289460ed0d166e915da745e02e5ec7e Staturate the set of state of the current node to avoid some traversal. --- diff --git a/src/auto/eval.ml b/src/auto/eval.ml index cc9ed71..19bcf6f 100644 --- a/src/auto/eval.ml +++ b/src/auto/eval.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) INCLUDE "utils.ml" @@ -77,27 +77,34 @@ module Make (T : Tree.Sig.S) : loop phi let eval_trans cache ltrs node_info fcs nss ps ss = - let i = (ltrs.Ata.TransList.id :> int) - and j = (node_info.NodeInfo.id :> int) + let j = (node_info.NodeInfo.id :> int) and k = (fcs.StateSet.id :> int) and l = (nss.StateSet.id :> int) - and m = (ps.StateSet.id :> int) + and m = (ps.StateSet.id :> int) in + let rec loop ltrs ss = + let i = (ltrs.Ata.TransList.id :> int) and n = (ss.StateSet.id :> int) in - let res = Cache.N6.find cache i j k l m n in - if res == Cache.N6.dummy cache then - let res = - Ata.TransList.fold (fun trs (acct, accs) -> - let q, _, phi = Ata.Transition.node trs in - if StateSet.mem q accs then (acct, accs) else - if eval_form phi node_info fcs nss ps accs then - (acct, StateSet.add q accs) - else - (Ata.TransList.cons trs acct, accs) - ) ltrs (Ata.TransList.nil, ss) - in - Cache.N6.add cache i j k l m n res; res - else - res + let (new_ltrs, new_ss) as res = + let res = Cache.N6.find cache i j k l m n in + if res == Cache.N6.dummy cache then + let res = + Ata.TransList.fold (fun trs (acct, accs) -> + let q, _, phi = Ata.Transition.node trs in + if StateSet.mem q accs then (acct, accs) else + if eval_form phi node_info fcs nss ps accs then + (acct, StateSet.add q accs) + else + (Ata.TransList.cons trs acct, accs) + ) ltrs (Ata.TransList.nil, ss) + in + Cache.N6.add cache i j k l m n res; res + else + res + in + if new_ss == ss then res else + loop new_ltrs new_ss + in + loop ltrs ss let top_down_run auto tree node cache _i = let redo = ref false in