]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaScript.ml
more on screenshot
[helm.git] / helm / software / matita / matitaScript.ml
index 7768e2287f27d5626262c3b6a7f583d2a272e3dc..21450e5e796e7d74c8f7549e156f079799e80646 100644 (file)
@@ -71,11 +71,9 @@ type guistuff = {
   ask_confirmation: title:string -> message:string -> [`YES | `NO | `CANCEL];
 }
 
-let eval_with_engine include_paths guistuff lexicon_status grafite_status user_goal
+let eval_with_engine include_paths guistuff grafite_status user_goal
  skipped_txt nonskipped_txt st
 =
-  let module TAPp = GrafiteAstPp in
-  let module DTE = DisambiguateTypes.Environment in
   let parsed_text_length =
     String.length skipped_txt + String.length nonskipped_txt 
   in
@@ -84,7 +82,7 @@ let eval_with_engine include_paths guistuff lexicon_status grafite_status user_g
   let enriched_history_fragment =
    MatitaEngine.eval_ast ~do_heavy_checks:(Helm_registry.get_bool
      "matita.do_heavy_checks")
-    lexicon_status grafite_status (text,prefix_len,st)
+    grafite_status (text,prefix_len,st)
   in
   let enriched_history_fragment = List.rev enriched_history_fragment in
   (* really fragile *)
@@ -105,7 +103,7 @@ let eval_with_engine include_paths guistuff lexicon_status grafite_status user_g
  * so that we can ensure the inclusion is performed after the included file 
  * is compiled (if needed). matitac does not need that, since it compiles files
  * in the good order, here files may be compiled on demand. *)
-let wrap_with_make include_paths (f : GrafiteParser.statement) x = 
+let wrap_with_make include_paths (f : #LexiconEngine.status GrafiteParser.statement) x = 
   try      
     f ~never_include:true ~include_paths x
   with
@@ -212,7 +210,7 @@ let cic2grafite context menv t =
       | Cic.Const _ as t -> 
           PT.Ident (pp_t c t, None)
       | Cic.Appl l -> PT.Appl (List.map (aux c) l)
-      | Cic.Implicit _ -> PT.Implicit
+      | Cic.Implicit _ -> PT.Implicit `JustOne
       | Cic.Lambda (Cic.Name n, s, t) ->
           PT.Binder (`Lambda, (PT.Ident (n,None), Some (aux c s)),
             aux (Some (Cic.Name n, Cic.Decl s)::c) t)
@@ -222,7 +220,7 @@ let cic2grafite context menv 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,ty))::c) t)
-      | Cic.Meta _ -> PT.Implicit
+      | Cic.Meta _ -> PT.Implicit `JustOne
       | Cic.Sort (Cic.Type u) -> PT.Sort (`Type u)
       | Cic.Sort Cic.Set -> PT.Sort `Set
       | Cic.Sort (Cic.CProp u) -> PT.Sort (`CProp u)
@@ -346,8 +344,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")
@@ -367,13 +365,31 @@ let cic2grafite context menv t =
   prerr_endline script;
   stupid_indenter script
 ;;
+let eval_nmacro include_paths (buffer : GText.buffer) guistuff grafite_status user_goal unparsed_text parsed_text script mac =
+  let parsed_text_length = String.length parsed_text in
+  match mac with
+  | TA.Screenshot (_,name) -> 
+       let status = script#grafite_status in
+       let _,_,menv,subst,_ = status#obj in
+       let sequent = List.hd menv in
+       let name = Filename.dirname (script#filename) ^ "/" ^ name in
+       guistuff.mathviewer#screenshot status sequent menv subst name;
+       [status, parsed_text], "", parsed_text_length
+  | TA.NCheck (_,t) ->
+      let status = script#grafite_status in
+      let ctx = [] in
+      let m, s, status, t = 
+        GrafiteDisambiguate.disambiguate_nterm 
+          None status [] [] ctx (parsed_text,parsed_text_length,
+            CicNotationPt.Cast (t,CicNotationPt.Implicit `JustOne))  
+          (* XXX use the metasenv, if possible *)
+      in
+      guistuff.mathviewer#show_entry (`NCic (t,ctx,m,s));
+      [], "", parsed_text_length
 
-let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status grafite_status user_goal unparsed_text parsed_text script mac =
-  let module TAPp = GrafiteAstPp in
+let rec eval_macro include_paths (buffer : GText.buffer) guistuff grafite_status user_goal unparsed_text parsed_text script mac =
   let module MQ = MetadataQuery in
-  let module MDB = LibraryDb in
   let module CTC = CicTypeChecker in
-  let module CU = CicUniv in
   (* no idea why ocaml wants this *)
   let parsed_text_length = String.length parsed_text in
   let dbd = LibraryDb.instance () in
@@ -449,7 +465,7 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
             let loc = HExtlib.floc_of_loc (0,text_len) in
             let statement = `Ast (GrafiteParser.LSome (ast loc),text) in
             let res,_,_parsed_text_len =
-             eval_statement include_paths buffer guistuff lexicon_status
+             eval_statement include_paths buffer guistuff 
               grafite_status user_goal script statement
             in
              (* we need to replace all the parsed_text *)
@@ -485,7 +501,7 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       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 ],"", 
+      [(grafite_status#set_proof_status No_proof), parsed_text ],"", 
         parsed_text_length 
   | TA.Check (_,term) ->
       let metasenv = GrafiteTypes.get_proof_metasenv grafite_status in
@@ -512,7 +528,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#automation_cache) 
+            proof_status
         in
         let proof_term = 
           let irl = 
@@ -548,7 +565,7 @@ 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 *)
@@ -559,7 +576,7 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
                 Helm_registry.get_bool "matita.paste_unicode_as_tex"
              in
              ApplyTransformation.procedural_txt_of_cic_term
-                 ~map_unicode_to_tex 78 cc proof_term
+                 ~map_unicode_to_tex 78 [] cc proof_term
         in
         let text = comment parsed_text ^ "\n" ^ proof_script ^ trailer in
         [],text,parsed_text_length
@@ -567,28 +584,25 @@ 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,flavour) ->
-       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 ?flavour prefix suri 
+          params suri 
        in
        [], str, String.length parsed_text
                                 
 and eval_executable include_paths (buffer : GText.buffer) guistuff
-lexicon_status grafite_status user_goal unparsed_text skipped_txt nonskipped_txt
+grafite_status user_goal unparsed_text skipped_txt nonskipped_txt
 script ex loc
 =
- let module TAPp = GrafiteAstPp in
- let module MD = MultiPassDisambiguator in
- let module ML = MatitaMisc in
   try
    ignore (buffer#move_mark (`NAME "beginning_of_statement")
     ~where:((buffer#get_iter_at_mark (`NAME "locked"))#forward_chars
        (Glib.Utf8.length skipped_txt))) ;
    eval_with_engine include_paths 
-    guistuff lexicon_status grafite_status user_goal skipped_txt nonskipped_txt
+    guistuff grafite_status user_goal skipped_txt nonskipped_txt
      (TA.Executable (loc, ex))
   with
      MatitaTypes.Cancel -> [], "", 0
@@ -598,22 +612,27 @@ script ex loc
           None -> []
         | Some n -> GrafiteTypes.get_proof_context grafite_status n in
       let grafite_status,macro = lazy_macro context in
-       eval_macro include_paths buffer guistuff lexicon_status grafite_status
+       eval_macro include_paths buffer guistuff grafite_status
         user_goal unparsed_text (skipped_txt ^ nonskipped_txt) script macro
+   | GrafiteEngine.NMacro (_loc,macro) ->
+       eval_nmacro include_paths buffer guistuff grafite_status
+        user_goal unparsed_text (skipped_txt ^ nonskipped_txt) script macro
+
 
-and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
+and eval_statement include_paths (buffer : GText.buffer) guistuff 
  grafite_status user_goal script statement
 =
-  let (lexicon_status,st), unparsed_text =
+  let (grafite_status,st), unparsed_text =
     match statement with
     | `Raw text ->
         if Pcre.pmatch ~rex:only_dust_RE text then raise Margin;
         let ast = 
          wrap_with_make include_paths
-          (GrafiteParser.parse_statement (Ulexing.from_utf8_string text)) lexicon_status 
+          (GrafiteParser.parse_statement (Ulexing.from_utf8_string text)) 
+            grafite_status
         in
           ast, text
-    | `Ast (st, text) -> (lexicon_status, st), text
+    | `Ast (st, text) -> (grafite_status, st), text
   in
   let text_of_loc floc = 
     let nonskipped_txt,_ = MatitaGtkMisc.utf8_parsed_text unparsed_text floc in
@@ -627,15 +646,24 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
   match st with
   | GrafiteParser.LNone loc ->
       let parsed_text, _, _, parsed_text_length = text_of_loc loc in
-       [(grafite_status,lexicon_status),parsed_text],"",
+       [grafite_status,parsed_text],"",
         parsed_text_length
+  | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) ->
+     let _, nonskipped, skipped, parsed_text_length = text_of_loc loc in
+      eval_executable include_paths buffer guistuff 
+       grafite_status user_goal unparsed_text skipped nonskipped script ex loc
+  | GrafiteParser.LSome (GrafiteAst.Comment (loc, GrafiteAst.Code (_, ex))) 
+    (*when Helm_registry.get_bool "matita.literate" *) ->
+     let _, nonskipped, skipped, parsed_text_length = text_of_loc loc in
+      eval_executable include_paths buffer guistuff 
+       grafite_status user_goal unparsed_text skipped nonskipped script ex loc
   | GrafiteParser.LSome (GrafiteAst.Comment (loc, _)) -> 
       let parsed_text, _, _, parsed_text_length = text_of_loc loc in
       let remain_len = String.length unparsed_text - parsed_text_length in
       let s = String.sub unparsed_text parsed_text_length remain_len in
       let s,text,len = 
        try
-        eval_statement include_paths buffer guistuff lexicon_status
+        eval_statement include_paths buffer guistuff 
          grafite_status user_goal script (`Raw s)
        with
           HExtlib.Localized (floc, exn) ->
@@ -651,12 +679,6 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
       | (statuses,text)::tl ->
          (statuses,parsed_text ^ text)::tl,"",parsed_text_length + len
       | [] -> [], "", 0)
