X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fformula.ml;h=f4022f91e6346bdf3c43412c186a8e4dada91fb5;hb=6b66008811639324be623a42037b60e02056772c;hp=4c58e3cc531dc501f811cd93357837711996ed08;hpb=9b75e9a2074c357fc2c823156451209d2a4cef8b;p=tatoo.git diff --git a/src/formula.ml b/src/formula.ml index 4c58e3c..f4022f9 100644 --- a/src/formula.ml +++ b/src/formula.ml @@ -5,24 +5,30 @@ (* Kim Nguyen, LRI UMR8623 *) (* Université Paris-Sud & CNRS *) (* *) -(* Copyright 2010-2012 Université Paris-Sud and Centre National de la *) +(* 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 + + type move = [ `Left | `Right | `Epsilon | `Up1 | `Up2 ] type 'formula expr = | False | True | Or of 'formula * 'formula | And of 'formula * 'formula - | Move of (move * bool * State.t) - | Label of QNameSet.t + | Atom of move * bool * State.t type 'hcons node = { pos : 'hcons expr; @@ -37,13 +43,12 @@ module rec Node : Hcons.S and Data : Hashtbl.HashedType with type t = Node.t node = struct type t = Node.t node - let equal x y = (*x.size == y.size &&*) + let equal x y = match x.pos, y.pos with | a,b when a == b -> true | Or(xf1, xf2), Or(yf1, yf2) | And(xf1, xf2), And(yf1,yf2) -> (xf1 == yf1) && (xf2 == yf2) | Move(d1, p1, s1), Move(d2 ,p2 ,s2) -> d1 == d2 && p1 == p2 && s1 == s2 - | Label s1, Label s2 -> s1 == s2 | _ -> false let hash f = @@ -56,7 +61,6 @@ module rec Node : Hcons.S HASHINT3(PRIME3, Uid.to_int f1.Node.id, Uid.to_int f2.Node.id) | Move(d, p, s) -> HASHINT4(PRIME5, hash_const_variant d,vb p,s) - | Label s -> HASHINT2(PRIME7, Uid.to_int s.QNameSet.id) end type t = Node.t @@ -64,14 +68,12 @@ let hash x = x.Node.hash let uid x = x.Node.id let equal = Node.equal let expr f = f.Node.node.pos -(*let st f = f.Node.node.st*) -(*let size f = f.Node.node.size*) + let compare f1 f2 = compare f1.Node.id f2.Node.id let prio f = match expr f with | True | False -> 10 | Move _ -> 8 - | Label _ -> 7 | And _ -> 6 | Or _ -> 1 @@ -88,7 +90,6 @@ let rec print ?(parent=false) ppf f = (print ppf f1); fprintf ppf " %s " Pretty.vee; (print ppf f2); - | Label s -> fprintf ppf "%a" QNameSet.print s | Move(dir, b, s) -> let _ = flush_str_formatter() in let fmt = str_formatter in @@ -155,12 +156,3 @@ let and_ f1 f2 = let of_bool = function true -> true_ | false -> false_ - -module Infix = struct - let ( +| ) f1 f2 = or_ f1 f2 - - let ( *& ) f1 f2 = and_ f1 f2 - - let ( *+ ) d s = atom_ d true s - let ( *- ) d s = atom_ d false s -end