exception IncludedFileNotCompiled of string * string
exception Macro of
GrafiteAst.loc *
- (Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro)
+ (Cic.context -> GrafiteTypes.status * (Cic.term,Cic.lazy_term) GrafiteAst.macro)
type 'a disambiguator_input = string * int * 'a
(* First order tactics *)
| GrafiteAst.Absurd (_, term) -> Tactics.absurd term
| GrafiteAst.Apply (_, term) -> Tactics.apply term
+ | GrafiteAst.ApplyRule (_, term) -> Tactics.apply term
| GrafiteAst.ApplyP (_, term) -> Tactics.applyP term
| GrafiteAst.ApplyS (_, term, params) ->
Tactics.applyS ~term ~params ~dbd:(LibraryDb.instance ())
disambiguate_macro:
(GrafiteTypes.status ->
- ('term GrafiteAst.macro) disambiguator_input ->
- Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
+ (('term,'lazy_term) GrafiteAst.macro) disambiguator_input ->
+ Cic.context -> GrafiteTypes.status * (Cic.term,Cic.lazy_term) GrafiteAst.macro) ->
?do_heavy_checks:bool ->
GrafiteTypes.status ->
GrafiteTypes.status * UriManager.uri list
}
+type 'a eval_comment =
+ {ecm_go: 'term 'lazy_term 'reduction_kind 'obj 'ident.
+ disambiguate_command:
+ (GrafiteTypes.status -> (('term,'obj) GrafiteAst.command) disambiguator_input ->
+ GrafiteTypes.status * (Cic.term,Cic.obj) GrafiteAst.command) ->
+ options -> GrafiteTypes.status ->
+ (('term,'lazy_term,'reduction_kind,'obj,'ident) GrafiteAst.comment) disambiguator_input ->
+ GrafiteTypes.status * UriManager.uri list
+ }
+
type 'a eval_executable =
{ee_go: 'term 'lazy_term 'reduction 'obj 'ident.
disambiguate_tactic:
disambiguate_macro:
(GrafiteTypes.status ->
- ('term GrafiteAst.macro) disambiguator_input ->
- Cic.context -> GrafiteTypes.status * Cic.term GrafiteAst.macro) ->
+ (('term,'lazy_term) GrafiteAst.macro) disambiguator_input ->
+ Cic.context -> GrafiteTypes.status * (Cic.term,Cic.lazy_term) GrafiteAst.macro) ->
options ->
GrafiteTypes.status ->
GrafiteAst.Coercion
(HExtlib.dummy_floc, CicUtil.term_of_uri uri, false, arity, saturations)
-let refinement_toolkit = {
- RefinementTool.type_of_aux' =
- (fun ?localization_tbl e c t u ->
- let saved = !CicRefine.insert_coercions in
- CicRefine.insert_coercions:= false;
- let rc =
- try
- let t, ty, metasenv, ugraph =
- CicRefine.type_of_aux' ?localization_tbl e c t u in
- RefinementTool.Success (t, ty, metasenv, ugraph)
- with
- | CicRefine.RefineFailure s
- | CicRefine.Uncertain s
- | CicRefine.AssertFailure s -> RefinementTool.Exception s
- in
- CicRefine.insert_coercions := saved;
- rc);
- RefinementTool.ppsubst = CicMetaSubst.ppsubst;
- RefinementTool.apply_subst = CicMetaSubst.apply_subst;
- RefinementTool.ppmetasenv = CicMetaSubst.ppmetasenv;
- RefinementTool.pack_coercion_obj = CicRefine.pack_coercion_obj;
- }
-
+let eval_unification_hint status t n =
+ (* XXX no undo *)
+ NCicUnifHint.add_user_provided_hint t n;
+ status,[]
+;;
+
+let add_coercions_of_lemmas lemmas status =
+ let moo_content =
+ HExtlib.filter_map
+ (fun uri ->
+ match CoercDb.is_a_coercion (Cic.Const (uri,[])) with
+ | None -> None
+ | Some (_,tgt,_,sat,_) ->
+ let arity = match tgt with CoercDb.Fun n -> n | _ -> 0 in
+ Some (coercion_moo_statement_of (uri,arity,sat,0)))
+ lemmas
+ in
+ let status = GrafiteTypes.add_moo_content moo_content status in
+ {status with GrafiteTypes.coercions = CoercDb.dump () },
+ lemmas
+
let eval_coercion status ~add_composites uri arity saturations =
let uri =
try CicUtil.uri_of_term uri
with Invalid_argument _ ->
raise (Invalid_argument "coercion can only be constants/constructors")
in
- let status,compounds =
- GrafiteSync.add_coercion ~add_composites refinement_toolkit status uri arity
- saturations (GrafiteTypes.get_baseuri status)
- in
- let moo_content =
- List.map coercion_moo_statement_of ((uri,arity,saturations,0)::compounds)
+ let status, lemmas =
+ GrafiteSync.add_coercion ~add_composites
+ ~pack_coercion_obj:CicRefine.pack_coercion_obj
+ status uri arity saturations (GrafiteTypes.get_baseuri status) in
+ let moo_content = coercion_moo_statement_of (uri,arity,saturations,0) in
+ let status = GrafiteTypes.add_moo_content [moo_content] status in
+ add_coercions_of_lemmas lemmas status
+
+let eval_prefer_coercion status c =
+ let uri =
+ try CicUtil.uri_of_term c
+ with Invalid_argument _ ->
+ raise (Invalid_argument "coercion can only be constants/constructors")
in
- let status = GrafiteTypes.add_moo_content moo_content status in
- {status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
- List.map (fun u,_,_,_ -> u) compounds
+ let status = GrafiteSync.prefer_coercion status uri in
+ let moo_content = GrafiteAst.PreferCoercion (HExtlib.dummy_floc,c) in
+ let status = GrafiteTypes.add_moo_content [moo_content] status in
+ status, []
module MatitaStatus =
struct
in
status
-let eval_comment status c = status
-
-(* since the record syntax allows to declare coercions, we have to put this
- * information inside the moo *)
-let add_coercions_of_record_to_moo obj lemmas status =
- let attributes = CicUtil.attributes_of_obj obj in
- let is_record = function `Class (`Record att) -> Some att | _-> None in
- match HExtlib.list_findopt is_record attributes with
- | None -> status,[]
- | Some fields ->
- let is_a_coercion uri =
- try
- let obj,_ =
- CicEnvironment.get_cooked_obj CicUniv.oblivion_ugraph uri in
- let attrs = CicUtil.attributes_of_obj obj in
- try
- match List.find
- (function `Class (`Coercion _) -> true | _-> false) attrs
- with `Class (`Coercion n) -> true,n | _ -> assert false
- with Not_found -> false,0
- with Not_found -> assert false
- in
- let buri = GrafiteTypes.get_baseuri status in
- (* looking at the fields we can know the 'wanted' coercions, but not the
- * actually generated ones. So, only the intersection between the wanted
- * and the actual should be in the moo as coercion, while everithing in
- * lemmas should go as aliases *)
- let wanted_coercions =
- HExtlib.filter_map
- (function
- | (name,true,arity) ->
- Some
- (arity, UriManager.uri_of_string (buri ^ "/" ^ name ^ ".con" ))
- | _ -> None)
- fields
- in
- (*prerr_endline "wanted coercions:";
- List.iter
- (fun u -> prerr_endline (UriManager.string_of_uri u))
- wanted_coercions; *)
- let coercions, moo_content =
- List.split
- (HExtlib.filter_map
- (fun uri ->
- let is_a_wanted_coercion,arity_wanted =
- try
- let arity,_ =
- List.find (fun (n,u) -> UriManager.eq u uri)
- wanted_coercions
- in
- true, arity
- with Not_found -> false, 0
- in
- let is_a_coercion, arity_coercion = is_a_coercion uri in
- if is_a_coercion then
- Some (uri, coercion_moo_statement_of (uri,arity_coercion,0,0))
- else if is_a_wanted_coercion then
- Some (uri, coercion_moo_statement_of (uri,arity_wanted,0,0))
- else
- None)
- lemmas)
- in
- (*prerr_endline "actual coercions:";
- List.iter
- (fun u -> prerr_endline (UriManager.string_of_uri u))
- coercions;
- prerr_endline "lemmas was:";
- List.iter
- (fun u -> prerr_endline (UriManager.string_of_uri u))
- lemmas; *)
- let status = GrafiteTypes.add_moo_content moo_content status in
- {status with
- GrafiteTypes.coercions = coercions @ status.GrafiteTypes.coercions},
- lemmas
-
-let add_obj uri obj status =
- let status,lemmas = GrafiteSync.add_obj refinement_toolkit uri obj status in
- status, lemmas
+let add_obj = GrafiteSync.add_obj ~pack_coercion_obj:CicRefine.pack_coercion_obj
let rec eval_command = {ec_go = fun ~disambiguate_command opts status
(text,prefix_len,cmd) ->
*)
let status = GrafiteTypes.add_moo_content [cmd] status in
status,[]
+ | GrafiteAst.PreferCoercion (loc, coercion) ->
+ eval_prefer_coercion status coercion
| GrafiteAst.Coercion (loc, uri, add_composites, arity, saturations) ->
eval_coercion status ~add_composites uri arity saturations
+ | GrafiteAst.UnificationHint (loc, t, n) ->
+ eval_unification_hint status t n
| GrafiteAst.Default (loc, what, uris) as cmd ->
LibraryObjects.set_default what uris;
GrafiteTypes.add_moo_content [cmd] status,[]
status,[]
| GrafiteAst.Print (_,"proofterm") ->
let _,_,_,p,_, _ = GrafiteTypes.get_current_proof status in
- prerr_endline (Auto.pp_proofterm p);
+ prerr_endline (Auto.pp_proofterm (Lazy.force p));
status,[]
| GrafiteAst.Print (_,_) -> status,[]
| GrafiteAst.Qed loc ->
(GrafiteTypes.Command_error
"Proof not completed! metasenv is not empty!");
let name = UriManager.name_of_uri uri in
- let obj = Cic.Constant (name,Some bo,ty,[],attrs) in
+ let obj = Cic.Constant (name,Some (Lazy.force bo),ty,[],attrs) in
let status, lemmas = add_obj uri obj status in
{status with
GrafiteTypes.proof_status = GrafiteTypes.No_proof},
"\nPlease use a variant."));
end;
let _subst = [] in
- let initial_proof = (Some uri, metasenv', _subst, bo, ty, attrs) in
+ let initial_proof = (Some uri, metasenv', _subst, lazy bo, ty, attrs) in
let initial_stack = Continuationals.Stack.of_metasenv metasenv' in
{ status with GrafiteTypes.proof_status =
GrafiteTypes.Incomplete_proof
CicMetaSubst.ppmetasenv [] metasenv));
let status, lemmas = add_obj uri obj status in
let status,new_lemmas =
- add_coercions_of_record_to_moo obj lemmas status
+ add_coercions_of_lemmas lemmas status
in
{status with GrafiteTypes.proof_status = GrafiteTypes.No_proof},
uri::new_lemmas@lemmas
} and eval_executable = {ee_go = fun ~disambiguate_tactic ~disambiguate_command
~disambiguate_macro opts status (text,prefix_len,ex) ->
match ex with
- | GrafiteAst.Tactic (loc, Some tac, punct) ->
+ | GrafiteAst.Tactic (_(*loc*), Some tac, punct) ->
let tac = apply_tactic ~disambiguate_tactic (text,prefix_len,tac) in
let status = eval_tactical status (tactic_of_ast' tac) in
- (* CALL auto on every goal, easy way of testing it *)
+ (* CALL auto on every goal, easy way of testing it
let auto =
GrafiteAst.AutoBatch
(loc, ([],["depth","2";"timeout","1";"type","1"])) in
(try
let auto = apply_tactic ~disambiguate_tactic ("",0,auto) in
let _ = eval_tactical status (tactic_of_ast' auto) in
- print_endline "GOOD"; ()
- with ProofEngineTypes.Fail _ -> print_endline "BAD" | _ -> ());
+ print_endline "GOOD"; ()
+ with ProofEngineTypes.Fail _ -> print_endline "BAD" | _ -> ());*)
eval_tactical status
(punctuation_tactical_of_ast (text,prefix_len,punct)),[]
| GrafiteAst.Tactic (_, None, punct) ->
| GrafiteAst.Executable (_,ex) ->
eval_executable.ee_go ~disambiguate_tactic ~disambiguate_command
~disambiguate_macro opts status (text,prefix_len,ex)
- | GrafiteAst.Comment (_,c) -> eval_comment status (text,prefix_len,c),[]
+ | GrafiteAst.Comment (_,c) ->
+ eval_comment.ecm_go ~disambiguate_command opts status (text,prefix_len,c)
+} and eval_comment = { ecm_go = fun ~disambiguate_command opts status (text,prefix_len,c) ->
+ status, []
}
+;;
+
let eval_ast = eval_ast.ea_go
projects / helm.git / blobdiff