]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaScript.ml
Huge commit with several changes:
[helm.git] / helm / software / matita / matitaScript.ml
index 477e775d8dfe8cca961a6e892c042398db91a059..b221919d2e33a38433f3216bcb3498718541c06a 100644 (file)
@@ -76,7 +76,6 @@ let eval_with_engine include_paths guistuff lexicon_status grafite_status user_g
 =
   let module TAPp = GrafiteAstPp in
   let module DTE = DisambiguateTypes.Environment in
-  let module DP = DisambiguatePp in
   let parsed_text_length =
     String.length skipped_txt + String.length nonskipped_txt 
   in
@@ -94,8 +93,8 @@ let eval_with_engine include_paths guistuff lexicon_status grafite_status user_g
       (fun (acc, to_prepend) (status,alias) ->
        match alias with
        | None -> (status,to_prepend ^ nonskipped_txt)::acc,""
-       | Some (k,((v,_) as value)) ->
-            let newtxt = DP.pp_environment (DTE.add k value DTE.empty) in
+       | Some (k,value) ->
+            let newtxt = LexiconAstPp.pp_alias value in
             (status,to_prepend ^ newtxt ^ "\n")::acc, "")
       ([],skipped_txt) enriched_history_fragment
   in
@@ -118,28 +117,7 @@ let wrap_with_make include_paths (f : GrafiteParser.statement) x =
           HLog.error "please create it.";
           raise (Failure ("No root file for "^mafilename))
       in
-      let initial_lexicon_status = 
-        CicNotation2.load_notation ~include_paths:[] BuildTimeConf.core_notation_script 
-      in
-      let b,x = 
-        try
-          GrafiteSync.push ();
-          LexiconSync.time_travel ~present:x ~past:initial_lexicon_status;
-          let rc = MatitacLib.Make.make root [tgt] in 
-          GrafiteSync.pop ();
-          CicNotation.reset ();
-          ignore(CicNotation2.load_notation ~include_paths:[]
-            BuildTimeConf.core_notation_script);
-          let x = List.fold_left (fun s c -> LexiconEngine.eval_command s c)
-            initial_lexicon_status (List.rev
-            x.LexiconEngine.lexicon_content_rev) 
-          in
-          rc,x
-        with 
-        | exn ->
-            HLog.error ("Unexpected " ^ snd(MatitaExcPp.to_string exn));
-            assert false
-      in
+      let b = MatitacLib.Make.make root [tgt] in
       if b then 
         try f ~include_paths x with LexiconEngine.IncludedFileNotCompiled _ ->
          raise 
