X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftag.ml;h=2cc1663a0bc089e6fbbf84bcf01dac9f5b9ad3f9;hb=6df6ad6cf27e57872bd5891b49354acb0a5ce6a4;hp=ce1979c08cf540ee2159815399e878b8b9a4839c;hpb=124b3b4e8f440f8c996263127336377c9456e090;p=SXSI%2Fxpathcomp.git diff --git a/src/tag.ml b/src/tag.ml index ce1979c..2cc1663 100644 --- a/src/tag.ml +++ b/src/tag.ml @@ -8,26 +8,44 @@ type t = int -type pool type operations = { - tag : pool -> string -> t; - to_string : pool -> t ->string; - nullt : pool -> t; - translate : pool -> t -> t + tag : string -> t; + to_string : t ->string; + translate : t -> t } +type intern = { + mutable tag_ : string -> t; + mutable to_string_ : t ->string; + mutable translate_ : t -> t +} + + + + + let dummy_fun =function _ -> failwith "Tag.ml Uninitialized tag structure" +let ops = { + tag_ = dummy_fun; + to_string_ = dummy_fun; + translate_ = dummy_fun +} + +let init p = + ops.tag_ <- p.tag; + ops.to_string_ <- p.to_string; + ops.translate_ <- p.translate + +let tag s = ops.tag_ s +let to_string t = ops.to_string_ t +let translate s = ops.translate_ s -external null_pool : unit -> pool = "caml_xml_tree_nullt" -external null_tag : unit -> t = "caml_xml_tree_nullt" -external register_tag : pool -> string -> t = "caml_xml_tree_register_tag" -external tag_name : pool -> t -> string = "caml_xml_tree_get_tag_name" -external num_tags : pool -> int = "caml_xml_tree_num_tags" -let nullt = null_tag () + +let nullt = ~-1 let dummy = nullt (* Defined in XMLTree.cpp *) let document_node = 0 @@ -40,44 +58,11 @@ let pcdata_close = 6 let attribute_data_close= 7 -let pool = Weak.create 1 - -let init p = Weak.set pool 0 (Some p) - -let get_pool () = match Weak.get pool 0 with - | Some x -> x - | None -> failwith "Tag.ml: Uninitialized Document" - -let tag s = match s with - | "<$>" -> pcdata - | "<@>" -> attribute - | "" -> document_node - | "<@$>" -> attribute_data - | _ -> register_tag (get_pool()) s - let compare = (-) let equal = (==) let hash x = x - -let to_string t = - if t == pcdata then "<$>" - else if t == attribute_data then "<@$>" - else if t == attribute then "<@>" - else if t == nullt then "" - else tag_name (get_pool()) t - - -let xml_operations = { - tag = (fun _ x -> tag x); - to_string = (fun _ x -> to_string x); - nullt = (fun _ -> nullt); - translate = (fun _ x -> x); -} - - - - +(* let dump_tags () = Format.eprintf "Tags are:\n"; let doc = get_pool() in @@ -85,7 +70,7 @@ let dump_tags () = for i = 0 to ntags - 1 do Format.eprintf "%i, -><%s/>\n%!" i (to_string i) done - +*) let print ppf t = Format.fprintf ppf "%s" (to_string t) @@ -96,3 +81,15 @@ let check t = let dump = print + + + + + + + + + + +(* To move *) +