X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=matita%2Fcomponents%2Fgrafite_engine%2FgrafiteEngine.ml;h=59821ac09734d36345d29ef1825e22acfd1fe95d;hb=59e3ddd15ee1983027e8929c073b06a80d523875;hp=7febf874e3a25ac5defb81232663ace8756a3fe2;hpb=894d518aa760c9f816ddb0dc2b3fa88e1fe20a94;p=helm.git diff --git a/matita/components/grafite_engine/grafiteEngine.ml b/matita/components/grafite_engine/grafiteEngine.ml index 7febf874e..59821ac09 100644 --- a/matita/components/grafite_engine/grafiteEngine.ml +++ b/matita/components/grafite_engine/grafiteEngine.ml @@ -477,7 +477,7 @@ let compute_relevance status uri = let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = match cmd with | GrafiteAst.Include (loc, mode, fname) -> - let _root, baseuri, fullpath, _rrelpath = + 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? *) @@ -485,13 +485,14 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = GrafiteTypes.Serializer.require ~alias_only ~baseuri ~fname:fullpath status | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n - | GrafiteAst.NCoercion (loc, name, t, ty, source, target) -> + | GrafiteAst.NCoercion (loc, name, compose, t, ty, source, target) -> let status, composites = - NCicCoercDeclaration.eval_ncoercion status name t ty source target in + 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.NQed loc -> + | GrafiteAst.NQed (loc,index) -> if status#ng_mode <> `ProofMode then raise (GrafiteTypes.Command_error "Not in proof mode") else @@ -526,7 +527,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let obj = uri,height,[],[],obj_kind in let old_status = status in let status = NCicLibrary.add_obj status obj in - let index_obj = + let index_obj = index && match obj_kind with NCic.Constant (_,_,_,_,(_,`Example,_)) | NCic.Fixpoint (_,_,(_,`Example,_)) -> false @@ -592,7 +593,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let _,_,menv,_,_ = invobj in (match menv with [] -> eval_ncommand ~include_paths opts status - ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + ("",0,GrafiteAst.NQed (Stdpp.dummy_loc,false)) | _ -> status)) (* XXX *) with _ -> (*HLog.warn "error in generating inversion principle"; *) @@ -602,6 +603,57 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = List.map (fun s -> NCic.Type s) (NCicEnvironment.get_universes ())) | _ -> status in + let status = match nobj with + NCic.Inductive (is_ind,leftno,itl,_) -> + (* first leibniz *) + let status' = List.fold_left + (fun status it -> + let _,ind_name,ty,cl = it in + let status = status#set_ng_mode `ProofMode in + try + (let status,invobj = + NDestructTac.mk_discriminator ~use_jmeq:false + (ind_name ^ "_discr") + it leftno status status#baseuri in + let _,_,menv,_,_ = invobj in + (match menv with + [] -> eval_ncommand ~include_paths opts status + ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) + | _ -> status)) + (* XXX *) + with + | NDestructTac.ConstructorTooBig k -> + HLog.warn (Printf.sprintf + "unable to generate leibniz discrimination principle (constructor %s too big)" + k); + let status = status#set_ng_mode `CommandMode in status + | _ -> (*HLog.warn "error in generating discrimination principle"; *) + let status = status#set_ng_mode `CommandMode in + status) + status itl + in + (* then JMeq *) + List.fold_left + (fun status it -> + let _,ind_name,ty,cl = it in + let status = status#set_ng_mode `ProofMode in + try + (let status,invobj = + NDestructTac.mk_discriminator ~use_jmeq:true + (ind_name ^ "_jmdiscr") + it leftno status status#baseuri in + let _,_,menv,_,_ = invobj in + (match menv with + [] -> eval_ncommand ~include_paths opts status + ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) + | _ -> status)) + (* XXX *) + with _ -> (*HLog.warn "error in generating discrimination principle"; *) + let status = status#set_ng_mode `CommandMode in + status) + status' itl + | _ -> status + in let coercions = match obj with _,_,_,_,NCic.Inductive @@ -622,7 +674,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let status, nuris = NCicCoercDeclaration. basic_eval_and_record_ncoercion_from_t_cpos_arity - status (name,t,cpos,arity) in + status (name,true,t,cpos,arity) in let aliases = GrafiteDisambiguate.aliases_for_objs status nuris in eval_alias status (mode,aliases) with MultiPassDisambiguator.DisambiguationError _-> @@ -665,7 +717,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let status = status#set_stack ninitial_stack in 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) + eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) | GrafiteAst.NObj (loc,obj) -> if status#ng_mode <> `CommandMode then raise (GrafiteTypes.Command_error "Not in command mode") @@ -681,26 +733,28 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = let status = status#set_ng_mode `ProofMode in (match nmenv with [] -> - eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,true)) | _ -> status) - | GrafiteAst.NDiscriminator (_,_) -> assert false (*(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 None status [] [] [] (text,prefix_len,indty) in - let indtyno, (_,_,tys,_,_) = match indty with - NCic.Const ((NReference.Ref (_,NReference.Ind (_,indtyno,_))) as r) -> - indtyno, NCicEnvironment.get_checked_indtys r + GrafiteDisambiguate.disambiguate_nterm status None [] [] [] (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 | _ -> prerr_endline ("engine: indty expected... (fix this error message)"); assert false in - let it = List.nth tys indtyno in - let status,obj = NDestructTac.mk_discriminator it status in + let (_,ind_name,_,_ as it) = List.nth tys indtyno in + let status,obj = + NDestructTac.mk_discriminator ~use_jmeq:true (ind_name ^ "_jmdiscr") + it leftno status status#baseuri in let _,_,menv,_,_ = obj in (match menv with - [] -> eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + [] -> eval_ncommand ~include_paths opts status ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) | _ -> prerr_endline ("Discriminator: non empty metasenv"); - status, []) *) + status) | GrafiteAst.NInverter (loc, name, indty, selection, sort) -> if status#ng_mode <> `CommandMode then raise (GrafiteTypes.Command_error "Not in command mode") @@ -740,7 +794,7 @@ let rec eval_ncommand ~include_paths opts status (text,prefix_len,cmd) = (match menv with [] -> eval_ncommand ~include_paths opts status - ("",0,GrafiteAst.NQed Stdpp.dummy_loc) + ("",0,GrafiteAst.NQed(Stdpp.dummy_loc,false)) | _ -> assert false) | GrafiteAst.NUnivConstraint (loc,u1,u2) -> eval_add_constraint status [`Type,u1] [`Type,u2]