]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/matita/matitaScript.ml
some improvements
[helm.git] / helm / software / matita / matitaScript.ml
index 62d760c3b993b365b01b133b362855b3a3b20324..9eb1dbf69c608c9ba231d4e46f45f3ae78fb1f18 100644 (file)
@@ -60,14 +60,6 @@ let first_line s =
     String.sub s 0 nl_pos
   with Not_found -> s
 
-  (** creates a statement AST for the Goal tactic, e.g. "goal 7" *)
-let goal_ast n =
-  let module A = GrafiteAst in
-  let loc = HExtlib.dummy_floc in
-  A.Executable (loc, A.Tactical (loc,
-    A.Tactic (loc, A.Goal (loc, n)),
-    Some (A.Dot loc)))
-
 type guistuff = {
   mathviewer:MatitaTypes.mathViewer;
   urichooser: UriManager.uri list -> UriManager.uri list;
@@ -85,9 +77,11 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
   let parsed_text_length =
     String.length skipped_txt + String.length nonskipped_txt 
   in
+  let text = skipped_txt ^ nonskipped_txt in
+  let prefix_len = MatitaGtkMisc.utf8_string_length skipped_txt in
   let enriched_history_fragment =
    MatitaEngine.eval_ast ~do_heavy_checks:true
-    lexicon_status grafite_status st
+    lexicon_status grafite_status (text,prefix_len,st)
   in
   let enriched_history_fragment = List.rev enriched_history_fragment in
   (* really fragile *)
@@ -101,64 +95,74 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
             (status,to_prepend ^ newtxt ^ "\n")::acc, "")
       ([],skipped_txt) enriched_history_fragment
   in
-  let res = (*List.combine (List.map fst (List.rev enriched_history_fragment))
-  strings*) res in 
-  res,parsed_text_length
+  res,"",parsed_text_length
 
 let wrap_with_developments guistuff f arg = 
+  let compile_needed_and_go_on lexiconfile d exc =
+    let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" lexiconfile in
+    let target = Pcre.replace ~pat:"metadata$" ~templ:"moo" target in
+    let refresh_cb () = 
+      while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
+    in
+    if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
+      raise exc
+    else
+      f arg
+  in
+  let do_nothing () = raise (ActionCancelled "Inclusion not performed") in
+  let check_if_file_is_exists f =
+    assert(Pcre.pmatch ~pat:"ma$" f);
+    let pwd = Sys.getcwd () in
+    let f_pwd = pwd ^ "/" ^ f in
+    if not (HExtlib.is_regular f_pwd) then
+      raise (ActionCancelled ("File "^f_pwd^" does not exists!"))
+    else
+      raise 
+        (ActionCancelled 
+          ("Internal error: "^f_pwd^" exists but I'm unable to include it!"))
+  in
+  let handle_with_devel d lexiconfile mafile exc =
+    let name = MatitamakeLib.name_for_development d in
+    let title = "Unable to include " ^ lexiconfile in
+    let message = 
+      mafile ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
+      "<i>Should I compile it and Its dependencies?</i>"
+    in
+    (match guistuff.ask_confirmation ~title ~message with
+    | `YES -> compile_needed_and_go_on lexiconfile d exc
+    | `NO -> raise exc
+    | `CANCEL -> do_nothing ())
+  in
+  let handle_without_devel mafilename exc =
+    let title = "Unable to include " ^ mafilename in
+    let message = 
+     mafilename ^ " is <b>not</b> handled by a development.\n" ^
+     "All dependencies are automatically solved for a development.\n\n" ^
+     "<i>Do you want to set up a development?</i>"
+    in
+    (match guistuff.ask_confirmation ~title ~message with
+    | `YES -> 
+        guistuff.develcreator ~containing:(Some (Filename.dirname mafilename));
+        do_nothing ()
+    | `NO -> raise exc
+    | `CANCEL -> do_nothing())
+  in
   try 
     f arg
   with
