let inject_unification_hint =
let basic_eval_unification_hint (t,n)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference:_
~alias_only status
=
if not alias_only then
let inject_interpretation =
let basic_eval_interpretation (dsc, (symbol, args), cic_appl_pattern)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only
=
let rec refresh =
;;
let inject_alias =
- let basic_eval_alias (mode,diff) ~refresh_uri_in_universe ~refresh_uri_in_term
- ~refresh_uri_in_reference ~alias_only =
+ let basic_eval_alias (mode,diff) ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_
+ ~refresh_uri_in_reference:_ ~alias_only:_ =
basic_eval_alias (mode,diff)
in
GrafiteTypes.Serializer.register#run "alias" basic_eval_alias
let inject_input_notation =
let basic_eval_input_notation (l1,l2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference
~alias_only status
=
if not alias_only then
let inject_output_notation =
let basic_eval_output_notation (l1,l2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term ~refresh_uri_in_reference
~alias_only status
=
if not alias_only then
;;
let record_index_obj =
- let aux l ~refresh_uri_in_universe
- ~refresh_uri_in_term ~refresh_uri_in_reference ~alias_only status
+ let aux l ~refresh_uri_in_universe:_
+ ~refresh_uri_in_term ~refresh_uri_in_reference:_ ~alias_only status
=
let refresh_uri_in_term = refresh_uri_in_term (status:>NCic.status) in
if not alias_only then
| exn -> prerr_endline ("EXTRACTION FAILURE: " ^ Printexc.to_string exn); assert false
;;
+let basic_extract_ocaml_obj obj status =
+ try
+ let status = OcamlExtraction.print_ocaml_of_obj status obj in
+ let infos,status = status#get_info in
+ status,infos
+ with
+ exn -> prerr_endline ("EXTRACTION FAILURE: " ^ Printexc.to_string exn); assert false
+;;
+
let inject_extract_obj =
let basic_extract_obj info
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
- ~alias_only status
+ ~refresh_uri_in_universe:__ ~refresh_uri_in_term:_ ~refresh_uri_in_reference
+ ~alias_only:_ status
=
let info= NCicExtraction.refresh_uri_in_info ~refresh_uri_in_reference info in
status#set_extraction_db
GrafiteTypes.Serializer.register#run "extraction" basic_extract_obj
;;
+let inject_extract_ocaml_obj =
+ let basic_extract_ocaml_obj info
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference
+ ~alias_only:_ status
+ =
+ let info= OcamlExtractionTable.refresh_uri_in_info ~refresh_uri_in_reference ~refresh_uri:NCicLibrary.refresh_uri info in
+ status#set_ocaml_extraction_db
+ (OcamlExtractionTable.register_infos status#ocaml_extraction_db info)
+ in
+ GrafiteTypes.Serializer.register#run "ocaml_extraction" basic_extract_ocaml_obj
+;;
+
let eval_extract_obj status obj =
let status,infos = basic_extract_obj obj status in
NCicLibrary.dump_obj status (inject_extract_obj infos)
;;
+let eval_extract_ocaml_obj status obj =
+ let status,infos = basic_extract_ocaml_obj obj status in
+ NCicLibrary.dump_obj status (inject_extract_ocaml_obj infos)
+;;
+
(*
module EmptyC =
struct
let record_index_eq =
let basic_index_eq uri
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ ~refresh_uri_in_universe:_ ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only status
= if not alias_only then index_eq false (NCicLibrary.refresh_uri uri) status
else
;;
let inject_constraint =
- let basic_eval_add_constraint (u1,u2)
- ~refresh_uri_in_universe ~refresh_uri_in_term ~refresh_uri_in_reference
+ let basic_eval_add_constraint (acyclic,u1,u2)
+ ~refresh_uri_in_universe ~refresh_uri_in_term:_ ~refresh_uri_in_reference:_
~alias_only status
=
if not alias_only then
(* NCicLibrary.add_constraint adds the constraint to the NCicEnvironment
* and also to the storage (for undo/redo). During inclusion of compiled
* files the storage must not be touched. *)
- NCicEnvironment.add_lt_constraint u1 u2;
+ NCicEnvironment.add_lt_constraint acyclic u1 u2;
status
else
status
GrafiteTypes.Serializer.register#run "constraints" basic_eval_add_constraint
;;
-let eval_add_constraint status u1 u2 =
- let status = NCicLibrary.add_constraint status u1 u2 in
- NCicLibrary.dump_obj status (inject_constraint (u1,u2))
+let eval_add_constraint status acyclic u1 u2 =
+ let status = NCicLibrary.add_constraint status acyclic u1 u2 in
+ NCicLibrary.dump_obj status (inject_constraint (acyclic,u1,u2))
;;
let eval_ng_tac tac =
+ let just_to_tacstatus_just just text prefix_len =
+ match just with
+ | `Term t -> `Term (text,prefix_len,t)
+ | `Auto (l,params) ->
+ (
+ match l with
+ | None -> `Auto (None,params)
+ | Some l -> `Auto (Some (List.map (fun t -> (text,prefix_len,t)) l),params)
+ )
+ | _ -> assert false
+ in
let rec aux f (text, prefix_len, tac) =
match tac with
| GrafiteAst.NApply (_loc, t) -> NTactics.apply_tac (text,prefix_len,t)
NTactics.block_tac (List.map (fun x -> aux f (text,prefix_len,x)) l)
|GrafiteAst.NRepeat (_,tac) ->
NTactics.repeat_tac (f f (text, prefix_len, tac))
+ |GrafiteAst.Assume (_,id,t) -> Declarative.assume id (text,prefix_len,t)
+ |GrafiteAst.Suppose (_,t,id) -> Declarative.suppose (text,prefix_len,t) id
+ |GrafiteAst.By_just_we_proved (_,j,t1,s) -> Declarative.by_just_we_proved
+ (just_to_tacstatus_just j text prefix_len) (text,prefix_len,t1) s
+ |GrafiteAst.We_need_to_prove (_, t, id) -> Declarative.we_need_to_prove (text,prefix_len,t) id
+ |GrafiteAst.BetaRewritingStep (_, t) -> Declarative.beta_rewriting_step (text,prefix_len,t)
+ | GrafiteAst.Bydone (_, j) -> Declarative.bydone (just_to_tacstatus_just j text prefix_len)
+ | GrafiteAst.ExistsElim (_, just, id1, t1, t2, id2) ->
+ Declarative.existselim (just_to_tacstatus_just just text prefix_len) id1 (text,prefix_len,t1)
+ (text,prefix_len,t2) id2
+ | GrafiteAst.AndElim(_,just,t1,id1,t2,id2) -> Declarative.andelim (just_to_tacstatus_just just
+ text prefix_len) (text,prefix_len,t1) id1 (text,prefix_len,t2) id2
+ | GrafiteAst.Thesisbecomes (_, t1) -> Declarative.thesisbecomes (text,prefix_len,t1)
+ | GrafiteAst.RewritingStep (_,rhs,just,cont) ->
+ Declarative.rewritingstep (text,prefix_len,rhs)
+ (match just with
+ `Term _
+ | `Auto _ -> just_to_tacstatus_just just text prefix_len
+ |`Proof -> `Proof
+ |`SolveWith t -> `SolveWith (text,prefix_len,t)
+ )
+ cont
+ | GrafiteAst.Obtain (_,id,t1) ->
+ Declarative.obtain id (text,prefix_len,t1)
+ | GrafiteAst.Conclude (_,t1) ->
+ Declarative.conclude (text,prefix_len,t1)
+ | GrafiteAst.We_proceed_by_cases_on (_, t, t1) ->
+ Declarative.we_proceed_by_cases_on (text,prefix_len,t) (text,prefix_len,t1)
+ | GrafiteAst.We_proceed_by_induction_on (_, t, t1) ->
+ Declarative.we_proceed_by_induction_on (text,prefix_len,t) (text,prefix_len,t1)
+ | GrafiteAst.Byinduction (_, t, id) -> Declarative.byinduction (text,prefix_len,t) id
+ | GrafiteAst.Case (_,id,params) -> Declarative.case id params
+ | GrafiteAst.PrintStack (_) -> Declarative.print_stack
in
aux aux tac (* trick for non uniform recursion call *)
;;
NCic.Inductive (ind,leftno,tys,attrs)
;;
+let extract_uris status uris =
+ List.fold_left
+ (fun status uri ->
+ let obj = NCicEnvironment.get_checked_obj status uri in
+ let status = eval_extract_obj status obj in
+ eval_extract_ocaml_obj status obj
+ ) status uris
+;;
let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) =
match cmd with
- | GrafiteAst.Include (loc, mode, fname) ->
+ | GrafiteAst.Include (_loc, mode, fname) ->
let _root, baseuri, fullpath, _rrelpath =
Librarian.baseuri_of_script ~include_paths fname in
let baseuri = NUri.uri_of_string baseuri in
(* MATITA 1.0: keep WithoutPreferences? *)
let alias_only = (mode = GrafiteAst.OnlyPreferences) in
+ let status =
GrafiteTypes.Serializer.require
- ~alias_only ~baseuri ~fname:fullpath status
- | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n
+ ~alias_only ~baseuri ~fname:fullpath status in
+ OcamlExtraction.print_open status
+ (NCicLibrary.get_transitively_included status)
+ | GrafiteAst.UnificationHint (_loc, t, n) -> eval_unification_hint status t n
| GrafiteAst.NCoercion (loc, name, compose, None) ->
let status, t, ty, source, target =
let o_t = NotationPt.Ident (name,None) in
in
status, o_t, NotationPt.NCic ty, source, target
in
- let status, composites =
- NCicCoercDeclaration.eval_ncoercion status name compose t ty source
- target
- in
- let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *)
- let aliases = GrafiteDisambiguate.aliases_for_objs status composites in
- eval_alias status (mode,aliases)
- | GrafiteAst.NCoercion (loc, name, compose, Some (t, ty, source, target)) ->
+ let cmd =
+ GrafiteAst.NCoercion (loc, name, compose, Some (t, ty, source, target))
+ in
+ eval_ncommand ~include_paths opts status (text,prefix_len,cmd)
+ | GrafiteAst.NCoercion (_loc, name, compose, Some (t, ty, source, target)) ->
let status, composites =
NCicCoercDeclaration.eval_ncoercion status name compose t ty source
target in
+ let status = extract_uris status composites in
let mode = GrafiteAst.WithPreferences in (* MATITA 1.0: fixme *)
let aliases = GrafiteDisambiguate.aliases_for_objs status composites in
eval_alias status (mode,aliases)
- | GrafiteAst.NQed (loc,index) ->
+ | GrafiteAst.NQed (_loc,index) ->
if status#ng_mode <> `ProofMode then
raise (GrafiteTypes.Command_error "Not in proof mode")
else
- let uri,height,menv,subst,obj_kind = status#obj in
+ let uri,_height,menv,subst,obj_kind = status#obj in
if menv <> [] then
raise
(GrafiteTypes.Command_error"You can't Qed an incomplete theorem")
let old_status = status in
let status = NCicLibrary.add_obj status obj in
let status = eval_extract_obj status obj in
+ let status = eval_extract_ocaml_obj status obj in
(try
let index_obj = index &&
match obj_kind with
| _ -> status)
else
status in
+ (* purge tinycals stack *)
+ let ninitial_stack = Continuationals.Stack.of_nmetasenv [] in
+ let status = status#set_stack ninitial_stack in
(*
try
index_eq uri status
else
nstatus
with
- | MultiPassDisambiguator.DisambiguationError _ as e ->
+ | MultiPassDisambiguator.DisambiguationError _ ->
HLog.warn "error in disambiguating projection/eliminator";
status
| NCicTypeChecker.TypeCheckerFailure _ ->
let status = match nobj with
NCic.Inductive (is_ind,leftno,itl,_) ->
List.fold_left (fun status it ->
- (let _,ind_name,ty,cl = it in
+ (let _,ind_name,_ty,_cl = it in
List.fold_left
(fun status outsort ->
let status = status#set_ng_mode `ProofMode in
| _ -> status
in
let status = match nobj with
- NCic.Inductive (is_ind,leftno,itl,_) ->
+ NCic.Inductive (_is_ind,leftno,itl,_) ->
(* first leibniz *)
let status' = List.fold_left
(fun status it ->
- let _,ind_name,ty,cl = it in
+ let _,ind_name,_ty,_cl = it in
let status = status#set_ng_mode `ProofMode in
try
(let status,invobj =
(* then JMeq *)
List.fold_left
(fun status it ->
- let _,ind_name,ty,cl = it in
+ let _,ind_name,_ty,_cl = it in
let status = status#set_ng_mode `ProofMode in
try
(let status,invobj =
basic_eval_and_record_ncoercion_from_t_cpos_arity
status (name,true,t,cpos,arity) in
let aliases = GrafiteDisambiguate.aliases_for_objs status nuris in
- let status =
- List.fold_left
- (fun status uri ->
- let obj = NCicEnvironment.get_checked_obj status uri in
- eval_extract_obj status obj
- ) status nuris
- in
+ let status = extract_uris status nuris in
eval_alias status (mode,aliases)
with MultiPassDisambiguator.DisambiguationError _->
HLog.warn ("error in generating coercion: "^name);
exn ->
NCicLibrary.time_travel old_status;
raise exn)
- | GrafiteAst.NCopy (log,tgt,src_uri, map) ->
+ | GrafiteAst.NCopy (_loc,tgt,src_uri, map) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
let status = subst_metasenv_and_fix_names status in
let status = status#set_ng_mode `ProofMode in
eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
- | GrafiteAst.NObj (loc,obj,index) ->
+ | GrafiteAst.NObj (_loc,obj,index) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
let status,obj =
GrafiteDisambiguate.disambiguate_nobj status
~baseuri:status#baseuri (text,prefix_len,obj) in
- let uri,height,nmenv,nsubst,nobj = obj in
+ let _uri,_height,nmenv,_nsubst,_nobj = obj in
let ninitial_stack = Continuationals.Stack.of_nmetasenv nmenv in
let status = status#set_obj obj in
let status = status#set_stack ninitial_stack in
eval_ncommand ~include_paths opts status
("",0,GrafiteAst.NQed(Stdpp.dummy_loc,index))
| _ -> status)
- | GrafiteAst.NDiscriminator (loc, indty) ->
+ | GrafiteAst.NDiscriminator (_loc, indty) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
let status = status#set_ng_mode `ProofMode in
- let metasenv,subst,status,indty =
- GrafiteDisambiguate.disambiguate_nterm status `XTSort [] [] [] (text,prefix_len,indty) in
+ let _metasenv,_subst,status,indty =
+ GrafiteDisambiguate.disambiguate_nterm status `XTNone [] [] [] (text,prefix_len,indty) in
let indtyno, (_,_,tys,_,_),leftno = match indty with
NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,leftno))) as r) ->
indtyno, NCicEnvironment.get_checked_indtys status r, leftno
[] -> eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
| _ -> prerr_endline ("Discriminator: non empty metasenv");
status)
- | GrafiteAst.NInverter (loc, name, indty, selection, sort) ->
+ | GrafiteAst.NInverter (_loc, name, indty, selection, sort) ->
if status#ng_mode <> `CommandMode then
raise (GrafiteTypes.Command_error "Not in command mode")
else
"ninverter: found target %s, which is not a sort"
(status#ppterm ~metasenv ~subst ~context:[] sort))) in
let status = status#set_ng_mode `ProofMode in
- let metasenv,subst,status,indty =
+ let _metasenv,_subst,status,indty =
GrafiteDisambiguate.disambiguate_nterm status `XTNone [] [] subst
(text,prefix_len,indty) in
let indtyno,(_,leftno,tys,_,_) =
eval_ncommand ~include_paths opts status
("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false))
| _ -> assert false)
- | GrafiteAst.NUnivConstraint (loc,u1,u2) ->
- eval_add_constraint status [`Type,u1] [`Type,u2]
+ | GrafiteAst.NUnivConstraint (_loc,acyclic,u1,u2) ->
+ eval_add_constraint status acyclic [`Type,u1] [`Type,u2]
(* ex lexicon commands *)
- | GrafiteAst.Interpretation (loc, dsc, (symbol, args), cic_appl_pattern) ->
+ | GrafiteAst.Interpretation (_loc, dsc, (symbol, args), cic_appl_pattern) ->
let cic_appl_pattern =
GrafiteDisambiguate.disambiguate_cic_appl_pattern status args
cic_appl_pattern
in
eval_interpretation status (dsc,(symbol, args),cic_appl_pattern)
- | GrafiteAst.Notation (loc, dir, l1, associativity, precedence, l2) ->
+ | GrafiteAst.Notation (_loc, dir, l1, associativity, precedence, l2) ->
let l1 =
CicNotationParser.check_l1_pattern
l1 (dir = Some `RightToLeft) precedence associativity
in
if dir <> Some `LeftToRight then eval_output_notation status (l1,l2)
else status
- | GrafiteAst.Alias (loc, spec) ->
+ | GrafiteAst.Alias (_loc, spec) ->
let diff =
(*CSC: Warning: this code should be factorized with the corresponding
code in DisambiguatePp *)
match spec with
- | GrafiteAst.Ident_alias (id,uri) ->
+ | GrafiteAst.Ident_alias (id,_uri) ->
[DisambiguateTypes.Id id,spec]
- | GrafiteAst.Symbol_alias (symb, instance, desc) ->
+ | GrafiteAst.Symbol_alias (symb, instance, _desc) ->
[DisambiguateTypes.Symbol (symb,instance),spec]
- | GrafiteAst.Number_alias (instance,desc) ->
+ | GrafiteAst.Number_alias (instance,_desc) ->
[DisambiguateTypes.Num instance,spec]
in
let mode = GrafiteAst.WithPreferences in(*assert false in (* VEDI SOPRA *) MATITA 1.0*)
eval_alias status (mode,diff)
;;
-let eval_comment opts status (text,prefix_len,c) = status
+let eval_comment _opts status (_text,_prefix_len,_c) = status
let rec eval_executable ~include_paths opts status (text,prefix_len,ex) =
match ex with
projects / helm.git / blobdiff