DisambiguateTypes.Environment.empty
| _ -> MatitaSync.alias_diff ~from:status new_status
in
+ (* we remove the defined object since we consider them "automathic aliases" *)
+ let new_aliases =
+ let module DTE = DisambiguateTypes.Environment in
+ let module UM = UriManager in
+ DTE.fold (
+ fun k ((v,_) as value) acc ->
+ let v = UM.strip_xpointer (UM.uri_of_string v) in
+ if List.exists (fun (s,_) -> s = v) new_status.objects then
+ acc
+ else
+ DTE.add k value acc
+ ) new_aliases DTE.empty
+ in
let new_text =
if DisambiguateTypes.Environment.is_empty new_aliases then
parsed_text
new_text
in
[ new_status, new_text ], parsed_text_length
+
+let disambiguate term status =
+ let module MD = MatitaDisambiguator in
+ let dbd = MatitaDb.instance () in
+ let metasenv = MatitaMisc.get_proof_metasenv status in
+ let context = MatitaMisc.get_proof_context status in
+ let aliases = MatitaMisc.get_proof_aliases status in
+ let interps = MD.disambiguate_term dbd context metasenv aliases term in
+ match interps with
+ | [_,_,x,_] -> x
+ | _ -> assert false
-let eval_macro status (mathviewer:MatitaTypes.mathViewer) urichooser parsed_text mac =
+let eval_macro status (mathviewer:MatitaTypes.mathViewer) urichooser parsed_text
+ script mac
+=
let module TA = TacticAst in
let module TAPp = TacticAstPp in
let module MQ = MetadataQuery in
- let module MD = MatitaDisambiguator in
let module MDB = MatitaDb in
+ let module CTC = CicTypeChecker in
+ let module CU = CicUniv in
+ (* no idea why ocaml wants this *)
+ let advance ?statement () = script#advance ?statement () in
let parsed_text_length = String.length parsed_text in
+ let dbd = MatitaDb.instance () in
match mac with
+ (* WHELP's stuff *)
+ | TA.WMatch (loc, term) ->
+ let term = disambiguate term status in
+ let l = MQ.match_term ~dbd term in
+ let entry = `Whelp (TAPp.pp_macro_cic (TA.WMatch (loc, term)), l) in
+ mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WInstance (loc, term) ->
+ let term = disambiguate term status in
+ let l = MQ.instance ~dbd term in
+ let entry = `Whelp (TAPp.pp_macro_cic (TA.WInstance (loc, term)), l) in
+ mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WLocate (loc, s) ->
+ let l = MQ.locate ~dbd s in
+ let entry = `Whelp (TAPp.pp_macro_cic (TA.WLocate (loc, s)), l) in
+ mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WElim (loc, term) ->
+ let term = disambiguate term status in
+ let uri =
+ match term with
+ | Cic.MutInd (uri,n,_) -> UriManager.string_of_uriref (uri,[n])
+ | _ -> failwith "Not a MutInd"
+ in
+ let l = MQ.elim ~dbd uri in
+ let entry = `Whelp (TAPp.pp_macro_cic (TA.WElim (loc, term)), l) in
+ mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ | TA.WHint (loc, term) ->
+ let term = disambiguate term status 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 (TAPp.pp_macro_cic (TA.WHint (loc, term)), l) in
+ mathviewer#show_uri_list ~reuse:true ~entry l;
+ [], parsed_text_length
+ (* REAL macro *)
| TA.Hint loc ->
let s = MatitaMisc.get_proof_status status in
- let l = List.map fst (MQ.experimental_hint ~dbd:(MDB.instance ()) s) in
+ let l = List.map fst (MQ.experimental_hint ~dbd s) in
let selected = urichooser l in
(match selected with
| [] -> [], parsed_text_length
comment parsed_text ^
"\n" ^ TAPp.pp_statement ast
in
- [ new_status , extra_text ],parsed_text_length
- | _ -> assert false)
- | TA.Match (_,term) ->
- let dbd = MatitaDb.instance () in
+ [ new_status , extra_text ], parsed_text_length
+ | _ ->
+ MatitaLog.error
+ "The result of the urichooser should be only 1 uri, not:\n";
+ List.iter (
+ fun u -> MatitaLog.error (u ^ "\n")
+ ) selected;
+ assert false)
+ | TA.Check (_,term) ->
let metasenv = MatitaMisc.get_proof_metasenv status in
let context = MatitaMisc.get_proof_context status in
let aliases = MatitaMisc.get_proof_aliases status in
- let (_env,_metasenv,term,_graph) =
- let interps =
- MD.disambiguate_term dbd context metasenv aliases term
- in
+ let interps =
+ MatitaDisambiguator.disambiguate_term
+ dbd context metasenv aliases term
+ in
+ let _, metasenv , term, ugraph =
match interps with
| [x] -> x
| _ -> assert false
in
- let results = MetadataQuery.match_term ~dbd:dbd term in
- mathviewer#show_uri_list ~reuse:true ~entry:(`Whelp ("match", results))
- results;
+ let ty,_ = CTC.type_of_aux' metasenv context term ugraph in
+ let t_and_ty = Cic.Cast (term,ty) in
+ mathviewer#show_entry (`Cic (t_and_ty,metasenv));
[], parsed_text_length
- | TA.Instance (_,term) ->
- let dbd = MatitaDb.instance () in
- let metasenv = MatitaMisc.get_proof_metasenv status in
- let context = MatitaMisc.get_proof_context status in
- let aliases = MatitaMisc.get_proof_aliases status in
- let (_env,_metasenv,term,_graph) =
- let interps =
- MD.disambiguate_term dbd context metasenv aliases term
- in
- match interps with
- | [x] -> x
- | _ -> assert false
+(* | TA.Abort _ ->
+ let rec go_back () =
+ let status = script#status.proof_status in
+ match status with
+ | No_proof -> ()
+ | _ -> script#retract ();go_back()
in
- let results = MetadataQuery.instance ~dbd term in
- mathviewer#show_uri_list ~reuse:true
- ~entry:(`Whelp ("instance", results)) results;
- [], parsed_text_length
-
-
- | TA.Check (_,t) ->
- let metasenv = MatitaMisc.get_proof_metasenv status in
- let context = MatitaMisc.get_proof_context status in
- let aliases = MatitaMisc.get_proof_aliases status in
- let db = MatitaDb.instance () in
- let (_env,_metasenv,term,_graph) =
- let interps =
- MD.disambiguate_term db context metasenv aliases t
- in
- match interps with
- | [x] -> x
- | _ -> assert false
- in
- let ty,_ =
- CicTypeChecker.type_of_aux' metasenv context term
- CicUniv.empty_ugraph
- in
- let t_and_ty = Cic.Cast (term,ty) in
- mathviewer # show_entry (`Cic (t_and_ty,metasenv));
- [], parsed_text_length
- | TA.Quit _ ->
- failwith "not implemented quit"
- | _ -> failwith "not implemented"
+ [], parsed_text_length, Some go_back
+ | TA.Redo (_, Some i) -> [], parsed_text_length,
+ Some (fun () -> for j = 1 to i do advance () done)
+ | TA.Redo (_, None) -> [], parsed_text_length,
+ Some (fun () -> advance ())
+ | TA.Undo (_, Some i) -> [], parsed_text_length,
+ Some (fun () -> for j = 1 to i do script#retract () done)
+ | TA.Undo (_, None) -> [], parsed_text_length,
+ Some (fun () -> script#retract ()) *)
+ (* 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"
-let eval_executable status (mathviewer:MatitaTypes.mathViewer) urichooser user_goal parsed_text ex =
+let eval_executable status (mathviewer:MatitaTypes.mathViewer) urichooser
+user_goal parsed_text script ex =
let module TA = TacticAst in
let module TAPp = TacticAstPp in
let module MD = MatitaDisambiguator in
| TA.Command (loc, _) | TA.Tactical (loc, _) ->
eval_with_engine status user_goal parsed_text (TA.Executable (loc, ex))
| TA.Macro (_,mac) ->
- eval_macro status mathviewer urichooser parsed_text mac
+ eval_macro status mathviewer urichooser parsed_text script mac
-let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) urichooser user_goal s =
+let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) urichooser
+user_goal script s =
if Pcre.pmatch ~rex:only_dust_RE s then raise Margin;
let st = CicTextualParser2.parse_statement (Stream.of_string s) in
let text_of_loc loc =
let parsed_text, parsed_text_length = text_of_loc loc in
let remain_len = String.length s - parsed_text_length in
let s = String.sub s parsed_text_length remain_len in
- let s,len = eval_statement status mathviewer urichooser user_goal s in
+ let s,len =
+ eval_statement status mathviewer urichooser user_goal script s
+ in
(match s with
| (status, text) :: tl ->
((status, parsed_text ^ text)::tl), (parsed_text_length + len)
| [] -> [], 0)
| TacticAst.Executable (loc, ex) ->
let parsed_text, parsed_text_length = text_of_loc loc in
- eval_executable status mathviewer urichooser user_goal parsed_text ex
+ eval_executable
+ status mathviewer urichooser user_goal parsed_text script ex
class script ~(buffer: GText.buffer) ~(init: MatitaTypes.status)
let s = match statement with Some s -> s | None -> self#getFuture in
MatitaLog.debug ("evaluating: " ^ first_line s ^ " ...");
let (entries, parsed_len) =
- eval_statement self#status mathviewer urichooser userGoal s in
+ eval_statement self#status mathviewer urichooser userGoal self s in
let (new_statuses, new_statements) = List.split entries in
(*
prerr_endline "evalStatement returned";
end;
let new_text = String.concat "" new_statements in
buffer#insert ~iter:start new_text;
- self#moveMark (String.length new_text);
+ self#moveMark (String.length new_text)
method private _retract () =
match statements, history with
MatitaSync.time_travel ~present:cur_status ~past:prev_status;
statements <- List.tl statements;
history <- List.tl history;
- self#moveMark (- (String.length last_statement))
+ self#moveMark (- (String.length last_statement));
| _ -> raise Margin
method advance ?statement () =
(** @param rel_offset relative offset from current position of locked_mark *)
method private moveMark rel_offset =
let mark = `MARK locked_mark in
+ let old_insert = buffer#get_iter_at_mark `INSERT in
buffer#remove_tag locked_tag ~start:buffer#start_iter ~stop:buffer#end_iter;
let current_mark_pos = buffer#get_iter_at_mark mark in
let new_mark_pos =
in
buffer#move_mark mark ~where:new_mark_pos;
buffer#apply_tag locked_tag ~start:buffer#start_iter ~stop:new_mark_pos;
+ buffer#move_mark `INSERT old_insert;
self#notify
val mutable observers = []
projects / helm.git / blobdiff