X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Ftactics%2Finversion.ml;h=d80814fc363da2945b236a42381ba67e2e8b03bd;hb=1f1e441c320c1ed94e648f5e126cf2298a1eda00;hp=f5e2a847690f2b4c20544c32d9a18ba25108177c;hpb=801f0eb3eabe1cbcd66d6a3f52c24eb8f1189611;p=helm.git diff --git a/components/tactics/inversion.ml b/components/tactics/inversion.ml index f5e2a8476..d80814fc3 100644 --- a/components/tactics/inversion.ml +++ b/components/tactics/inversion.ml @@ -171,6 +171,7 @@ let isSetType paramty = ((Pervasives.compare (get_sort_type paramty) (Cic.Sort Cic.Prop)) != 0) +exception EqualityNotDefinedYet let private_inversion_tac ~term = let module T = CicTypeChecker in let module R = CicReduction in @@ -180,8 +181,12 @@ let private_inversion_tac ~term = let private_inversion_tac ~term (proof, goal) = (*DEBUG*) debug_print (lazy ("private inversion begins")); - let (_,metasenv,_,_) = proof in - let uri_of_eq = LibraryObjects.eq_URI () in + let _,metasenv,_,_, _ = proof in + let uri_of_eq = + match LibraryObjects.eq_URI () with + None -> raise EqualityNotDefinedYet + | Some uri -> uri + in let (_,context,goalty) = CicUtil.lookup_meta goal metasenv in let termty,_ = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in let uri = baseuri_of_term termty in @@ -219,7 +224,7 @@ let private_inversion_tac ~term = parameters_tys goalty uri_of_eq in (*DEBUG*) debug_print (lazy ("cut term " ^ CicPp.ppterm cut_term)); debug_print (lazy ("CONTEXT before apply HCUT: " ^ - (CicMetaSubst.ppcontext [] context ))); + (CicMetaSubst.ppcontext ~metasenv [] context ))); debug_print (lazy ("termty " ^ CicPp.ppterm termty)); (* cut DXn=DXn \to GOAL *) let proof1,gl1 = PET.apply_tactic (P.cut_tac cut_term) (proof,goal) in @@ -233,7 +238,7 @@ let private_inversion_tac ~term = (*DEBUG*) debug_print (lazy ("after apply HCUT;reflexivity in private inversion")); (* apply (ledx_ind( lambda x. lambda y, ...)) *) - let (t1,metasenv,t3,t4) = proof2 in + let t1,metasenv,t3,t4, attrs = proof2 in let goal2 = List.hd (List.tl gl1) in let (_,context,_) = CicUtil.lookup_meta goal2 metasenv in (* rightparameters type list *) @@ -250,7 +255,7 @@ let private_inversion_tac ~term = debug_print (lazy ("Right param: " ^ (CicPp.ppterm (Cic.Appl rightparameters)))); debug_print (lazy ("CONTEXT before refinement: " ^ - (CicMetaSubst.ppcontext [] context ))); + (CicMetaSubst.ppcontext ~metasenv [] context ))); (*DEBUG*) debug_print (lazy ("private inversion: term before refinement: " ^ CicPp.ppterm t)); let (ref_t,_,metasenv'',_) = CicRefine.type_of_aux' metasenv context t @@ -258,13 +263,13 @@ let private_inversion_tac ~term = in (*DEBUG*) debug_print (lazy ("private inversion: termine after refinement: " ^ CicPp.ppterm ref_t)); - let proof2 = (t1,metasenv'',t3,t4) in + let proof2 = (t1,metasenv'',t3,t4, attrs) in let my_apply_tac = let my_apply_tac status = let proof,goals = ProofEngineTypes.apply_tactic (P.apply_tac ref_t) status in let patched_new_goals = - let (_,metasenv''',_,_) = proof in + let (_,metasenv''',_,_, _) = proof in let new_goals = ProofEngineHelpers.compare_metasenvs ~oldmetasenv:metasenv ~newmetasenv:metasenv'' in @@ -298,17 +303,20 @@ let inversion_tac ~term = let module PET = ProofEngineTypes in let inversion_tac ~term (proof, goal) = (*DEBUG*) debug_print (lazy ("inversion begins")); - let (_,metasenv,_,_) = proof in + let _,metasenv,_,_, _ = proof in let (_,context,goalty) = CicUtil.lookup_meta goal metasenv in let termty,_ = T.type_of_aux' metasenv context term CicUniv.empty_ugraph in - let uri = baseuri_of_term termty in + let uri, typeno = + match termty with + | Cic.MutInd (uri,typeno,_) + | Cic.Appl(Cic.MutInd (uri,typeno,_)::_) -> uri,typeno + | _ -> assert false + in + (* let uri = baseuri_of_term termty in *) let obj,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in let name,nleft,arity,cons_list = match obj with Cic.InductiveDefinition (tys,_,nleft,_) -> - (*we suppose there is only one inductiveType in the definition, - so typeno=0 identically *) - let typeno = 0 in let (name,_,arity,cons_list) = List.nth tys typeno in (name,nleft,arity,cons_list) |_ -> assert false @@ -330,15 +338,15 @@ let inversion_tac ~term = Cic.Appl ([Cic.Const(uri,[])] @ !a @ [Cic.Rel 1]) in let t = appl_term (arity_length + (List.length cons_list)) inversor_uri in - let (t1,metasenv,t3,t4) = proof in + let (t1,metasenv,t3,t4, attrs) = proof in let (ref_t,_,metasenv'',_) = CicRefine.type_of_aux' metasenv context t CicUniv.empty_ugraph in - let proof = (t1,metasenv'',t3,t4) in + let proof = (t1,metasenv'',t3,t4, attrs) in let proof3,gl3 = ProofEngineTypes.apply_tactic (P.apply_tac ref_t) (proof,goal) in let patched_new_goals = - let (_,metasenv''',_,_) = proof3 in + let (_,metasenv''',_,_, _) = proof3 in let new_goals = ProofEngineHelpers.compare_metasenvs ~oldmetasenv:metasenv ~newmetasenv:metasenv'' in