-  | DependenciesParser.UnableToInclude what 
-  | LexiconEngine.IncludedFileNotCompiled what 
-  | GrafiteEngine.IncludedFileNotCompiled what as exc ->
-      let compile_needed_and_go_on d =
-        let target = Pcre.replace ~pat:"lexicon$" ~templ:"moo" what in
-        let refresh_cb () = 
-          while Glib.Main.pending () do ignore(Glib.Main.iteration false); done
-        in
-        if not(MatitamakeLib.build_development_in_bg ~target refresh_cb d) then
-          raise exc
-        else
-          f arg
-      in
-      let do_nothing () = raise (ActionCancelled "Inclusion not performed") in
-      let handle_with_devel d =
-        let name = MatitamakeLib.name_for_development d in
-        let title = "Unable to include " ^ what in
-        let message = 
-          what ^ " is handled by development <b>" ^ name ^ "</b>.\n\n" ^
-          "<i>Should I compile it and Its dependencies?</i>"
-        in
-        (match guistuff.ask_confirmation ~title ~message with
-        | `YES -> compile_needed_and_go_on d
-        | `NO -> raise exc
-        | `CANCEL -> do_nothing ())
-      in
-      let handle_without_devel filename =
-        let title = "Unable to include " ^ what in
-        let message = 
-         what ^ " is <b>not</b> handled by a development.\n" ^
-         "All dependencies are automatically solved for a development.\n\n" ^
-         "<i>Do you want to set up a development?</i>"
-        in
-        (match guistuff.ask_confirmation ~title ~message with
-        | `YES -> 
-            (match filename with
-            | Some f -> 
-                guistuff.develcreator ~containing:(Some (Filename.dirname f))
-            | None -> guistuff.develcreator ~containing:None);
-            do_nothing ()
-        | `NO -> raise exc
-        | `CANCEL -> do_nothing())
-      in
-      match guistuff.filenamedata with
-      | None,None -> handle_without_devel None
-      | None,Some d -> handle_with_devel d
-      | Some f,_ ->
-          match MatitamakeLib.development_for_dir (Filename.dirname f) with
-          | None -> handle_without_devel (Some f)
-          | Some d -> handle_with_devel d
+  | DependenciesParser.UnableToInclude mafilename -> 
+      assert (Pcre.pmatch ~pat:"ma$" mafilename);
+      check_if_file_is_exists mafilename
+  | LexiconEngine.IncludedFileNotCompiled (xfilename,mafilename) 
+  | GrafiteEngine.IncludedFileNotCompiled (xfilename,mafilename) as exn ->
+      assert (Pcre.pmatch ~pat:"ma$" mafilename);
+      assert (Pcre.pmatch ~pat:"lexicon$" xfilename || 
+              Pcre.pmatch ~pat:"mo$" xfilename );
+      (* we know that someone was able to include the .ma, get the baseuri
+       * but was unable to get the compilation output 'xfilename' *)
+      match MatitamakeLib.development_for_dir (Filename.dirname mafilename) with
+      | None -> handle_without_devel mafilename exn
+      | Some d -> handle_with_devel d xfilename mafilename exn
 ;;
     
 let eval_with_engine
@@ -200,17 +204,17 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
      let l =  Whelp.match_term ~dbd term in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WInstance (loc, term) ->
      let l = Whelp.instance ~dbd term in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WLocate (loc, s) -> 
      let l = Whelp.locate ~dbd s in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WElim (loc, term) ->
      let uri =
        match term with