@@ -241,13 +219,13 @@ let cic2grafite context menv t =
       | Cic.Prod (Cic.Name n, s, t) ->
           PT.Binder (`Forall, (PT.Ident (n,None), Some (aux c s)),
             aux (Some (Cic.Name n, Cic.Decl s)::c) t)
-      | Cic.LetIn (Cic.Name n, s, t) ->
+      | Cic.LetIn (Cic.Name n, s, ty, t) ->
           PT.Binder (`Lambda, (PT.Ident (n,None), Some (aux c s)),
-            aux (Some (Cic.Name n, Cic.Def (s,None))::c) t)
+            aux (Some (Cic.Name n, Cic.Def (s,ty))::c) t)
       | Cic.Meta _ -> PT.Implicit
       | Cic.Sort (Cic.Type u) -> PT.Sort (`Type u)
       | Cic.Sort Cic.Set -> PT.Sort `Set
-      | Cic.Sort Cic.CProp -> PT.Sort `CProp
+      | Cic.Sort (Cic.CProp u) -> PT.Sort (`CProp u)
       | Cic.Sort Cic.Prop -> PT.Sort `Prop
       | _ as t -> PT.Ident ("ERROR: "^CicPp.ppterm t, None)
     in
@@ -368,8 +346,8 @@ let cic2grafite context menv t =
     let width = max_int in
     let term_pp content_term =
       let pres_term = TermContentPres.pp_ast content_term in
-      let dummy_tbl = Hashtbl.create 1 in
-      let markup = CicNotationPres.render dummy_tbl pres_term in
+      let lookup_uri = fun _ -> None in
+      let markup = CicNotationPres.render ~lookup_uri pres_term in
       let s = "(" ^ BoxPp.render_to_string
        ~map_unicode_to_tex:(Helm_registry.get_bool
          "matita.paste_unicode_as_tex")
@@ -399,33 +377,22 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
   (* no idea why ocaml wants this *)
   let parsed_text_length = String.length parsed_text in
   let dbd = LibraryDb.instance () in
-  let pp_macro = 
-    let f t = ProofEngineReduction.replace 
-      ~equality:(fun _ t -> match t with Cic.Meta _ -> true | _ -> false)
-      ~what:[()] ~with_what:[Cic.Implicit None] ~where:t
-    in
-    let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in
-    TAPp.pp_macro 
-      ~term_pp:(fun x -> 
-        ApplyTransformation.txt_of_cic_term max_int metasenv [] (f x)
-         ~map_unicode_to_tex:(Helm_registry.get_bool
-           "matita.paste_unicode_as_tex"))
-  in
+  let pp_macro = ApplyTransformation.txt_of_macro ~map_unicode_to_tex:true in
   match mac with
   (* WHELP's stuff *)
   | TA.WMatch (loc, term) -> 
      let l =  Whelp.match_term ~dbd term in
-     let entry = `Whelp (pp_macro mac, l) in
+     let entry = `Whelp (pp_macro [] [] mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
      [], "", parsed_text_length
   | TA.WInstance (loc, term) ->
      let l = Whelp.instance ~dbd term in
-     let entry = `Whelp (pp_macro mac, l) in
+     let entry = `Whelp (pp_macro [] [] mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
      [], "", parsed_text_length
   | TA.WLocate (loc, s) -> 
      let l = Whelp.locate ~dbd s in
-     let entry = `Whelp (pp_macro mac, l) in
+     let entry = `Whelp (pp_macro [] [] mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
      [], "", parsed_text_length
   | TA.WElim (loc, term) ->
@@ -435,14 +402,14 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
        | _ -> failwith "Not a MutInd"
      in
      let l = Whelp.elim ~dbd uri in
-     let entry = `Whelp (pp_macro mac, l) in
+     let entry = `Whelp (pp_macro [] [] mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
      [], "", parsed_text_length
   | TA.WHint (loc, term) ->
      let _subst = [] in
-     let s = ((None,[0,[],term], _subst, Cic.Meta (0,[]) ,term, []),0) in
+     let s = ((None,[0,[],term], _subst, lazy (Cic.Meta (0,[])) ,term, []),0) in
      let l = List.map fst (MQ.experimental_hint ~dbd s) in
-     let entry = `Whelp (pp_macro mac, l) in
+     let entry = `Whelp (pp_macro [] [] mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
      [], "", parsed_text_length
   (* REAL macro *)
@@ -457,7 +424,8 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       if rewrite then
         let l = MQ.equations_for_goal ~dbd proof_status in
         let l = List.filter (fun u -> not (LibraryObjects.in_eq_URIs u)) l in
-        let entry = `Whelp (pp_macro (TA.WHint(loc, Cic.Implicit None)), l) in
+        let entry = 
+          `Whelp (pp_macro [] [] (TA.WHint(loc, Cic.Implicit None)), l) in
         guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
         [], "", parsed_text_length
       else
@@ -493,6 +461,32 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
               fun u -> HLog.error (UriManager.string_of_uri u ^ "\n")
             ) selected;
             assert false)
+  | TA.Eval (_, kind, term) -> 
+      let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in
+      let context =
+       match user_goal with
+          None -> []
+        | Some n -> GrafiteTypes.get_proof_context grafite_status n in
+      let ty,_ = CTC.type_of_aux' metasenv context term CicUniv.empty_ugraph in
+      let term = 
+        match kind with
+        | `Normalize ->
+             CicReduction.normalize ~delta:true ~subst:[] context term
+        | `Simpl -> 
+            ProofEngineReduction.simpl context term
+        | `Unfold None ->
+            ProofEngineReduction.unfold ?what:None context term
+        | `Unfold (Some lazy_term) ->
+             let what, _, _ = 
+               lazy_term context metasenv CicUniv.empty_ugraph in
+             ProofEngineReduction.unfold ~what context term
+        | `Whd ->
+            CicReduction.whd ~delta:true ~subst:[] context term
+      in
+      let t_and_ty = Cic.Cast (term,ty) in
+      guistuff.mathviewer#show_entry (`Cic (t_and_ty,metasenv));
+      [({grafite_status with proof_status = No_proof},lexicon_status), parsed_text ],"", 
+        parsed_text_length 
   | TA.Check (_,term) ->
       let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in
       let context =
