X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic%2FcicParser.ml;h=64ee58427b4bfb8c571b9e62f630e6425117010b;hb=c66e9d17eda5e5defcb363e42d891d2b407cf7c3;hp=38fe9e210c41787004f1f970000d88d938f121ec;hpb=04d38d22679cd02229503269c3d2c6704ad9d1f3;p=helm.git

diff --git a/helm/ocaml/cic/cicParser.ml b/helm/ocaml/cic/cicParser.ml
index 38fe9e210..64ee58427 100644
--- a/helm/ocaml/cic/cicParser.ml
+++ b/helm/ocaml/cic/cicParser.ml
@@ -36,49 +36,62 @@
 (*                                                                            *)
 (******************************************************************************)
 
-exception Warnings;;
+exception Getter_failure of string * string
+exception Parser_failure of string
 
-class warner =
-  object 
-    method warn w =
-      prerr_endline ("WARNING: " ^ w) ;
-      (raise Warnings : unit)
-  end
-;;
+  (** tries to recover from a parse error caused by the parsing of a getter
+  * error message (e.g. Key_not_found exception). Unfortunately we have to
+  * re-parse xml document to extract exception data *)
+let try_recover exn filename =
+  let rc = ref None in
+  (try
+    let entity_manager =
+      Pxp_ev_parser.create_entity_manager ~is_document:true
+        PxpHelmConf.pxp_config (Pxp_types.from_file filename)
+    in
+    let pull_parser =
+      Pxp_ev_parser.create_pull_parser PxpHelmConf.pxp_config
+        (`Entry_document []) entity_manager
+    in
+    let rec find_exn p =
+      match p () with
+      | None -> ()
+      | Some (Pxp_types.E_start_tag ("html", attrs, _, _)) ->
+          let exn = List.assoc "helm:exception" attrs in
+          let arg =
+            try List.assoc "helm:exception_arg" attrs with Not_found -> ""
+          in
+          rc := Some (Getter_failure (exn, arg))
+      | _ -> find_exn p
+    in
+    find_exn pull_parser
+  with _ -> raise (Parser_failure (Printexc.to_string exn)));
+  match !rc with
+  | None -> raise (Parser_failure (Printexc.to_string exn))
+  | Some exn -> raise exn
 
-exception EmptyUri of string;;
+let parse_document filename =
+  try
+    Pxp_tree_parser.parse_document_entity PxpHelmConf.pxp_config
+      (Pxp_types.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
+      CicParser3.domspec
+  with exn ->
+    raise (try_recover exn filename)
 
 (* given the filename of an xml file of a cic object it returns its internal *)
 (* representation.                                                           *)
 let annobj_of_xml filename filenamebody =
- let module Y = Pxp_yacc in
-  try 
-    let root, rootbody =
-     let config = {Y.default_config with Y.warner = new warner} in
-      let doc =
-       Y.parse_document_entity config
-        (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
-        CicParser3.domspec in
-      let docroot = doc#root in
-       match filenamebody with
-          None -> docroot,None
-        | Some filename ->
-           let docbody =
-            Y.parse_document_entity config
-             (Y.from_file ~alt:[PxpUrlResolver.url_resolver] filename)
-             CicParser3.domspec
-           in
-            docroot,Some docbody#root
-    in
-     CicParser2.get_term root rootbody
-  with
-   e ->
-     prerr_endline ("Filenames: " ^ filename ^
-      (match filenamebody with None -> "" | Some s -> ", " ^ s)) ;
-     prerr_endline ("Exception: " ^ Pxp_types.string_of_exn e) ;
-     raise e
-;;
+  let root, rootbody =
+    let doc = parse_document filename in
+    let docroot = doc#root in
+     match filenamebody with
+        None -> docroot,None
+      | Some filename ->
+         let docbody = parse_document filename in
+         docroot,Some docbody#root
+  in
+   CicParser2.get_term root rootbody
 
 let obj_of_xml filename filenamebody =
  Deannotate.deannotate_obj (annobj_of_xml filename filenamebody)
-;;
+