X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Fpxp%2Fpxp%2Fcompatibility%2Fmarkup_yacc.ml;fp=helm%2FDEVEL%2Fpxp%2Fpxp%2Fcompatibility%2Fmarkup_yacc.ml;h=26c40de18f4ef18e76fd0ff1510ec8d7c3c0b1ee;hb=c03d2c1fdab8d228cb88aaba5ca0f556318bebc5;hp=0000000000000000000000000000000000000000;hpb=758057e85325f94cd88583feb1fdf6b038e35055;p=helm.git diff --git a/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml b/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml new file mode 100644 index 000000000..26c40de18 --- /dev/null +++ b/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml @@ -0,0 +1,245 @@ +(* $Id$ + * ---------------------------------------------------------------------- + *) + +open Markup_types +open Markup_dtd +open Markup_document + +type config = + { warner : collect_warnings; + errors_with_line_numbers : bool; + processing_instructions_inline : bool; + virtual_root : bool; + debugging_mode : bool; + } + + +type source = + Entity of ((dtd -> Pxp_entity.entity) * Markup_reader.resolver) + | Channel of in_channel + | File of string + | Latin1 of string + | ExtID of (ext_id * Markup_reader.resolver) + +type 'ext domspec = + { map : (node_type, 'ext node) Hashtbl.t; + default_element : 'ext node; + } + + +class default_ext = + object(self) + val mutable node = (None : ('a extension node as 'a) option) + method clone = {< >} + method node = + match node with + None -> + assert false + | Some n -> n + method set_node n = + node <- Some n + end +;; + + +let default_extension = new default_ext;; + +let default_config = + { warner = new collect_warnings; + errors_with_line_numbers = true; + processing_instructions_inline = false; + virtual_root = false; + debugging_mode = false; + } + + +let default_dom = + let d = Hashtbl.create 2 in + Hashtbl.add d T_data (new data_impl default_extension ""); + { map = d; + default_element = new element_impl default_extension + } +;; + + +let pxp_config cfg = + { Pxp_yacc.default_config with + Pxp_yacc.warner = (cfg.warner :> Pxp_types.collect_warnings); + Pxp_yacc.errors_with_line_numbers = cfg.errors_with_line_numbers; + Pxp_yacc.enable_pinstr_nodes = cfg.processing_instructions_inline; + Pxp_yacc.enable_super_root_node = cfg.virtual_root; + Pxp_yacc.encoding = `Enc_iso88591; + Pxp_yacc.recognize_standalone_declaration = false; + Pxp_yacc.debugging_mode = cfg.debugging_mode; + } +;; + + +class pxp_resolver r = + object (self) + val markup_resolver = r + + method init_rep_encoding enc = + assert (enc = `Enc_iso88591 ) + + method init_warner w = + () + + method rep_encoding = `Enc_iso88591 + + method open_in xid = + markup_resolver # open_in xid + + method close_in = + markup_resolver # close_in + + method close_all = + markup_resolver # close_in + + method change_encoding enc = + markup_resolver # change_encoding enc + + method clone = + ( {< markup_resolver = markup_resolver # clone >} + : #Pxp_reader.resolver :> Pxp_reader.resolver ) + end +;; + + +let pxp_source src = + match src with + Entity (mkent, res) -> Pxp_yacc.Entity(mkent, new pxp_resolver res) + | ExtID (id, res) -> Pxp_yacc.ExtID(id, new pxp_resolver res) + | Channel ch -> Pxp_yacc.from_channel + ~system_encoding:`Enc_iso88591 ch + | File f -> Pxp_yacc.from_file + ~system_encoding:`Enc_iso88591 f + | Latin1 s -> Pxp_yacc.from_string ~fixenc:`Enc_iso88591 s +;; + + +let pxp_dom dom = + let dex = + try Hashtbl.find dom.map T_data + with Not_found -> assert false + in + let eex = dom.default_element in + let m = Hashtbl.create 100 in + Hashtbl.iter + (fun nt ex -> + match nt with + T_element name when name <> "-vr" && name <> "-pi" -> + let pxp_ex = ex # pxp_node in + Hashtbl.add m name pxp_ex + | _ -> () + ) + dom.map; + let srex = + try + Some ((Hashtbl.find dom.map (T_element "-vr")) # pxp_node) + with + Not_found -> None + in + let piex = + try + Some ((Hashtbl.find dom.map (T_element "-pi")) # pxp_node) + with + Not_found -> None + in + Pxp_document.make_spec_from_mapping + ?super_root_exemplar:srex + ?default_pinstr_exemplar:piex + ~data_exemplar:(dex # pxp_node) + ~default_element_exemplar:(eex # pxp_node) + ~element_mapping:m + () +;; + + +let markup_document w index doc = + let mdoc = new document w in + mdoc # init_xml_version (doc # xml_version); + mdoc # init_xml_standalone (doc # xml_standalone); + let r = doc # root # extension in + r # set_index index; + mdoc # init_root (r # markup_node); + List.iter + (fun piname -> + let l = doc # pinstr piname in + List.iter + (fun pi -> mdoc # add_pinstr pi) + l) + (doc # pinstr_names); + mdoc +;; + + + +let parse_dtd_entity cfg src = + Pxp_yacc.parse_dtd_entity + (pxp_config cfg) + (pxp_source src) +;; + + +let parse_document_entity cfg src dom = + let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in + markup_document + cfg.warner + index + (Pxp_yacc.parse_document_entity + ~id_index:index + (pxp_config cfg) + (pxp_source src) + (pxp_dom dom)) +;; + + +let parse_content_entity cfg src dtd dom = + let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in + let n = + (Pxp_yacc.parse_content_entity + ~id_index:index + (pxp_config cfg) + (pxp_source src) + dtd + (pxp_dom dom)) # extension in + n # set_index index; + n # markup_node +;; + + +let parse_wf_entity cfg src dom = + let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in + (* Restriction: index is not filled! *) + markup_document + cfg.warner + index + (Pxp_yacc.parse_wfdocument_entity + (pxp_config cfg) + (pxp_source src) + (pxp_dom dom)) +;; + + +(* ====================================================================== + * History: + * + * $Log$ + * Revision 1.1 2000/11/17 09:57:30 lpadovan + * Initial revision + * + * Revision 1.4 2000/08/18 20:19:16 gerd + * Updates in the emulation because of PXP changes. + * + * Revision 1.3 2000/07/14 21:35:35 gerd + * Updated because of the simplification of Pxp_types.collect_warnings. + * + * Revision 1.2 2000/07/08 17:40:50 gerd + * Updated the simulation. + * + * Revision 1.1 2000/05/29 23:43:51 gerd + * Initial compatibility revision. + * + *)