diff -Naur --text --exclude '*~' pxp-1.1.94.2/src/pxp-engine/pxp_document.ml pxp-1.1.94.2-alex/src/pxp-engine/pxp_document.ml --- pxp-1.1.94.2/src/pxp-engine/pxp_document.ml 2003-11-04 23:49:04.000000000 +0100 +++ pxp-1.1.94.2-alex/src/pxp-engine/pxp_document.ml 2004-02-28 08:24:56.000000000 +0100 @@ -1940,7 +1940,7 @@ | Implied_value -> raise Not_found with Not_found -> - failwith "Pxp_document, method required_string_attribute: not found" + failwith (Printf.sprintf "Pxp_document, method required_string_attribute %S: not found" n) method optional_string_attribute n = try @@ -1960,7 +1960,7 @@ | Implied_value -> raise Not_found with Not_found -> - failwith "Pxp_document, method required_list_attribute: not found" + failwith (Printf.sprintf "Pxp_document, method required_list_attribute %S: not found" n) method optional_list_attribute n = try diff -Naur --text --exclude '*~' pxp-1.1.94.2/src/pxp-engine/pxp_tree_parser.ml pxp-1.1.94.2-alex/src/pxp-engine/pxp_tree_parser.ml --- pxp-1.1.94.2/src/pxp-engine/pxp_tree_parser.ml 2003-11-04 23:49:05.000000000 +0100 +++ pxp-1.1.94.2-alex/src/pxp-engine/pxp_tree_parser.ml 2004-05-05 02:19:21.000000000 +0200 @@ -4,6 +4,11 @@ * Copyright by Gerd Stolpmann. See LICENSE for details. *) +(* Portions of this code are contributions made to Ocamlnet by Alex Baretta. + * Copyright is held by Baretta SRL DE&IT. Such code is released under the + * terms of the LICENSE convering the whole of Ocamlnet. + *) + open Pxp_types open Pxp_lexers open Pxp_lexer_types @@ -23,6 +28,13 @@ method find : string -> 'ext node end +(* reverse_index is a contribution to Ocamlnet made by Baretta SRL DE&IT *) +class type [ 'ext ] reverse_index = +object + inherit [ 'ext ] index + method ref_add : string -> 'ext node -> unit + method ref_find : string -> 'ext node list +end class [ 'ext ] hash_index = object @@ -40,6 +52,25 @@ method index = ht end +(* reverse_hash_index is a contribution to Ocamlnet made by Baretta SRL DE&IT *) +class [ 'ext ] reverse_hash_index = +object (self : 'ext #reverse_index ) + inherit [ 'ext ] hash_index + val ref_ht = (Hashtbl.create 100 : (string, 'ext node) Hashtbl.t) + method ref_add id referring_node = Hashtbl.add ref_ht id referring_node + method ref_find id = Hashtbl.find_all ref_ht id + method ref_index = ref_ht +end + +(* fake_reverse_hash_index is a contribution to Ocamlnet made by Baretta SRL DE&IT *) +class [ 'ext ] fake_reverse_index (index : 'ext #index) = +object (self : 'ext #reverse_index ) + (* DELEGATION WANTED, DEAD OR ALIVE! *) + method add = index # add + method find = index # find + method ref_add id referring_node = () + method ref_find id = [] +end class default_ext = object(self : 'self) @@ -93,7 +124,7 @@ val transform_dtd = transform_dtd (* A function transforming the DTD *) - val id_index = (id_index : 'ext index option) + val id_index = (id_index : 'ext reverse_index option) (* The ID index or None *) val doc = init_doc @@ -513,14 +544,14 @@ (fun att -> match t # attribute att with Value s -> - begin try ignore(id_index # find s) with + begin try ignore(id_index # find s); id_index # ref_add s t with Not_found -> error t att s end | Valuelist l -> List.iter (fun s -> - try ignore(id_index # find s) with + try ignore(id_index # find s); id_index # ref_add s t with Not_found -> error t att s ) @@ -544,7 +575,7 @@ ~document:doc ~specification:spec ~transform_dtd - ~(id_index : 'ext #index option) + ~(id_index : 'ext #reverse_index option) ~use_document_entity ~entry ~init_lexer = @@ -557,7 +588,7 @@ cfg spec transform_dtd - (id_index :> 'ext index option) + (id_index :> 'ext reverse_index option) in let mgr = new entity_manager en dtd in let gen_att_events = cfg.escape_attributes <> None in @@ -637,6 +668,7 @@ dtd # validate; (* ensure that the DTD is valid *) if cfg.accept_only_deterministic_models then dtd # only_deterministic_models; let doc = new document ?swarner:cfg.swarner cfg.warner cfg.encoding in + let idx = match id_index with None -> None | Some idx' -> Some(new fake_reverse_index idx') in let pobj = call_tree_parser ~configuration:cfg @@ -645,7 +677,32 @@ ~document:doc ~specification:spec ~transform_dtd:(fun x -> x) (* Do not transform the DTD *) - ~id_index:(id_index :> 'ext index option) + ~id_index:(idx :> 'ext reverse_index option) + ~use_document_entity:false + ~entry:(`Entry_content []) (* Entry point of the grammar *) + ~init_lexer:Content (* The initially used lexer *) + in + match pobj # root with + Some r -> r + | None -> raise(WF_error("No root element")) +;; + + +let parse_content_entity_with_reverse_index ~id_index cfg src dtd spec = + (* Parse an element given as separate entity *) + dtd # validate; (* ensure that the DTD is valid *) + if cfg.accept_only_deterministic_models then dtd # only_deterministic_models; + let doc = new document ?swarner:cfg.swarner cfg.warner cfg.encoding in + let idx = Some id_index in + let pobj = + call_tree_parser + ~configuration:cfg + ~source:src + ~dtd:dtd + ~document:doc + ~specification:spec + ~transform_dtd:(fun x -> x) (* Do not transform the DTD *) + ~id_index:(idx :> 'ext reverse_index option) ~use_document_entity:false ~entry:(`Entry_content []) (* Entry point of the grammar *) ~init_lexer:Content (* The initially used lexer *) @@ -722,7 +779,7 @@ dtd' # only_deterministic_models; dtd') - ~id_index:(id_index :> 'ext index option) + ~id_index:(id_index :> 'ext reverse_index option) ~use_document_entity:true ~entry:(`Entry_document entry_flags) (* Entry point of the grammar *) ~init_lexer:Document (* The initially used lexer *) @@ -734,10 +791,19 @@ let parse_document_entity ?(transform_dtd = (fun x -> x)) ?id_index cfg src spec = + let idx = match id_index with None -> None | Some idx' -> Some(new fake_reverse_index idx') in + iparse_document_entity + ~transform_dtd:transform_dtd + ?id_index:(idx : 'ext #reverse_index option :> 'ext reverse_index option) + cfg src spec false;; + +let parse_document_entity_with_reverse_index ?(transform_dtd = (fun x -> x)) + ~id_index + cfg src spec = iparse_document_entity ~transform_dtd:transform_dtd - ?id_index:(id_index : 'ext #index option :> 'ext index option) - cfg src spec false;; + ~id_index:(id_index : 'ext #reverse_index :> 'ext reverse_index) + {cfg with idref_pass = true} src spec false;; let parse_wfdocument_entity ?(transform_dtd = (fun x -> x)) cfg src spec = diff -Naur --text --exclude '*~' pxp-1.1.94.2/src/pxp-engine/pxp_tree_parser.mli pxp-1.1.94.2-alex/src/pxp-engine/pxp_tree_parser.mli --- pxp-1.1.94.2/src/pxp-engine/pxp_tree_parser.mli 2003-11-04 23:49:05.000000000 +0100 +++ pxp-1.1.94.2-alex/src/pxp-engine/pxp_tree_parser.mli 2004-05-05 02:31:45.000000000 +0200 @@ -4,6 +4,11 @@ * Copyright by Gerd Stolpmann. See LICENSE for details. *) +(* Portions of this code are contributions made to Ocamlnet by Alex Baretta. + * Copyright is held by Baretta SRL DE&IT. Such code is released under the + * terms of the LICENSE convering the whole of Ocamlnet. + *) + open Pxp_types open Pxp_dtd open Pxp_document @@ -18,6 +23,10 @@ *) constraint 'ext = 'ext node #extension method add : string -> 'ext node -> unit + (* index # add id referenced_node + * This method allows idref_pass to incrementally build the function + * mapping ID to the ID-defining nodes. + *) (* Add the passed node to the index. If there is already an ID with * the passed string value, the exception ID_not_unique should be * raised. (But the index is free also to accept several identical IDs.) @@ -26,7 +35,22 @@ (* Finds the node with the passed ID value, or raises Not_found *) end - +(* reverse_index is a contribution to Ocamlnet made by Baretta SRL DE&IT *) +class type [ 'ext ] reverse_index = +object + inherit [ 'ext ] index + method ref_add : string -> 'ext node -> unit + (* index # ref_add idref referring_node + * This method allows the idref_pass to incrementally build the inverse + * relation of the function mapping IDs to the ID-defining nodes. This + * function is useful to find all nodes referring to a given ID. + *) + method ref_find : string -> 'ext node list + (* index # ref_find id + * Returns the list of all nodes containing an IDREF + * refering to the given id. + *) +end class [ 'ext ] hash_index : object @@ -40,6 +64,17 @@ (* Returns the hash table. *) end +(* reverse_hash_index is a contribution to Ocamlnet made by Baretta SRL DE&IT *) +class [ 'ext ] reverse_hash_index : +object + inherit [ 'ext ] hash_index + method ref_add : string -> 'ext node -> unit + method ref_find : string -> 'ext node list + method ref_index : (string, 'ext node) Hashtbl.t +end + +class [ 'ext ] fake_reverse_index : 'ext #index -> [ 'ext ] reverse_index + val default_extension : ('a node extension) as 'a (* A "null" extension; an extension that does not extend the functionality *) @@ -71,6 +106,18 @@ * violations of the uniqueness of IDs. *) +(* parse_document_entity_with_reverse_index is a contribution + * to Ocamlnet made by Baretta SRL DE&IT. + *) +val parse_document_entity_with_reverse_index : + ?transform_dtd:(dtd -> dtd) -> + id_index:('ext reverse_index) -> + config -> source -> 'ext spec -> 'ext document + (* Like parse_document_entity except that the index object is required to be + * a reverse_index, although it might be a fake reverse_index. In any case, an + * idref_pass is done, even if config.idref_pass is false. + *) + val parse_wfdocument_entity : ?transform_dtd:(dtd -> dtd) -> config -> source -> 'ext spec -> 'ext document @@ -83,6 +130,9 @@ * declarations). *) +(* parse_document_entity_with_reverse_index is a contribution + * to Ocamlnet made by Baretta SRL DE&IT. + *) val parse_content_entity : ?id_index:('ext index) -> config -> source -> dtd -> 'ext spec -> 'ext node @@ -97,6 +147,14 @@ * violations of the uniqueness of IDs. *) +val parse_content_entity_with_reverse_index : + id_index:('ext reverse_index) -> + config -> source -> dtd -> 'ext spec -> 'ext node + (* Like parse_content_entity except that the index object is required to be + * a reverse_index, although it might be a fake reverse_index. In any case, an + * idref_pass is done, even if config.idref_pass is false. + *) + val parse_wfcontent_entity : config -> source -> 'ext spec -> 'ext node (* Parse a file representing a well-formed fragment of a document diff -Naur --text --exclude '*~' pxp-1.1.94.2/src/pxp-engine/pxp_yacc.ml pxp-1.1.94.2-alex/src/pxp-engine/pxp_yacc.ml --- pxp-1.1.94.2/src/pxp-engine/pxp_yacc.ml 2003-11-04 23:49:04.000000000 +0100 +++ pxp-1.1.94.2-alex/src/pxp-engine/pxp_yacc.ml 2004-05-05 02:32:55.000000000 +0200 @@ -68,8 +68,11 @@ exception ID_not_unique = Pxp_tree_parser.ID_not_unique class type [ 'ext ] index = [ 'ext ] Pxp_tree_parser.index +class type [ 'ext ] reverse_index = [ 'ext ] Pxp_tree_parser.reverse_index class [ 'ext ] hash_index = [ 'ext ] Pxp_tree_parser.hash_index +class [ 'ext ] reverse_hash_index = [ 'ext ] Pxp_tree_parser.reverse_hash_index +class [ 'ext ] fake_reverse_index = [ 'ext ] Pxp_tree_parser.fake_reverse_index let default_extension = Pxp_tree_parser.default_extension diff -Naur --text --exclude '*~' pxp-1.1.94.2/src/pxp-engine/pxp_yacc.mli pxp-1.1.94.2-alex/src/pxp-engine/pxp_yacc.mli --- pxp-1.1.94.2/src/pxp-engine/pxp_yacc.mli 2003-11-04 23:49:04.000000000 +0100 +++ pxp-1.1.94.2-alex/src/pxp-engine/pxp_yacc.mli 2004-05-05 02:34:17.000000000 +0200 @@ -111,8 +111,12 @@ (* now defined in Pxp_tree_parser *) class type [ 'ext ] index = [ 'ext ] Pxp_tree_parser.index +class type [ 'ext ] reverse_index = [ 'ext ] Pxp_tree_parser.reverse_index class [ 'ext ] hash_index : [ 'ext ] Pxp_tree_parser.hash_index +class [ 'ext ] reverse_hash_index : [ 'ext ] Pxp_tree_parser.reverse_hash_index +class [ 'ext ] fake_reverse_index : 'ext #index -> [ 'ext ] Pxp_tree_parser.fake_reverse_index + val default_extension : ('a node extension) as 'a (* now defined in Pxp_tree_parser *)