-  | GrafiteParser.LSome (GrafiteAst.Executable (loc, ex)) ->
-     let _, nonskipped, skipped, parsed_text_length = 
-       text_of_loc loc 
-     in
-      eval_executable include_paths buffer guistuff lexicon_status
-       grafite_status user_goal unparsed_text skipped nonskipped script ex loc
   
 let fresh_script_id =
   let i = ref 0 in
@@ -672,11 +694,11 @@ let buffer = source_view#buffer in
 let source_buffer = source_view#source_buffer in
 let initial_statuses baseuri =
  let lexicon_status =
-   CicNotation2.load_notation ~include_paths:[]
+   CicNotation2.load_notation ~include_paths:[] (new LexiconEngine.status)
      BuildTimeConf.core_notation_script 
  in
- let grafite_status = GrafiteSync.init baseuri in
-  grafite_status,lexicon_status
+ let grafite_status = GrafiteSync.init lexicon_status baseuri in
+  grafite_status
 in
 let read_include_paths file =
  try 
@@ -765,8 +787,7 @@ object (self)
 
     (* history can't be empty, the invariant above grant that it contains at
      * least the init grafite_status *)
-  method grafite_status = match history with (s,_)::_ -> s | _ -> assert false
-  method lexicon_status = match history with (_,ss)::_ -> ss | _ -> assert false
+  method grafite_status = match history with s::_ -> s | _ -> assert false
 
   method private _advance ?statement () =
    let s = match statement with Some s -> s | None -> self#getFuture in