@@ -220,13 +224,13 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
      let l = Whelp.elim ~dbd uri in
      let entry = `Whelp (pp_macro mac, l) in
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   | TA.WHint (loc, term) ->
-     let s = ((None,[0,[],term], Cic.Meta (0,[]) ,term),0) in
+     let s = ((None,[0,[],term], 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
      guistuff.mathviewer#show_uri_list ~reuse:true ~entry l;
-     [], parsed_text_length
+     [], "", parsed_text_length
   (* REAL macro *)
   | TA.Hint loc -> 
       let user_goal' =
@@ -239,26 +243,25 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       let l = List.map fst (MQ.experimental_hint ~dbd proof_status) in
       let selected = guistuff.urichooser l in
       (match selected with
-      | [] -> [], parsed_text_length
+      | [] -> [], "", parsed_text_length
       | [uri] -> 
           let suri = UriManager.string_of_uri uri in
           let ast loc =
-            TA.Executable (loc, (TA.Tactical (loc,
-              TA.Tactic (loc,
-                TA.Apply (loc, CicNotationPt.Uri (suri, None))),
-                Some (TA.Dot loc)))) in
+            TA.Executable (loc, (TA.Tactic (loc,
+             Some (TA.Apply (loc, CicNotationPt.Uri (suri, None))),
+             TA.Dot loc))) in
           let text =
            comment parsed_text ^ "\n" ^
             pp_eager_statement_ast (ast HExtlib.dummy_floc) in
           let text_len = MatitaGtkMisc.utf8_string_length text in
           let loc = HExtlib.floc_of_loc (0,text_len) in
           let statement = `Ast (GrafiteParser.LSome (ast loc),text) in
-          let res,_parsed_text_len =
+          let res,_,_parsed_text_len =
            eval_statement include_paths buffer guistuff lexicon_status
             grafite_status user_goal script statement
           in
            (* we need to replace all the parsed_text *)
-           res,String.length parsed_text
+           res,"",String.length parsed_text
       | _ -> 
           HLog.error 
             "The result of the urichooser should be only 1 uri, not:\n";
@@ -275,12 +278,10 @@ let rec eval_macro include_paths (buffer : GText.buffer) guistuff lexicon_status
       let ty,_ = CTC.type_of_aux' metasenv context term CicUniv.empty_ugraph in
       let t_and_ty = Cic.Cast (term,ty) in
       guistuff.mathviewer#show_entry (`Cic (t_and_ty,metasenv));
-      [], parsed_text_length
-  (* TODO *)
-  | TA.Quit _ -> failwith "not implemented"
-  | TA.Print (_,kind) -> failwith "not implemented"
-  | TA.Search_pat (_, search_kind, str) -> failwith "not implemented"
-  | TA.Search_term (_, search_kind, term) -> failwith "not implemented"
+      [], "", parsed_text_length
+  | TA.Inline (_,style,suri,prefix) ->
+       let str = ApplyTransformation.txt_of_inline_macro style suri prefix 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
@@ -309,11 +310,14 @@ script ex loc
            | `CANCEL -> raise MatitaTypes.Cancel)
      | _ -> ()
    end;
+   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
     guistuff lexicon_status grafite_status user_goal skipped_txt nonskipped_txt
      (TA.Executable (loc, ex))
   with
-     MatitaTypes.Cancel -> [], 0
+     MatitaTypes.Cancel -> [], "", 0
    | GrafiteEngine.Macro (_loc,lazy_macro) ->
       let context =
        match user_goal with
@@ -350,28 +354,30 @@ 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,lexicon_status),parsed_text],"",
         parsed_text_length
   | 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,len = 
+      let s,text,len = 
        try
         eval_statement include_paths buffer guistuff lexicon_status
          grafite_status user_goal script (`Raw s)
        with
           HExtlib.Localized (floc, exn) ->
-           HExtlib.raise_localized_exception ~offset:parsed_text_length floc exn
+           HExtlib.raise_localized_exception 
+             ~offset:(MatitaGtkMisc.utf8_string_length parsed_text) floc exn
         | GrafiteDisambiguator.DisambiguationError (offset,errorll) ->
            raise
             (GrafiteDisambiguator.DisambiguationError
               (offset+parsed_text_length, errorll))
       in