@@ -518,7 +512,8 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
         let (_,menv,subst,_,_,_), _ = 
           ProofEngineTypes.apply_tactic
             (Auto.auto_tac ~dbd ~params
-              ~universe:grafite_status.GrafiteTypes.universe) proof_status
+              ~automation_cache:grafite_status.GrafiteTypes.automation_cache) 
+            proof_status
         in
         let proof_term = 
           let irl = 
@@ -534,7 +529,7 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
             Auto.revision time size depth
         in
         let proof_script = 
-          if List.exists (fun (s,_) -> s = "paramodulation") params then
+          if List.exists (fun (s,_) -> s = "paramodulation") (snd params) then
               let proof_term, how_many_lambdas = 
                 Auto.lambda_close ~prefix_name:"orrible_hack_" 
                   proof_term menv cc 
@@ -554,32 +549,18 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
                   "matita.paste_unicode_as_tex")
                 ~skip_thm_and_qed:true
                 ~skip_initial_lambdas:how_many_lambdas
-                80 GrafiteAst.Declarative "" obj
+                80 [] obj
           else
             if true then
               (* use cic2grafite *)
               cic2grafite cc menv proof_term 
             else
               (* alternative using FG stuff *)
-              let proof_term, how_many_lambdas = 
-                Auto.lambda_close ~prefix_name:"orrible_hack_" 
-                  proof_term menv cc 
-              in
-              let ty,_ = 
-                CicTypeChecker.type_of_aux'
-                  menv [] proof_term CicUniv.empty_ugraph
-              in
-              let obj = 
-                Cic.Constant ("",Some proof_term, ty, [], [`Flavour `Lemma])
-              in
-                Pcre.qreplace ~templ:"?" ~pat:"orrible_hack_[0-9]+"
-                 (strip_comments
-                  (ApplyTransformation.txt_of_cic_object
-                    ~map_unicode_to_tex:(Helm_registry.get_bool
-                      "matita.paste_unicode_as_tex")
-                    ~skip_thm_and_qed:true
-                    ~skip_initial_lambdas:how_many_lambdas
-                    80 (GrafiteAst.Procedural None) "" obj)) 
+              let map_unicode_to_tex =
+                Helm_registry.get_bool "matita.paste_unicode_as_tex"
+             in
+             ApplyTransformation.procedural_txt_of_cic_term
+                 ~map_unicode_to_tex 78 [] cc proof_term
         in
         let text = comment parsed_text ^ "\n" ^ proof_script ^ trailer in
         [],text,parsed_text_length
@@ -587,12 +568,12 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
         ProofEngineTypes.Fail _ as exn -> 
           raise exn
           (* [], comment parsed_text ^ "\nfail.\n", parsed_text_length *))
-  | TA.Inline (_,style,suri,prefix) ->
-       let str = 
+  | TA.Inline (_, suri, params) ->
+       let str = "\n\n" ^ 
          ApplyTransformation.txt_of_inline_macro
           ~map_unicode_to_tex:(Helm_registry.get_bool
             "matita.paste_unicode_as_tex")
