Added toggle for enabling/disabling the conversion from multibyte unicode

[helm.git] / helm / software / matita / applyTransformation.ml

diff --git a/helm/software/matita/applyTransformation.ml b/helm/software/matita/applyTransformation.ml
index 83e5f3c18e42dd97a04222180ddb57f5bc1684a2..499c1705be978b97c7f9634ead475190e817e208 100644 (file)
--- a/helm/software/matita/applyTransformation.ml
+++ b/helm/software/matita/applyTransformation.ml
@@ -70,3 +70,125 @@ let mml_of_cic_object obj =
    (ids_to_terms, ids_to_father_ids, ids_to_conjectures, ids_to_hypotheses,
   ids_to_inner_sorts,ids_to_inner_types)))
 
+let txt_of_cic_sequent ?map_unicode_to_tex size metasenv sequent =
+  let unsh_sequent,(asequent,ids_to_terms,
+    ids_to_father_ids,ids_to_inner_sorts,ids_to_hypotheses)
+  =
+    Cic2acic.asequent_of_sequent metasenv sequent
+  in
+  let content_sequent = Acic2content.map_sequent asequent in 
+  let pres_sequent = 
+   CicNotationPres.mpres_of_box
+    (Sequent2pres.sequent2pres ~ids_to_inner_sorts content_sequent)
+  in
+  BoxPp.render_to_string ?map_unicode_to_tex
+    (function x::_ -> x | _ -> assert false) size pres_sequent
+
+let txt_of_cic_sequent_conclusion ?map_unicode_to_tex size metasenv sequent =
+  let _,(asequent,_,_,ids_to_inner_sorts,_) = 
+    Cic2acic.asequent_of_sequent metasenv sequent 
+  in
+  let _,_,_,t = Acic2content.map_sequent asequent in 
+  let t, ids_to_uris = TermAcicContent.ast_of_acic ids_to_inner_sorts t in
+  let t = TermContentPres.pp_ast t in
+  let t = CicNotationPres.render ids_to_uris t in
+  BoxPp.render_to_string ?map_unicode_to_tex
+    (function x::_ -> x | _ -> assert false) size t
+
+let txt_of_cic_term ?map_unicode_to_tex size metasenv context t = 
+  let fake_sequent = (-1,context,t) in
+  txt_of_cic_sequent_conclusion ?map_unicode_to_tex size metasenv fake_sequent 
+;;
+
+ignore (
+ CicMetaSubst.set_ppterm_in_context
+  (fun ~metasenv subst term context ->
+    try
+     let context' = CicMetaSubst.apply_subst_context subst context in
+     let term' = CicMetaSubst.apply_subst subst term in
+     let res = txt_of_cic_term 30 metasenv context' term' in
+      if String.contains res '\n' then
+       "\n" ^ res ^ "\n"
+      else
+       res
+    with
+       Sys.Break as exn -> raise exn
+     | exn ->
+        "[[ Exception raised during pretty-printing: " ^
+         (try
+           Printexc.to_string exn
+          with
+             Sys.Break as exn -> raise exn
+           | _ -> "<<exception raised pretty-printing the exception>>"
+         ) ^ " ]] " ^
+        (CicMetaSubst.use_low_level_ppterm_in_context := true;
+         try
+          let res =
+           CicMetaSubst.ppterm_in_context ~metasenv subst term context
+          in
+           CicMetaSubst.use_low_level_ppterm_in_context := false;
+           res
+         with
+          exc -> 
+           CicMetaSubst.use_low_level_ppterm_in_context := false;
+           raise exc))
+);;
+
+(****************************************************************************)
+(* txt_of_cic_object: IMPROVE ME *)
+
+let remove_closed_substs s =
+    Pcre.replace ~pat:"{...}" ~templ:"" s
+
+let term2pres ?map_unicode_to_tex n ids_to_inner_sorts annterm = 
+   let ast, ids_to_uris = 
+      TermAcicContent.ast_of_acic ids_to_inner_sorts annterm
+   in
+   let bobj =
+      CicNotationPres.box_of_mpres (
+         CicNotationPres.render ~prec:90 ids_to_uris 
+           (TermContentPres.pp_ast ast)
+      )
+   in
+   let render = function _::x::_ -> x | _ -> assert false in
+   let mpres = CicNotationPres.mpres_of_box bobj in
+   let s = BoxPp.render_to_string ?map_unicode_to_tex render n mpres in
+   remove_closed_substs s
+
+let txt_of_cic_object ?map_unicode_to_tex n style prefix obj =
+  let aobj,_,_,ids_to_inner_sorts,ids_to_inner_types,_,_ = 
+     try Cic2acic.acic_object_of_cic_object obj
+     with e -> 
+        let msg = "Cic2ACic: " ^ Printexc.to_string e in
+       failwith msg
+  in
+  match style with
+     | GrafiteAst.Declarative      ->
+        let cobj = Acic2content.annobj2content ids_to_inner_sorts ids_to_inner_types aobj in
+        let bobj = Content2pres.content2pres ids_to_inner_sorts cobj in
+        remove_closed_substs ("\n\n" ^
+          BoxPp.render_to_string ?map_unicode_to_tex
+            (function _::x::_ -> x | _ -> assert false) n
+            (CicNotationPres.mpres_of_box bobj)
+       )
+     | GrafiteAst.Procedural depth ->
+        let term_pp = term2pres (n - 8) ids_to_inner_sorts in
+        let lazy_term_pp = term_pp in
+        let obj_pp = CicNotationPp.pp_obj term_pp in
+        let aux = GrafiteAstPp.pp_statement ~term_pp ~lazy_term_pp ~obj_pp in
+        let script = Acic2Procedural.acic2procedural 
+          ~ids_to_inner_sorts ~ids_to_inner_types ?depth prefix aobj in
+       "\n\n" ^ String.concat "" (List.map aux script)
+
+let txt_of_inline_macro style suri prefix =
+   let dbd = LibraryDb.instance () in   
+   let sorted_uris = MetadataDeps.sorted_uris_of_baseuri ~dbd suri in
+   let map uri =
+      try txt_of_cic_object 78 style prefix (* FG: mi pare meglio 78 *)
+                            (fst (CicEnvironment.get_obj CicUniv.empty_ugraph uri))
+      with
+         | e -> 
+           Printf.sprintf "\n(* ERRORE IN STAMPA DI %s\nEXCEPTION: %s *)\n" 
+           (UriManager.string_of_uri uri) (Printexc.to_string e)
+   in
+   String.concat "\n\n" (List.map map sorted_uris)