exception Unbound_identifier of string
+type incomplete_proof = {
+ proof: ProofEngineTypes.proof;
+ stack: Continuationals.Stack.t;
+}
+
type proof_status =
| No_proof
- | Incomplete_proof of ProofEngineTypes.status
+ | Incomplete_proof of incomplete_proof
| Proof of ProofEngineTypes.proof
| Intermediate of Cic.metasenv
(* Status in which the proof could be while it is being processed by the
type options = option_value StringMap.t
let no_options = StringMap.empty
+type ast_command = (CicNotationPt.term, CicNotationPt.obj) GrafiteAst.command
+type moo = ast_command list * GrafiteAst.metadata list
+
type status = {
- aliases: DisambiguateTypes.environment; (** disambiguation aliases *)
+ aliases: DisambiguateTypes.environment;
+ multi_aliases: DisambiguateTypes.multiple_environment;
+ moo_content_rev: moo;
proof_status: proof_status;
options: options;
- objects: (UriManager.uri * string) list;
- (** in-scope objects, with their paths *)
+ objects: UriManager.uri list;
+ coercions: UriManager.uri list;
+ notation_ids: CicNotation.notation_id list;
}
+let set_metasenv metasenv status =
+ let proof_status =
+ match status.proof_status with
+ | No_proof -> Intermediate metasenv
+ | Incomplete_proof ({ proof = (uri, _, proof, ty) } as incomplete_proof) ->
+ Incomplete_proof
+ { incomplete_proof with proof = (uri, metasenv, proof, ty) }
+ | Intermediate _ -> Intermediate metasenv
+ | Proof _ -> assert false
+ in
+ { status with proof_status = proof_status }
+
let dump_status status =
- MatitaLog.message "status.aliases:\n";
- MatitaLog.message
- (CicTextualParser2.EnvironmentP3.to_string status.aliases ^ "\n");
- MatitaLog.message "status.proof_status:";
- MatitaLog.message
+ HLog.message "status.aliases:\n";
+ HLog.message "status.proof_status:";
+ HLog.message
(match status.proof_status with
| No_proof -> "no proof\n"
| Incomplete_proof _ -> "incomplete proof\n"
| Proof _ -> "proof\n"
| Intermediate _ -> "Intermediate\n");
- MatitaLog.message "status.options\n";
+ HLog.message "status.options\n";
StringMap.iter (fun k v ->
let v =
match v with
| String s -> s
| Int i -> string_of_int i
in
- MatitaLog.message (k ^ "::=" ^ v)) status.options;
- MatitaLog.message "status.coercions\n";
- MatitaLog.message "status.objects:\n";
+ HLog.message (k ^ "::=" ^ v)) status.options;
+ HLog.message "status.coercions\n";
+ HLog.message "status.objects:\n";
List.iter
- (fun (u,_) ->
- MatitaLog.message (UriManager.string_of_uri u)) status.objects
+ (fun u -> HLog.message (UriManager.string_of_uri u)) status.objects
-
let get_option status name =
try
StringMap.find name status.options
let s = Str.global_replace (Str.regexp "/$") "" s in
s
in
- let types =
- [ "baseuri", (`String, mangle_dir);
- "basedir", (`String, mangle_dir);
- ]
- in
+ let types = [ "baseuri", (`String, mangle_dir); ] in
let ty_and_mangler =
try
List.assoc name types
else
{ status with options = StringMap.add name value status.options }
+let add_moo_content cmds status =
+ let content, metadata = status.moo_content_rev in
+ let content' =
+ List.fold_right
+ (fun cmd acc ->
+(* prerr_endline ("adding to moo command: " ^ GrafiteAstPp.pp_command cmd); *)
+ match cmd with
+ | GrafiteAst.Interpretation _
+ | GrafiteAst.Default _ ->
+ if List.mem cmd content then acc
+ else cmd :: acc
+ | GrafiteAst.Alias _ -> (* move Alias as the last inserted one *)
+ cmd :: (List.filter ((<>) cmd) acc)
+ | _ -> cmd :: acc)
+ cmds content
+ in
+(* prerr_endline ("new moo content: " ^ String.concat " " (List.map
+ GrafiteAstPp.pp_command content')); *)
+ { status with moo_content_rev = content', metadata }
+
+let add_moo_metadata new_metadata status =
+ let content, metadata = status.moo_content_rev in
+ let metadata' =
+ List.fold_left
+ (fun acc m ->
+ match m with
+ | GrafiteAst.Dependency buri ->
+ let is_self = (* self dependency *)
+ try
+ get_string_option status "baseuri" = buri
+ with Option_error _ -> false (* baseuri not yet set *)
+ in
+ if is_self
+ || List.exists (GrafiteAst.eq_metadata m) metadata (* duplicate *)
+ then acc
+ else m :: acc
+ | _ -> m :: acc)
+ metadata new_metadata
+ in
+ { status with moo_content_rev = content, metadata' }
+
(* subset of MatitaConsole.console methods needed by MatitaInterpreter *)
class type console =
object
?reuse:bool -> entry:mathViewer_entry -> UriManager.uri list -> unit
end
+let qualify status name = get_string_option status "baseuri" ^ "/" ^ name
+
+let get_current_proof status =
+ match status.proof_status with
+ | Incomplete_proof { proof = p } -> p
+ | _ -> statement_error "no ongoing proof"
+
+let get_proof_metasenv status =
+ match status.proof_status with
+ | No_proof -> []
+ | Proof (_, metasenv, _, _)
+ | Incomplete_proof { proof = (_, metasenv, _, _) }
+ | Intermediate metasenv ->
+ metasenv
+
+let get_proof_context status goal =
+ match status.proof_status with
+ | Incomplete_proof { proof = (_, metasenv, _, _) } ->
+ let (_, context, _) = CicUtil.lookup_meta goal metasenv in
+ context
+ | _ -> []
+
+let get_proof_conclusion status goal =
+ match status.proof_status with
+ | Incomplete_proof { proof = (_, metasenv, _, _) } ->
+ let (_, _, conclusion) = CicUtil.lookup_meta goal metasenv in
+ conclusion
+ | _ -> statement_error "no ongoing proof"
+
+let get_stack status =
+ match status.proof_status with
+ | Incomplete_proof p -> p.stack
+ | Proof _ -> Continuationals.Stack.empty
+ | _ -> assert false
+
+let set_stack stack status =
+ match status.proof_status with
+ | Incomplete_proof p ->
+ { status with proof_status = Incomplete_proof { p with stack = stack } }
+ | Proof _ ->
+ assert (Continuationals.Stack.is_empty stack);
+ status
+ | _ -> assert false
+