X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fformula.ml;h=c3c836b2d6c83ef782f992c7b843f173bf738fab;hb=64d7d77a886a9fb00d62156b6dd1a43487b30772;hp=f7eae8516083c264f88bad92af477ede121173ba;hpb=cba2938d929fd5119b1491686ddc224d5af618c6;p=tatoo.git diff --git a/src/formula.ml b/src/formula.ml index f7eae85..c3c836b 100644 --- a/src/formula.ml +++ b/src/formula.ml @@ -15,7 +15,7 @@ INCLUDE "utils.ml" open Format -type move = [ `Left | `Right ] +type move = [ `Left | `Right | `Self ] type 'hcons expr = | False | True | Or of 'hcons * 'hcons @@ -71,7 +71,32 @@ let prio f = | Atom _ -> 8 | And _ -> 6 | Or _ -> 1 - + +(* Begin Lucca Hirschi *) +let rec eval_form (q,qf,qn) f = match expr f with + | False -> false + | True -> true + | And(f1,f2) -> eval_form (q,qf,qn) f1 && eval_form (q,qf,qn) f2 + | Or(f1,f2) -> eval_form (q,qf,qn) f1 || eval_form (q,qf,qn) f2 + | Atom(dir, b, s) -> + let set = match dir with + |`Left -> qf | `Right -> qn | `Self -> q in + if b then StateSet.mem s set + else not (StateSet.mem s set) + +let rec infer_form sq sqf sqn f = match expr f with + | False -> false + | True -> true + | And(f1,f2) -> infer_form sq sqf sqn f1 && infer_form sq sqf sqn f2 + | Or(f1,f2) -> infer_form sq sqf sqn f1 || infer_form sq sqf sqn f2 + | Atom(dir, b, s) -> + let setq, setr = match dir with + | `Left -> sqf | `Right -> sqn | `Self -> sq in + (* WG: WE SUPPOSE THAT Q^r and Q^q are disjoint ! *) + let mem = StateSet.mem s setq || StateSet.mem s setr in + if b then mem else not mem +(* End *) + let rec print ?(parent=false) ppf f = if parent then fprintf ppf "("; let _ = match expr f with @@ -92,6 +117,7 @@ let rec print ?(parent=false) ppf f = match dir with | `Left -> Pretty.down_arrow, Pretty.subscript 1 | `Right -> Pretty.down_arrow, Pretty.subscript 2 + | `Self -> Pretty.down_arrow, Pretty.subscript 0 in fprintf fmt "%s%s" a_str d_str; State.print fmt s; @@ -122,6 +148,7 @@ let atom_ d p s = let ss = match d with | `Left -> si, StateSet.empty | `Right -> StateSet.empty, si + | `Self -> StateSet.empty, StateSet.empty (* TODO WHAT? *) in fst (cons (Atom(d,p,s)) (Atom(d,not p,s)) ss ss 1 1) let not_ f = f.Node.node.neg