]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/applyTransformation.ml
Previous commit reverted, as explained in that log.
[helm.git] / helm / software / matita / applyTransformation.ml
index 9f5f5c311f7196441db3e6626416c86432766814..4015293a435907f7a24f29f20b5824fb14e05cc1 100644 (file)
@@ -66,9 +66,10 @@ let mml_of_cic_sequent metasenv sequent =
     (ids_to_terms,ids_to_father_ids,ids_to_hypotheses,ids_to_inner_sorts)))
 
 let nmml_of_cic_sequent metasenv subst sequent =
-  let content_sequent = NTermCicContent.nmap_sequent ~subst sequent in 
+  let content_sequent,ids_to_refs =
+   NTermCicContent.nmap_sequent ~subst sequent in 
   let pres_sequent = 
-   Sequent2pres.nsequent2pres subst content_sequent in
+   Sequent2pres.nsequent2pres ids_to_refs subst content_sequent in
   let xmlpres = mpres_document pres_sequent in
    Xml2Gdome.document_of_xml DomMisc.domImpl xmlpres
 
@@ -88,6 +89,13 @@ 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 nmml_of_cic_object obj =
+ let cobj,ids_to_nrefs = NTermCicContent.nmap_obj obj in 
+ let pres_sequent = Content2pres.ncontent2pres ~ids_to_nrefs cobj in
+ let xmlpres = mpres_document pres_sequent in
+  Xml2Gdome.document_of_xml DomMisc.domImpl xmlpres
+;;
+
 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)
@@ -111,8 +119,10 @@ let txt_of_cic_sequent_conclusion ~map_unicode_to_tex ~output_type size
   let t, ids_to_uris =
    TermAcicContent.ast_of_acic ~output_type 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
