]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/applyTransformation.ml
- hExtlib: new function "list_assoc_all"
[helm.git] / helm / software / matita / applyTransformation.ml
index 9f5f5c311f7196441db3e6626416c86432766814..2988af4211fa00143d85a84b2eeaa5de2424e545 100644 (file)
@@ -185,8 +185,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 +201,53 @@ 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
+             -> 
+          enable_notations false;
+          let str = stm_pp stm in enable_notations true; 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"
+       | stm -> stm_pp stm 
+     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 +261,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 +274,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 +299,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 +310,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 +327,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 +338,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 +358,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)
 ;;