Add the node summary to the Tree interface.

[tatoo.git] / src / tree.ml

diff --git a/src/tree.ml b/src/tree.ml
index 525f8c7..a1cd6a1 100644 (file)
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -12,6 +12,7 @@
 (*  ../LICENSE.                                                        *)
 (*                                                                     *)
 (***********************************************************************)
+open Misc
 
 (** The different kind of XML nodes and utility functions *)
 
@@ -38,6 +39,45 @@ module NodeKind =
       k1 == Node || k2 == Node || k1 == k2
 end
 
+
+module NodeSummary =
+struct
+  (* Pack into an integer the result of the is_* and has_ predicates
+     for a given node *)
+  type t = int
+  let dummy = -1
+  (*
+    ...44443210
+    ...4444 -> kind
+    3 -> has_right
+    2 -> has_left
+    1 -> is_right
+    0 -> is_left
+  *)
+  let is_left (s : t) : bool =
+    s land 1 != 0
+
+  let is_right (s : t) : bool =
+    s land 0b10 != 0
+
+  let has_left (s : t) : bool =
+    s land 0b100 != 0
+
+  let has_right (s : t) : bool =
+    s land 0b1000 != 0
+
+  let kind (s : t) : NodeKind.t =
+    Obj.magic (s lsr 4)
+
+  let make is_left is_right has_left has_right kind =
+    (int_of_bool is_left) lor
+      ((int_of_bool is_right) lsl 1) lor
+      ((int_of_bool has_left) lsl 2) lor
+      ((int_of_bool has_right) lsl 3) lor
+      ((Obj.magic kind) lsl 4)
+end
+
+
 (** Signatures for trees *)
 
 exception Parse_error of string
@@ -104,6 +144,9 @@ sig
   val kind : t -> node -> NodeKind.t
   (** Returns the kind of the given node *)
 
+  val summary : t -> node -> NodeSummary.t
+  (** Returns the summary of the given node *)
+
   val preorder : t -> node -> int
   (** [preorder t n] returns the pre-order position of [n] in [t].
       [preodrder t (root t) == 0] and [preorder t nil < 0].
@@ -113,4 +156,5 @@ sig
   (** [by_preorder t i] returns the node with preorder [i]
   *)
   val print_node : Format.formatter -> node -> unit
+
 end