+      assert (text=""); (* no macros inside comments, please! *)
       (match s with
       | (statuses,text)::tl ->
-         (statuses,parsed_text ^ text)::tl,parsed_text_length + len
-      | [] -> [], 0)
+         (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 
@@ -445,6 +451,9 @@ object (self)
   (** text mark and tag representing locked part of a script *)
   val locked_mark =
     buffer#create_mark ~name:"locked" ~left_gravity:true buffer#start_iter
+  val beginning_of_statement_mark =
+    buffer#create_mark ~name:"beginning_of_statement"
+     ~left_gravity:true buffer#start_iter
   val locked_tag = buffer#create_tag [`BACKGROUND "lightblue"; `EDITABLE false]
   val error_tag = buffer#create_tag [`UNDERLINE `SINGLE; `FOREGROUND "red"]
 
@@ -460,7 +469,7 @@ object (self)
   method private _advance ?statement () =
    let s = match statement with Some s -> s | None -> self#getFuture in
    HLog.debug ("evaluating: " ^ first_line s ^ " ...");
-   let (entries, parsed_len) = 
+   let entries, newtext, parsed_len = 
     try
      eval_statement include_paths buffer guistuff self#lexicon_status
       self#grafite_status userGoal self (`Raw s)
@@ -484,7 +493,8 @@ object (self)
        buffer#insert ~iter:start new_text;
      end;
    end;
-   self#moveMark (Glib.Utf8.length  new_text);
+   self#moveMark (Glib.Utf8.length new_text);
+   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
@@ -513,6 +523,7 @@ object (self)
     with 
     | Margin -> self#notify
     | Not_found -> assert false
+    | Invalid_argument "Array.make" -> HLog.error "The script is too big!\n"
     | exc -> self#notify; raise exc
 
   method retract () =
@@ -530,6 +541,7 @@ object (self)
        self#notify
     with 
     | Margin -> self#notify
+    | Invalid_argument "Array.make" -> HLog.error "The script is too big!\n"
     | exc -> self#notify; raise exc
 
   method private getFuture =
@@ -575,6 +587,11 @@ object (self)
     let grafite_status = self#grafite_status in
     List.iter (fun o -> o lexicon_status grafite_status) observers
 
+  method loadFromString s =
+    buffer#set_text s;
+    self#reset_buffer;
+    buffer#set_modified true
+
   method loadFromFile f =
     buffer#set_text (HExtlib.input_file f);
     self#reset_buffer;
@@ -658,6 +675,7 @@ object (self)
      set_star (Filename.basename self#ppFilename) false
 
   method goto (pos: [`Top | `Bottom | `Cursor]) () =
+  try  
     let old_locked_mark =
      `MARK
        (buffer#create_mark ~name:"old_locked_mark"
@@ -719,7 +737,7 @@ object (self)
              self#_retract (icmp - len) lexicon_status grafite_status statements
               history
           | statement::tl1, _::tl2 ->
-             back_until_cursor (len - String.length statement) (tl1,tl2)
+             back_until_cursor (len - MatitaGtkMisc.utf8_string_length statement) (tl1,tl2)
           | _,_ -> assert false
         in
         (try
@@ -737,7 +755,9 @@ object (self)
         | Margin -> dispose_remember (); dispose_old_locked_mark (); self#notify
         | exc -> dispose_remember (); dispose_old_locked_mark ();
                  self#notify; raise exc)
-              
+  with Invalid_argument "Array.make" ->
+     HLog.error "The script is too big!\n"
+  
   method onGoingProof () =
     match self#grafite_status.proof_status with
     | No_proof | Proof _ -> false
@@ -771,9 +791,10 @@ object (self)
       in
       match st with
       | GrafiteParser.LSome (GrafiteAst.Comment (loc,_)) -> 
-          let _,parsed_text_length = 
-            MatitaGtkMisc.utf8_parsed_text s loc 
-          in
+          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
@@ -783,9 +804,11 @@ object (self)
     try
       is_there_only_comments self#lexicon_status self#getFuture
     with 
+    | LexiconEngine.IncludedFileNotCompiled _
     | HExtlib.Localized _
     | CicNotationParser.Parse_error _ -> false
     | Margin | End_of_file -> true
+    | Invalid_argument "Array.make" -> false
 
   (* debug *)
   method dump () =