@@ -774,7 +795,7 @@ object (self)
    HLog.debug ("evaluating: " ^ first_line s ^ " ...");
    let entries, newtext, parsed_len = 
     try
-     eval_statement self#include_paths buffer guistuff self#lexicon_status
+     eval_statement self#include_paths buffer guistuff
       self#grafite_status userGoal self (`Raw s)
     with End_of_file -> raise Margin
    in
@@ -800,20 +821,20 @@ object (self)
    buffer#insert ~iter:(buffer#get_iter_at_mark (`MARK locked_mark)) newtext;
    (* here we need to set the Goal in case we are going to cursor (or to
       bottom) and we will face a macro *)
-   match self#grafite_status.proof_status with
+   match self#grafite_status#proof_status with
       Incomplete_proof p ->
        userGoal <-
          (try Some (Continuationals.Stack.find_goal p.stack)
          with Failure _ -> None)
     | _ -> userGoal <- None
 
-  method private _retract offset lexicon_status grafite_status new_statements
+  method private _retract offset grafite_status new_statements
    new_history
   =
-   let cur_grafite_status,cur_lexicon_status =
+   let cur_grafite_status =
     match history with s::_ -> s | [] -> assert false
    in
-    LexiconSync.time_travel ~present:cur_lexicon_status ~past:lexicon_status;
+    LexiconSync.time_travel ~present:cur_grafite_status ~past:grafite_status;
     GrafiteSync.time_travel ~present:cur_grafite_status ~past:grafite_status;
     statements <- new_statements;
     history <- new_history;
