X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fmatita%2FmatitaScript.ml;h=9eb1dbf69c608c9ba231d4e46f45f3ae78fb1f18;hb=effab341df3fb2bfe403e51d360e81c8b0455e1a;hp=a6842d832e2076251a7a14fdf82631b51e11d319;hpb=5716f9072fc8a7d46324e91cca970489c59cc590;p=helm.git
diff --git a/helm/software/matita/matitaScript.ml b/helm/software/matita/matitaScript.ml
index a6842d832..9eb1dbf69 100644
--- a/helm/software/matita/matitaScript.ml
+++ b/helm/software/matita/matitaScript.ml
@@ -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;
@@ -103,7 +95,7 @@ let eval_with_engine guistuff lexicon_status grafite_status user_goal
(status,to_prepend ^ newtxt ^ "\n")::acc, "")
([],skipped_txt) enriched_history_fragment
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 =
@@ -129,11 +121,11 @@ let wrap_with_developments guistuff f arg =
(ActionCancelled
("Internal error: "^f_pwd^" exists but I'm unable to include it!"))
in
- let handle_with_devel d lexiconfile exc =
+ 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 =
- lexiconfile ^ " is handled by development " ^ name ^ ".\n\n" ^
+ mafile ^ " is handled by development " ^ name ^ ".\n\n" ^
"Should I compile it and Its dependencies?"
in
(match guistuff.ask_confirmation ~title ~message with
@@ -170,7 +162,7 @@ let wrap_with_developments guistuff f arg =
* 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 exn
+ | Some d -> handle_with_devel d xfilename mafilename exn
;;
let eval_with_engine
@@ -212,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
@@ -232,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' =
@@ -251,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";
@@ -287,10 +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"
+ [], "", 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
@@ -319,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
@@ -360,13 +354,13 @@ 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)
@@ -379,10 +373,11 @@ and eval_statement include_paths (buffer : GText.buffer) guistuff lexicon_status
(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
@@ -456,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"]
@@ -471,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)
@@ -495,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
@@ -524,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 () =
@@ -541,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 =
@@ -586,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;
@@ -669,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"
@@ -748,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
@@ -799,6 +808,7 @@ prerr_endline ("## " ^ string_of_int parsed_text_length);
| HExtlib.Localized _
| CicNotationParser.Parse_error _ -> false
| Margin | End_of_file -> true
+ | Invalid_argument "Array.make" -> false
(* debug *)
method dump () =