+  let t =
+   CicNotationPres.render ~lookup_uri:(CicNotationPres.lookup_uri 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 = 
@@ -169,9 +179,10 @@ let term2pres ~map_unicode_to_tex n ids_to_inner_sorts annterm =
    let ast, ids_to_uris = 
     TermAcicContent.ast_of_acic ~output_type:`Term ids_to_inner_sorts annterm in
    let bobj =
-      CicNotationPres.box_of_mpres (
-         CicNotationPres.render ~prec:90 ids_to_uris 
-            (TermContentPres.pp_ast ast)) in
+    CicNotationPres.box_of_mpres (
+     CicNotationPres.render ~prec:90
+      ~lookup_uri:(CicNotationPres.lookup_uri 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
@@ -185,8 +196,7 @@ let enable_notations = function
       CicNotation.set_active_notations []
 
 let txt_of_cic_object 
- ~map_unicode_to_tex ?skip_thm_and_qed ?skip_initial_lambdas
- n style ?flavour prefix obj 
+ ~map_unicode_to_tex ?skip_thm_and_qed ?skip_initial_lambdas n params obj 
 =
   let get_aobj obj = 
      try   
@@ -202,55 +212,72 @@ let txt_of_cic_object
              let msg = "txt_of_cic_object: " ^ Printexc.to_string e in
              failwith msg
   in
-  match style with
-     | G.Declarative      ->
-        let aobj, ids_to_inner_sorts, ids_to_inner_types = get_aobj obj in
-        let cobj = 
-          Acic2content.annobj2content 
-            ids_to_inner_sorts ids_to_inner_types aobj 
-        in
-        let bobj = 
-          Content2pres.content2pres 
-            ?skip_initial_lambdas ?skip_thm_and_qed ~ids_to_inner_sorts cobj 
-        in
-        remove_closed_substs (
-           BoxPp.render_to_string ~map_unicode_to_tex
-            (function _::x::_ -> x | _ -> assert false) n
-            (CicNotationPres.mpres_of_box bobj)
-        ^ "\n\n" )
-     | G.Procedural depth ->
-(*     
-        PO.debug := true;
-        PO.critical := false;
-       Acic2Procedural.tex_formatter := Some Format.std_formatter;     
-       let _ = ProceduralTeX.tex_of_obj Format.std_formatter obj in
+  if List.mem G.IPProcedural params then begin
+(*
+     PO.debug := true;     
+     PO.critical := false;
+     Acic2Procedural.tex_formatter := Some Format.std_formatter;       
+     let _ = ProceduralTeX.tex_of_obj Format.std_formatter obj in
 *)     
-       let obj, info = PO.optimize_obj obj in
+     let obj, info = PO.optimize_obj obj in
 (*     
-       let _ = ProceduralTeX.tex_of_obj Format.std_formatter obj in
+     let _ = ProceduralTeX.tex_of_obj Format.std_formatter obj in
 *)     
-        let aobj, ids_to_inner_sorts, ids_to_inner_types = get_aobj obj in
-        let term_pp = term2pres ~map_unicode_to_tex (n - 8) ids_to_inner_sorts in
-        let lazy_term_pp = term_pp in
-        let obj_pp = CicNotationPp.pp_obj term_pp in
-        let stm_pp =         
-          GrafiteAstPp.pp_statement
-              ~map_unicode_to_tex ~term_pp ~lazy_term_pp ~obj_pp
-        in
-       let aux = function
-          | G.Executable (_, G.Command (_, G.Obj (_, N.Inductive _))) as stm
-                -> 
-             enable_notations false;
-             let str = stm_pp stm in enable_notations true; str
+     let aobj, ids_to_inner_sorts, ids_to_inner_types = get_aobj obj in
+     let term_pp = term2pres ~map_unicode_to_tex (n - 8) ids_to_inner_sorts in
+     let lazy_term_pp = term_pp in
+     let obj_pp = CicNotationPp.pp_obj term_pp in
+     let stm_pp =            
+       GrafiteAstPp.pp_statement
+          ~map_unicode_to_tex ~term_pp ~lazy_term_pp ~obj_pp
+     in
+     let aux = function
+       | G.Executable (_, G.Command (_, G.Obj (_, N.Inductive _))) as stm
+             ->           
+          let hc = !Acic2content.hide_coercions in
+          if List.mem G.IPCoercions params then 
+             Acic2content.hide_coercions := false;
+          enable_notations false;
+          let str = stm_pp stm in 
+          enable_notations true;
+          Acic2content.hide_coercions := hc;
+          str
 (* FG: we disable notation for Inductive to avoid recursive notation *) 
-          | stm -> stm_pp stm 
-       in
-        let script = 
-           Acic2Procedural.procedural_of_acic_object 
-              ~ids_to_inner_sorts ~ids_to_inner_types ~info
-             ?depth ?flavour prefix aobj 
-  in
-        String.concat "" (List.map aux script) ^ "\n\n"
+       | G.Executable (_, G.Tactic _) as stm -> 
+          let hc = !Acic2content.hide_coercions in
+          Acic2content.hide_coercions := false;
+          let str = stm_pp stm in
+          Acic2content.hide_coercions := hc;
+           str
+(* FG: we show coercion because the reconstruction is not aware of them *)
+       | stm -> 
+          let hc = !Acic2content.hide_coercions in
+          if List.mem G.IPCoercions params then 
+             Acic2content.hide_coercions := false;
+          let str = stm_pp stm in
+          Acic2content.hide_coercions := hc;
+           str
+     in
+     let script = 
+        Acic2Procedural.procedural_of_acic_object 
+           ~ids_to_inner_sorts ~ids_to_inner_types ~info params aobj 
+     in
+     String.concat "" (List.map aux script) ^ "\n\n"
+  end else
+     let aobj, ids_to_inner_sorts, ids_to_inner_types = get_aobj obj in
+     let cobj = 
+       Acic2content.annobj2content ids_to_inner_sorts ids_to_inner_types aobj 
+     in
+     let bobj = 
+        Content2pres.content2pres 
+           ?skip_initial_lambdas ?skip_thm_and_qed ~ids_to_inner_sorts cobj 
+     in
+     remove_closed_substs (
+        BoxPp.render_to_string ~map_unicode_to_tex
+           (function _::x::_ -> x | _ -> assert false) n
+           (CicNotationPres.mpres_of_box bobj)
+        ^ "\n\n"
+     )
 
 let cic_prefix = Str.regexp_string "cic:/"
 let matita_prefix = Str.regexp_string "cic:/matita/"
@@ -264,10 +291,10 @@ let replacement (ok, u) (l, s, x, t) =
    if ok then ok, u else
    if Str.last_chars u l = s then true, Str.replace_first x t u else ok, u
 
-let discharge_uri style uri =
-   let template = match style with
-      | G.Declarative  -> "cic:/matita/declarative/"   
-      | G.Procedural _ -> "cic:/matita/procedural/"
+let discharge_uri params uri =
+   let template = 
+      if List.mem G.IPProcedural params then "cic:/matita/procedural/"
+      else "cic:/matita/declarative/"
    in
    let s = UM.string_of_uri uri in
    if Str.string_match matita_prefix s 0 then uri else
@@ -277,7 +304,7 @@ let discharge_uri style uri =
 
 let discharge_name s = s ^ "_discharged"
 
-let txt_of_inline_uri ~map_unicode_to_tex style ?flavour prefix suri =
+let txt_of_inline_uri ~map_unicode_to_tex params suri =
 (*   
    Ds.debug := true;
 *)
@@ -302,7 +329,7 @@ let txt_of_inline_uri ~map_unicode_to_tex style ?flavour prefix suri =
       try
 (* FG: for now the explicit variables must be discharged *)
         let do_it obj =
-          let r = txt_of_cic_object ~map_unicode_to_tex 78 style ?flavour prefix obj in
+          let r = txt_of_cic_object ~map_unicode_to_tex 78 params obj in
           Librarian.time_stamp "AT: END MAP  "; r
        in
        let obj, real = 
@@ -313,10 +340,10 @@ let txt_of_inline_uri ~map_unicode_to_tex style ?flavour prefix suri =
              Librarian.time_stamp "AT: DONE          ";
               obj, true
           end else
-             Ds.discharge_uri discharge_name (discharge_uri style) uri
+             Ds.discharge_uri discharge_name (discharge_uri params) uri
        in
        if real then do_it obj else
-       let newuri = discharge_uri style uri in
+       let newuri = discharge_uri params uri in
        let _lemmas = LS.add_obj ~pack_coercion_obj:CicRefine.pack_coercion_obj newuri obj in
        do_it obj
       with
@@ -330,7 +357,7 @@ let txt_of_inline_uri ~map_unicode_to_tex style ?flavour prefix suri =
    in
    String.concat "" (List.map map sorted_uris)
 
-let txt_of_inline_macro ~map_unicode_to_tex style ?flavour prefix name =
+let txt_of_inline_macro ~map_unicode_to_tex params name =
    let suri = 
       if Librarian.is_uri name then name else
       let include_paths = 
@@ -341,12 +368,12 @@ let txt_of_inline_macro ~map_unicode_to_tex style ?flavour prefix name =
       in
       baseuri ^ "/"
    in
-   txt_of_inline_uri ~map_unicode_to_tex style ?flavour prefix suri
+   txt_of_inline_uri ~map_unicode_to_tex params suri
 
 (****************************************************************************)
 (* procedural_txt_of_cic_term *)
 
-let procedural_txt_of_cic_term ~map_unicode_to_tex n ?depth context term =
+let procedural_txt_of_cic_term ~map_unicode_to_tex n params context term =
   let term, _info = PO.optimize_term context term in
   let annterm, ids_to_inner_sorts, ids_to_inner_types = 
      try Cic2acic.acic_term_of_cic_term context term
@@ -361,7 +388,7 @@ let procedural_txt_of_cic_term ~map_unicode_to_tex n ?depth context term =
      ~map_unicode_to_tex ~term_pp ~lazy_term_pp ~obj_pp in
   let script = 
      Acic2Procedural.procedural_of_acic_term 
-        ~ids_to_inner_sorts ~ids_to_inner_types ?depth "" context annterm 
+        ~ids_to_inner_sorts ~ids_to_inner_types params context annterm 
   in
   String.concat "" (List.map aux script)
 ;;