ocaml 3.09 transition

[helm.git] / helm / ocaml / utf8_macros / make_table.ml

diff --git a/helm/ocaml/utf8_macros/make_table.ml b/helm/ocaml/utf8_macros/make_table.ml
index 2e3740943665fc5f4a734486efb9984f7f044226..68309b1c444afd531142bacdc519a8d6f621a2ae 100644 (file)
--- a/helm/ocaml/utf8_macros/make_table.ml
+++ b/helm/ocaml/utf8_macros/make_table.ml
@@ -24,11 +24,9 @@
  *)
 
 open Printf
-open Pxp_types
-open Pxp_ev_parser
 
 let debug = false
-let debug_print s = if debug then prerr_endline s
+let debug_print s = if debug then prerr_endline (Lazy.force s)
 
   (* source files for tables xml parsing (if unmarshall=false) *)
 let xml_tables = [
@@ -39,81 +37,63 @@ let xml_tables = [
   `Entities, "data/entities-table.xml";
   `Dictionary, "data/dictionary-tex.xml";
   `Entities, "data/extra-entities.xml";
+  (** extra-entities.xml should be the last one since it is used to override
+   * previous mappings. Add there overrides as needed. *)
 ]
 
-
-let rec find_first_tag pull_parser =
-  match pull_parser () with
-  | Some (E_start_tag _ as e) -> e
-  | None -> assert false
-  | _ -> find_first_tag pull_parser
-
-let iter_entities_file f pull_parser =
-  ignore (find_first_tag pull_parser); (* <entities-table> *)
-  let rec aux () =
-    match pull_parser () with
-    | Some (E_start_tag ("entity", attrs, _, _)) ->
-       (try
-         let name = List.assoc "name" attrs in
-         let value = List.assoc "value" attrs in
-         f name value
-       with Not_found -> ());
-       aux ()
-    | None -> ()
-    | _ -> aux ()
+let iter_gen record_tag name_field value_field f fname =
+  let start_element tag attrs =
+    if tag = record_tag then
+      try
+        let name = List.assoc name_field attrs in
+        let value = List.assoc value_field attrs in
+        f name value
+      with Not_found -> ()
   in
-  aux ()
+  let callbacks = {
+    XmlPushParser.default_callbacks with
+      XmlPushParser.start_element = Some start_element
+  } in
+  let xml_parser = XmlPushParser.create_parser callbacks in
+  XmlPushParser.parse xml_parser (`File fname)
 
-let iter_dictionary_file f pull_parser =
-  ignore (find_first_tag pull_parser); (* <dictionary> *)
-  let rec aux () =
-    match pull_parser () with
-    | Some (E_start_tag ("entry", attrs, _, _)) ->
-       (try
-         let name = List.assoc "name" attrs in
-         let value = List.assoc "val" attrs in
-         f name value
-       with Not_found -> ());
-       aux ()
-    | None -> ()
-    | _ -> aux ()
-  in
-  aux ()
+let iter_entities_file    = iter_gen "entity" "name" "value"
+let iter_dictionary_file  = iter_gen "entry" "name" "val"
 
 let parse_from_xml () =
   let (macro2utf8, utf82macro) = (Hashtbl.create 2000, Hashtbl.create 2000) in
   let add_macro macro utf8 =
-    debug_print (sprintf "Adding macro %s = '%s'" macro utf8);
-    Hashtbl.add macro2utf8 macro utf8;
-(*     Hashtbl.add utf82macro utf8 macro *)
+    debug_print (lazy (sprintf "Adding macro %s = '%s'" macro utf8));
+    Hashtbl.replace macro2utf8 macro utf8;
+    Hashtbl.replace utf82macro utf8 macro
   in
   let fill_table () =
     List.iter
       (fun (typ, fname) ->
-        let entry = `Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ] in
-        let config = PxpHelmConf.pxp_config in
-        let entity_manager =
-          create_entity_manager ~is_document:true config (from_file fname)
-        in
-        let pull_parser = create_pull_parser config entry entity_manager in
         match typ with
-        | `Entities -> iter_entities_file add_macro pull_parser
-        | `Dictionary -> iter_dictionary_file add_macro pull_parser)
+        | `Entities -> iter_entities_file add_macro fname
+        | `Dictionary -> iter_dictionary_file add_macro fname)
       xml_tables
   in
   fill_table ();
-  macro2utf8
+  macro2utf8, utf82macro
 
 let main () =
   let oc = open_out Sys.argv.(1) in
   output_string oc "(* GENERATED by make_table: DO NOT EDIT! *)\n";
   output_string oc "let macro2utf8 = Hashtbl.create 2000\n";
-  let macro2utf8 = parse_from_xml () in
+  output_string oc "let utf82macro = Hashtbl.create 2000\n";
+  let macro2utf8, utf82macro = parse_from_xml () in
   Hashtbl.iter
     (fun macro utf8 ->
-      fprintf oc "let _ = Hashtbl.add macro2utf8 \"%s\" \"%s\"\n"
+      fprintf oc "let _ = Hashtbl.replace macro2utf8 \"%s\" \"%s\"\n"
         macro (String.escaped utf8))
     macro2utf8;
+  Hashtbl.iter
+    (fun utf8 macro ->
+      fprintf oc "let _ = Hashtbl.replace utf82macro \"%s\" \"%s\"\n"
+        (String.escaped utf8) macro)
+    utf82macro;
   close_out oc
 
 let _ = main ()