Add grammar related function to result sets.

diff --git a/src/nodeSet.ml b/src/nodeSet.ml
index e1f5476..ad3768b 100644 (file)
--- a/src/nodeSet.ml
+++ b/src/nodeSet.ml
@@ -1,11 +1,15 @@
 INCLUDE "debug.ml"
 INCLUDE "utils.ml"
 
+
 module type S =
   sig
     type t
     type elt = Tree.node
     val empty : t
+    val var : (int*State.t) -> t
+    val close : ((int*State.t), t) Hashtbl.t -> t -> t
+    val is_open : t -> bool
     val singleton : elt -> t
     val cons : elt -> t -> t
     val snoc : t -> elt -> t
@@ -21,6 +25,7 @@ module type S =
     val fold : ( elt -> 'a -> 'a) -> t -> 'a -> 'a
     val length : t -> int
     val serialize : string -> Tree.t -> t -> unit
+
   end
 
 module Count : S with type t = int =
@@ -29,6 +34,9 @@ module Count : S with type t = int =
     type elt = Tree.node
 
     let empty = 0
+    let var _ = empty
+    let is_open _ = false
+    let close _ x = x
     let singleton _ = 1
     let cons _ x = x+1
     let snoc x _ = x+1
@@ -63,7 +71,7 @@ module Mat : S with type t = Tree.node mat =
   struct
     type t = Tree.node mat
     type elt = Tree.node
-
+    let is_open _ = false
     let empty = { clist = Nil; length = 0 }
     let singleton e = { clist = Cons(e, Nil) ; length = 1 }
     let cons e l = { clist = Cons(e, l.clist); length = l.length + 1 }
@@ -74,19 +82,10 @@ module Mat : S with type t = Tree.node mat =
            { clist = Concat(l1.clist, l2.clist); length = ll1 + ll2 }
 
     let snoc l e = concat l (singleton e)
-(*
-    let _total = ref 0
-    let _empty = ref 0
-    let () = at_exit (fun () -> Printf.eprintf "Dummy concatenations: %i/%i\n%!" !_empty !_total)
-
-    let concat l1 l2 =
-      let l = concat l1 l2 in
-      if l.length == 0 then incr _empty;
-      incr _total;
-      l
-*)
     let concat3 l1 l2 l3 = concat l1 (concat l2 l3)
     let concat4 l1 l2 l3 l4 = concat (concat l1 l2) (concat l3 l4)
+    let var _ = empty
+    let close _ x = x
 
 
     let conscat e l1 l2 =
@@ -227,3 +226,94 @@ let rec debug_clist =
          (Obj.magic node)
 
 let debug l = debug_clist l.clist
+
+
+
+module Partial(N : S) : S =
+struct
+
+  type elt = Tree.node
+  type t = { env : ((int*State.t), t) Hashtbl.t;
+            elem : list;
+            opened : bool;
+          }
+  and list =
+    | Var of (int * State.t)
+    | Nil
+    | Cons of elt * list
+    | Concat of list * list
+    | Lambda of t
+
+  let dummy = Hashtbl.create 0
+  let empty = { env = dummy;
+               elem = Nil;
+               opened = false }
+  let is_open t = t.opened
+
+
+  let close h t =
+    {empty with elem =
+       Lambda { t with env = h; opened = false } }
+
+  let singleton i = { empty with elem = Cons(i, Nil) }
+  let cons e t = { t with elem = Cons(e, t.elem) }
+  let concat t1 t2 =
+    { t1 with elem = Concat (t1.elem, t2.elem) }
+
+  let snoc t e = concat t (singleton e)
+  let concat3 t1 t2 t3 = concat t1 (concat t2 t3)
+  let concat4 t1 t2 t3 t4 = concat (concat t1 t2) (concat t3 t4)
+  let conscat e t1 t2 = cons e (concat t1 t2)
+  let conscat3 e t1 t2 t3 = cons e (concat3 t1 t2 t3)
+  let conscat4 e t1 t2 t3 t4 = cons e (concat4 t1 t2 t3 t4)
+  let subtree_tags _ = failwith "not implemented"
+  let subtree_elements _ = failwith "not_implemented"
+
+  let iter f t =
+    let rec loop t =
+      loop_list t.env t.elem
+    and loop_list h = function
+      | Nil -> ()
+      | Var i -> loop (Hashtbl.find h i)
+      | Cons (e, l) -> f e; loop_list h l
+      | Concat (l1, l2) -> loop_list h l1; loop_list h l2
+      | Lambda t -> loop t
+    in
+    loop t
+
+  let fold f t acc =
+    let rec loop t acc =
+      loop_list t.env acc t.elem
+    and loop_list h acc = function
+      | Nil -> acc
+      | Var i -> loop (try Hashtbl.find h i with Not_found -> let a,b = i in Printf.eprintf "%i,%i not found\n%!" a b; empty) acc
+      | Cons (e, l) ->   loop_list h (f e acc) l
+      | Concat (l1, l2) -> loop_list h (loop_list h acc l1) l2
+      | Lambda t -> loop t acc
+    in
+    loop t acc
+
+
+  let rec dump t =
+    Hashtbl.iter (fun (i,j) t ->
+      Format.eprintf "%i, %a ->" i State.print j;
+      dump t;
+      Format.eprintf "----------------\n%!";
+    ) t.env;
+    dump_list t.elem
+  and dump_list  = function
+    | Nil -> ()
+    | Var (i,j) -> Format.eprintf "Var(%i, %a) " i State.print j;
+    | Cons (e, l) -> Format.eprintf "%i " (Node.to_int e); dump_list l
+    | Concat (l1, l2) -> dump_list l1 ; dump_list l2
+    | Lambda t -> dump t
+
+
+  let length t = fold (fun _ acc -> 1 + acc) t 0
+
+
+  let var i =
+    { empty with elem = Var i; opened = true }
+
+  let serialize _ = failwith "not implemented"
+end

diff --git a/src/nodeSet.mli b/src/nodeSet.mli
index a25189a..2417ede 100644 (file)
--- a/src/nodeSet.mli
+++ b/src/nodeSet.mli
@@ -1,8 +1,12 @@
+
 module type S =
   sig
     type t
     type elt = Tree.node
     val empty : t
+    val var : (int*State.t) -> t
+    val close : ((int*State.t), t) Hashtbl.t -> t -> t
+    val is_open : t -> bool
     val singleton : elt -> t
     val cons : elt -> t -> t
     val snoc : t -> elt -> t
@@ -18,6 +22,9 @@ module type S =
     val fold : ( elt -> 'a -> 'a) -> t -> 'a -> 'a
     val length : t -> int
     val serialize : string -> Tree.t -> t -> unit
+
+
+
   end
 
 module Count : S with type t = int
@@ -37,3 +44,5 @@ type 'a mat = { mutable clist : clist;
 module Mat : S with type t = Tree.node mat
 
 val debug : Tree.node mat -> unit
+
+module Partial(N : S) : S