-          style suri prefix 
+          params suri 
        in
        [], str, String.length parsed_text
                                 
@@ -601,7 +582,7 @@ lexicon_status grafite_status user_goal unparsed_text skipped_txt nonskipped_txt
 script ex loc
 =
  let module TAPp = GrafiteAstPp in
- let module MD = GrafiteDisambiguator in
+ let module MD = MultiPassDisambiguator in
  let module ML = MatitaMisc in
   try
    ignore (buffer#move_mark (`NAME "beginning_of_statement")
@@ -661,9 +642,9 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
           HExtlib.Localized (floc, exn) ->
            HExtlib.raise_localized_exception 
              ~offset:(MatitaGtkMisc.utf8_string_length parsed_text) floc exn
-        | GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
+        | MultiPassDisambiguator.DisambiguationError (offset,errorll) ->
            raise
-            (GrafiteDisambiguator.DisambiguationError
+            (MultiPassDisambiguator.DisambiguationError
               (offset+parsed_text_length, errorll))
       in
       assert (text=""); (* no macros inside comments, please! *)
@@ -695,7 +676,7 @@ let initial_statuses baseuri =
    CicNotation2.load_notation ~include_paths:[]
      BuildTimeConf.core_notation_script 
  in
- let grafite_status = GrafiteSync.init baseuri in
+ let grafite_status = GrafiteSync.init lexicon_status baseuri in
   grafite_status,lexicon_status
 in
 let read_include_paths file =
@@ -868,9 +849,43 @@ object (self)
     | exc -> self#notify; raise exc
 
   method private getFuture =
-    buffer#get_text ~start:(buffer#get_iter_at_mark (`MARK locked_mark))
-      ~stop:buffer#end_iter ()
+    let lock = buffer#get_iter_at_mark (`MARK locked_mark) in
+    let text = buffer#get_text ~start:lock ~stop:buffer#end_iter () in
+    text
 
+  method expandAllVirtuals =
+    let lock = buffer#get_iter_at_mark (`MARK locked_mark) in
+    let text = buffer#get_text ~start:lock ~stop:buffer#end_iter () in
+    buffer#delete ~start:lock ~stop:buffer#end_iter;
+    let text = Pcre.replace ~pat:":=" ~templ:"\\def" text in
+    let text = Pcre.replace ~pat:"->" ~templ:"\\to" text in
+    let text = Pcre.replace ~pat:"=>" ~templ:"\\Rightarrow" text in
+    let text = 
+      Pcre.substitute_substrings 
+        ~subst:(fun str -> 
+           let pristine = Pcre.get_substring str 0 in
+           let input = 
+             if pristine.[0] = ' ' then
+               String.sub pristine 1 (String.length pristine -1) 
+             else pristine 
+           in
+           let input = 
+             if input.[String.length input-1] = ' ' then
+               String.sub input 0 (String.length input -1) 
+             else input
+           in
+           let before, after =  
+             if input = "\\forall" || 
+                input = "\\lambda" || 
+                input = "\\exists" then "","" else " ", " " 
+           in
+           try 
+             before ^ Glib.Utf8.from_unichar 
+               (snd (Virtuals.symbol_of_virtual input)) ^ after
+           with Virtuals.Not_a_virtual -> pristine) 
+        ~pat:" ?\\\\[a-zA-Z]+ ?" text
+    in
+    buffer#insert ~iter:lock text
       
   (** @param rel_offset relative offset from current position of locked_mark *)
   method private moveMark rel_offset =
@@ -1115,7 +1130,6 @@ object (self)
           let _,parsed_text_length = MatitaGtkMisc.utf8_parsed_text s loc in
           (* CSC: why +1 in the following lines ???? *)
           let parsed_text_length = parsed_text_length + 1 in
-prerr_endline ("## " ^ string_of_int parsed_text_length);
           let remain_len = String.length s - parsed_text_length in
           let next = String.sub s parsed_text_length remain_len in
           is_there_only_comments lexicon_status next