src/tag.ml

   1 (******************************************************************************)
   2 (*  SXSI : XPath evaluator                                                    *)
   3 (*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
   4 (*  Copyright NICTA 2008                                                      *)
   5 (*  Distributed under the terms of the LGPL (see LICENCE)                     *)
   6 (******************************************************************************)
   7 (*  maybe utf8 string... *)
   8
   9
  10 type t = int
  11 external to_int : t -> int = "%identity"
  12 type operations = {
  13   tag :  string -> t;
  14   to_string : t -> string;
  15   translate :  t -> t
  16 }
  17
  18 type intern = {
  19  mutable tag_ : string -> t;
  20  mutable to_string_ : t ->string;
  21  mutable translate_ : t -> t
  22 }
  23
  24
  25
  26
  27
  28 let dummy_fun =function _ -> failwith "Tag.ml Uninitialized tag structure"
  29
  30 let ops = {
  31   tag_ = dummy_fun;
  32   to_string_ = dummy_fun;
  33   translate_ = dummy_fun
  34 }
  35
  36 let init p =
  37   ops.tag_ <- p.tag;
  38   ops.to_string_ <- p.to_string;
  39   ops.translate_ <- p.translate
  40
  41 let tag s = ops.tag_ s
  42 let to_string t = ops.to_string_ t
  43 let translate s = ops.translate_ s
  44
  45
  46
  47
  48 let nullt = ~-1
  49 let dummy = nullt
  50 (* Defined in XMLTree.cpp *)
  51 let document_node = 0
  52 let attribute = 1
  53 let pcdata = 2
  54 let attribute_data= 3
  55 let document_node_close = 4
  56 let attribute_close = 5
  57 let pcdata_close = 6
  58 let attribute_data_close= 7
  59
  60
  61 let compare = (-)
  62 let equal = (==)
  63
  64 let hash x = x
  65 (*
  66 let dump_tags () =
  67   Format.eprintf "Tags are:\n";
  68   let doc = get_pool() in
  69   let ntags = num_tags doc in
  70     for i = 0 to ntags - 1 do
  71       Format.eprintf "%i, -><%s/>\n%!" i (to_string i)
  72     done
  73 *)
  74
  75
  76 let print ppf t = Format.fprintf ppf "%s" (to_string t)
  77 (* Check internal invariants *)
  78 let check t =
  79   if (t != tag (to_string t))
  80   then failwith "module Tag: internal check failed"
  81
  82 let dump = print
  83
  84
  85
  86
  87
  88
  89
  90
  91
  92
  93
  94 (* To move *)
  95