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=0000000000000000000000000000000000000000;hb=c7514aaa249a96c5fdd39b1123fbdb38d92f20b6;hp=26c40de18f4ef18e76fd0ff1510ec8d7c3c0b1ee;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git diff --git a/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml b/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml deleted file mode 100644 index 26c40de18..000000000 --- a/helm/DEVEL/pxp/pxp/compatibility/markup_yacc.ml +++ /dev/null @@ -1,245 +0,0 @@ -(* $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. - * - *)