@@ -831,7 +852,7 @@ object (self)
 
   method retract () =
     try
-      let cmp,new_statements,new_history,(grafite_status,lexicon_status) =
+      let cmp,new_statements,new_history,grafite_status =
        match statements,history with
           stat::statements, _::(status::_ as history) ->
            assert (Glib.Utf8.validate stat);
@@ -839,7 +860,7 @@ object (self)
        | [],[_] -> raise Margin
        | _,_ -> assert false
       in
-       self#_retract cmp lexicon_status grafite_status new_statements
+       self#_retract cmp grafite_status new_statements
         new_history;
        self#notify
     with 
@@ -916,13 +937,12 @@ object (self)
 
   val mutable observers = []
 
-  method addObserver (o: LexiconEngine.status -> GrafiteTypes.status -> unit) =
+  method addObserver (o: GrafiteTypes.status -> unit) =
     observers <- o :: observers
 
   method private notify =
-    let lexicon_status = self#lexicon_status in
     let grafite_status = self#grafite_status in
-    List.iter (fun o -> o lexicon_status grafite_status) observers
+    List.iter (fun o -> o grafite_status) observers
 
   method loadFromString s =
     buffer#set_text s;
@@ -971,17 +991,17 @@ object (self)
       end
   
   method private goto_top =
-    let grafite_status,lexicon_status = 
+    let grafite_status = 
       let rec last x = function 
       | [] -> x
       | hd::tl -> last hd tl
       in
-      last (self#grafite_status,self#lexicon_status) history
+      last (self#grafite_status) history
     in
     (* FIXME: this is not correct since there is no undo for 
      * library_objects.set_default... *)
     GrafiteSync.time_travel ~present:self#grafite_status ~past:grafite_status;
-    LexiconSync.time_travel ~present:self#lexicon_status ~past:lexicon_status
+    LexiconSync.time_travel ~present:self#grafite_status ~past:grafite_status
 
   method private reset_buffer = 
     statements <- [];
@@ -1062,9 +1082,9 @@ object (self)
         in
         let rec back_until_cursor len = (* go backward until locked < cursor *)
          function
-            statements, ((grafite_status,lexicon_status)::_ as history)
+            statements, ((grafite_status)::_ as history)
             when len <= 0 ->
-             self#_retract (icmp - len) lexicon_status grafite_status statements
+             self#_retract (icmp - len) grafite_status statements
               history
           | statement::tl1, _::tl2 ->
              back_until_cursor (len - MatitaGtkMisc.utf8_string_length statement) (tl1,tl2)
@@ -1089,7 +1109,7 @@ object (self)
      HLog.error "The script is too big!\n"
   
   method onGoingProof () =
-    match self#grafite_status.proof_status with
+    match self#grafite_status#proof_status with
     | No_proof | Proof _ -> false
     | Incomplete_proof _ -> true
     | Intermediate _ -> assert false
@@ -1135,8 +1155,7 @@ object (self)
       | GrafiteParser.LNone _
       | GrafiteParser.LSome (GrafiteAst.Executable _) -> false
     in
-    try
-      is_there_only_comments self#lexicon_status self#getFuture
+    try is_there_only_comments self#grafite_status self#getFuture
     with 
     | LexiconEngine.IncludedFileNotCompiled _
     | HExtlib.Localized _