X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fauto%2Feval.ml;fp=src%2Fauto%2Feval.ml;h=0000000000000000000000000000000000000000;hp=4a27fa5cd8ee931242f9b293cf7141213f79fccf;hb=b00bff88c7902e828804c06b7f9dc55222fdc84e;hpb=03b6a364e7240ca827585e7baff225a0aaa33bc6 diff --git a/src/auto/eval.ml b/src/auto/eval.ml deleted file mode 100644 index 4a27fa5..0000000 --- a/src/auto/eval.ml +++ /dev/null @@ -1,132 +0,0 @@ -(***********************************************************************) -(* *) -(* TAToo *) -(* *) -(* Kim Nguyen, LRI UMR8623 *) -(* Université Paris-Sud & CNRS *) -(* *) -(* Copyright 2010-2013 Université Paris-Sud and Centre National de la *) -(* Recherche Scientifique. All rights reserved. This file is *) -(* distributed under the terms of the GNU Lesser General Public *) -(* License, with the special exception on linking described in file *) -(* ../LICENSE. *) -(* *) -(***********************************************************************) - -(* - Time-stamp: -*) - -INCLUDE "utils.ml" -open Format -open Utils - -module Make (T : Tree.Sig.S) : - sig - val eval : Ata.t -> T.t -> T.node -> T.node list - end - = struct - - -IFDEF HTMLTRACE - THEN -DEFINE TRACE(e) = (e) - ELSE -DEFINE TRACE(e) = () -END - - - - type cache = StateSet.t Cache.N1.t - let get c t n = Cache.N1.find c (T.preorder t n) - - let set c t n v = Cache.N1.add c (T.preorder t n) v - - - let top_down_run auto tree node cache _i = - let redo = ref false in - let rec loop node = - if node != T.nil then begin - let parent = T.parent tree node in - 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 () = - TRACE(Html.trace (T.preorder tree node) _i "Pre States: %a
Pre Trans: %a
" - StateSet.print states0 (Ata.TransList.print ~sep:"
") trans0) - in - let ps = get cache tree parent in - let fcs = get cache tree fc in - let nss = get cache tree ns in - let is_left = node == T.first_child tree parent - and is_right = node == T.next_sibling tree parent - and has_left = fc != T.nil - 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 - 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) - in - if states1 != states0 then set cache tree node states1; - let () = loop fc in - let fcs1 = get cache tree fc in - let trans2, states2 = - Ata.eval_trans auto trans1 - fcs1 nss ps states1 - 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) - in - if states2 != states1 then set cache tree node states2; - let () = loop ns in - let _trans3, states3 = - Ata.eval_trans auto trans2 - fcs1 (get cache tree ns) ps states2 - 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) - in - if states3 != states2 then set cache tree node states3; - if states0 != states3 && (not !redo) then redo := true - end - in - loop node; - !redo - - let get_results auto tree node cache = - let rec loop node acc = - if node == T.nil then acc - else - 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 - node::acc1 - else - acc1 - in - loop node [] - - let eval auto tree node = - let cache = Cache.N1.create StateSet.empty in - let redo = ref true in - let iter = ref 0 in - Ata.reset auto; - while !redo do - redo := top_down_run auto tree node cache !iter; - incr iter; - done; - let r = get_results auto tree node cache in - TRACE(Html.gen_trace (module T : Tree.Sig.S with type t = T.t) (tree)); - r - -end