try String.sub s i j with Invalid_argument _ -> assert false
let heading_nl_RE = Pcre.regexp "^\\s*\n\\s*"
-let blanks_RE = Pcre.regexp "^\\s*$"
-
+let only_dust_RE = Pcre.regexp "^(\\s|\n|%%[^\n]*\n)*$"
+let multiline_RE = Pcre.regexp "^\n[^\n]+$"
+let newline_RE = Pcre.regexp "\n"
+
+let comment str =
+ if Pcre.pmatch ~rex:multiline_RE str then
+ "\n(** " ^ (Pcre.replace ~rex:newline_RE str) ^ " **)"
+ else
+ "\n(**\n" ^ str ^ "\n**)"
+
let first_line s =
let s = Pcre.replace ~rex:heading_nl_RE s in
try
let goal_ast n =
let module A = TacticAst in
let loc = CicAst.dummy_floc in
- A.Tactical (loc, A.Tactic (loc, A.Goal (loc, n)))
-
-let eval_statement status mathviewer user_goal s =
- let st = CicTextualParser2.parse_statement (Stream.of_string s) in
- match st with
- | TacticAst.Command (loc, _) | TacticAst.Tactical (loc, _) ->
- let parsed_text_length = snd (CicAst.loc_of_floc loc) in
- let parsed_text = safe_substring s 0 parsed_text_length in
- let goal_changed = ref false in
- let status =
- match status.proof_status with
- | Incomplete_proof (_, goal) when goal <> user_goal ->
- goal_changed := true;
- MatitaEngine.eval_ast status (goal_ast user_goal)
- | _ -> status
- in
- let new_status = MatitaEngine.eval_ast status st in
- let new_aliases =
- match st with
- | TacticAst.Command (_, TacticAst.Alias _) ->
- DisambiguateTypes.Environment.empty
- | _ -> MatitaSync.alias_diff ~from:status new_status
- in
- let new_text =
- if DisambiguateTypes.Environment.is_empty new_aliases then
- parsed_text
- else
- prepend_text (CicTextualParser2.EnvironmentP3.to_string new_aliases)
- parsed_text
- in
- let new_text =
- if !goal_changed then
- prepend_text
- (TacticAstPp.pp_tactic (TacticAst.Goal (loc, user_goal))(* ^ "\n"*))
- new_text
- else
- new_text
+ A.Executable (loc, A.Tactical (loc, A.Tactic (loc, A.Goal (loc, n))))
+
+let eval_with_engine status user_goal parsed_text st =
+ let module TA = TacticAst in
+ let module TAPp = TacticAstPp in
+ let parsed_text_length = String.length parsed_text in
+ let loc, ex =
+ match st with TA.Executable (loc,ex) -> loc, ex | _ -> assert false
+ in
+ let goal_changed = ref false in
+ let status =
+ match status.proof_status with
+ | Incomplete_proof (_, goal) when goal <> user_goal ->
+ goal_changed := true;
+ MatitaEngine.eval_ast status (goal_ast user_goal)
+ | _ -> status
+ in
+ let new_status = MatitaEngine.eval_ast status st in
+ let new_aliases =
+ match ex with
+ | TA.Command (_, TA.Alias _) ->
+ DisambiguateTypes.Environment.empty
+ | _ -> MatitaSync.alias_diff ~from:status new_status
+ in
+ let new_text =
+ if DisambiguateTypes.Environment.is_empty new_aliases then
+ parsed_text
+ else
+ prepend_text (CicTextualParser2.EnvironmentP3.to_string new_aliases)
+ parsed_text
+ in
+ let new_text =
+ if !goal_changed then
+ prepend_text
+ (TAPp.pp_tactic (TA.Goal (loc, user_goal))(* ^ "\n"*))
+ new_text
+ else
+ new_text
+ in
+ [ new_status, new_text ], parsed_text_length
+
+let eval_macro status (mathviewer:MatitaTypes.mathViewer) urichooser parsed_text 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 parsed_text_length = String.length parsed_text in
+ match mac with
+ | 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 selected = urichooser l in
+ (match selected with
+ | [] -> [], parsed_text_length
+ | [uri] ->
+ let ast =
+ (TA.Executable (loc,
+ (TA.Tactical (loc,
+ TA.Tactic (loc,
+ TA.Apply (loc, CicAst.Uri (uri,None)))))))
+ in
+ let new_status = MatitaEngine.eval_ast status ast in
+ let extra_text =
+ 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
+ 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
in
- [ new_status, new_text ], parsed_text_length
- | TacticAst.Macro (loc, mac) ->
- let parsed_text_length = snd (CicAst.loc_of_floc loc) in
- (match mac with (* TODO *)
- | TacticAst.Hint _ ->
- let s = MatitaMisc.get_proof_status status in
- let l = List.map fst
- (MetadataQuery.experimental_hint ~dbd:(MatitaDb.instance ()) s)
- in
- List.iter prerr_endline l;
- prerr_endline "FINITA LA HINT"; assert false
- | TacticAst.Match (_,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 =
- MatitaDisambiguator.disambiguate_term dbd context metasenv aliases term
- in
- match interps with
- | [x] -> x
- | _ -> assert false
+ let results = MetadataQuery.match_term ~dbd:dbd term in
+ mathviewer#show_uri_list ~reuse:true ~entry:(`Whelp ("match", results))
+ results;
+ [], 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
- List.iter prerr_endline (MetadataQuery.match_term ~dbd:dbd term);
- assert false;
- | TacticAst.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 =
- MatitaDisambiguator.disambiguate_term dbd context metasenv aliases term
- in
match interps with
- | [x] -> x
- | _ -> assert false
+ | [x] -> x
+ | _ -> assert false
+ 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
- List.iter prerr_endline (MetadataQuery.instance ~dbd term);
- assert false
-
- | TacticAst.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 =
- MatitaDisambiguator.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
- mathviewer # show_term (`Cic (ty,metasenv) );
- [ status, "" ] , parsed_text_length
- | _ -> failwith "not implemented")
+ 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"
+
+
+let eval_executable status (mathviewer:MatitaTypes.mathViewer) urichooser user_goal parsed_text ex =
+ let module TA = TacticAst in
+ let module TAPp = TacticAstPp in
+ let module MD = MatitaDisambiguator in
+ let parsed_text_length = String.length parsed_text in
+ match ex with
+ | 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
+
+let rec eval_statement status (mathviewer:MatitaTypes.mathViewer) urichooser user_goal 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_length = snd (CicAst.loc_of_floc loc) in
+ let parsed_text = safe_substring s 0 parsed_text_length in
+ parsed_text, parsed_text_length
+ in
+ match st with
+ | TacticAst.Comment (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
+ (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
+
class script ~(buffer: GText.buffer) ~(init: MatitaTypes.status)
- ~(mathviewer: MatitaTypes.mathViewer) () =
+ ~(mathviewer: MatitaTypes.mathViewer)
+ ~urichooser () =
object (self)
initializer self#reset ()
method private _advance ?statement () =
let s = match statement with Some s -> s | None -> self#getFuture in
- if Pcre.pmatch ~rex:blanks_RE s then raise Margin;
MatitaLog.debug ("evaluating: " ^ first_line s ^ " ...");
let (entries, parsed_len) =
- eval_statement self#status mathviewer userGoal s in
+ eval_statement self#status mathviewer urichooser userGoal s in
let (new_statuses, new_statements) = List.split entries in
(*
prerr_endline "evalStatement returned";
let _script = ref None
-let script ~buffer ~init ~mathviewer () =
- let s = new script ~buffer ~init ~mathviewer () in
+let script ~buffer ~init ~mathviewer ~urichooser () =
+ let s = new script ~buffer ~init ~mathviewer ~urichooser () in
_script := Some s;
s
projects / helm.git / blobdiff