open ProofEngineHelpers
open ProofEngineTypes
+exception TheTypeOfTheCurrentGoalIsAMetaICannotChooseTheRightElimiantionPrinciple
exception NotAnInductiveTypeToEliminate
-exception NotTheRightEliminatorShape
-exception NoHypothesesFound
exception WrongUriToVariable of string
(* lambda_abstract newmeta ty *)
in
let s' = CicReduction.normalize ~delta:false context s in
res,(newmeta,context,s')::newmetasenv,newargument::arguments,lastmeta
+ (** NORMALIZE RATIONALE
+ * we normalize the target only NOW since we may be in this case:
+ * A1 -> A2 -> T where T = (\lambda x.A3 -> P) k
+ * and we want a mesasenv with ?1:A1 and ?2:A2 and not
+ * ?1, ?2, ?3 (that is the one we whould get if we start from the
+ * beta-normalized A1 -> A2 -> A3 -> P **)
| t -> (CicReduction.normalize ~delta:false context t),[],[],newmeta
in
(* WARNING: here we are using the invariant that above the most *)
in
let metasenv' = metasenv@newmetasenvfragment in
let termty,_ =
- CicTypeChecker.type_of_aux' metasenv' context term CicUniv.empty_ugraph in
+ CicTypeChecker.type_of_aux' metasenv' context term' CicUniv.empty_ugraph in
let termty =
CicSubstitution.subst_vars exp_named_subst_diff termty
in
- prerr_endline ("term:" ^ CicPp.ppterm term);
- prerr_endline ("termty:" ^ CicPp.ppterm termty);
let subst,newmetasenv',t =
try
new_metasenv_and_unify_and_t newmeta' metasenv' proof context term' ty
in
mk_tactic (intros_tac ~mk_fresh_name_callback ())
-let cut_tac?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) ~term=
+let cut_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[]) term =
let cut_tac
?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
term (proof, goal)
in
mk_tactic (cut_tac ~mk_fresh_name_callback term)
-let letin_tac ?(mk_fresh_name_callback=FreshNamesGenerator.mk_fresh_name ~subst:[]) ~term=
+let letin_tac ?(mk_fresh_name_callback=FreshNamesGenerator.mk_fresh_name ~subst:[]) term =
let letin_tac
?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
term (proof, goal)
| C.Sort C.Set -> "_rec"
| C.Sort C.CProp -> "_rec"
| C.Sort (C.Type _)-> "_rect"
+ | C.Meta (_,_) -> raise TheTypeOfTheCurrentGoalIsAMetaICannotChooseTheRightElimiantionPrinciple
| _ -> assert false
in
U.uri_of_string (buri ^ "/" ^ name ^ ext ^ ".con")
mk_tactic (elim_tac ~term)
;;
-let elim_intros_tac ~term =
- Tacticals.then_ ~start:(elim_tac ~term)
- ~continuation:(intros_tac ())
+let elim_intros_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ ?depth ?using what =
+ Tacticals.then_ ~start:(elim_tac ~term:what)
+ ~continuation:(intros_tac ~mk_fresh_name_callback ?howmany:depth ())
;;
(* The simplification is performed only on the conclusion *)
-let elim_intros_simpl_tac ~term =
- Tacticals.then_ ~start:(elim_tac ~term)
+let elim_intros_simpl_tac ?(mk_fresh_name_callback = FreshNamesGenerator.mk_fresh_name ~subst:[])
+ ?depth ?using what =
+ Tacticals.then_ ~start:(elim_tac ~term:what)
~continuation:
(Tacticals.thens
- ~start:(intros_tac ())
+ ~start:(intros_tac ~mk_fresh_name_callback ?howmany:depth ())
~continuations:
- [ReductionTactics.simpl_tac ~also_in_hypotheses:false ~terms:None])
+ [ReductionTactics.simpl_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)])
;;
-
-exception NotConvertible
-
-(*CSC: Bug (or feature?). [with_what] is parsed in the context of the goal, *)
-(*CSC: while [what] can have a richer context (because of binders) *)
-(*CSC: So it is _NOT_ possible to use those binders in the [with_what] term. *)
-(*CSC: Is that evident? Is that right? Or should it be changed? *)
-let change_tac ~what ~with_what =
- let change_tac ~what ~with_what (proof, goal) =
- let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = CicUtil.lookup_meta goal metasenv in
- (* are_convertible works only on well-typed terms *)
- let _,u =
- CicTypeChecker.type_of_aux' metasenv context with_what
- CicUniv.empty_ugraph
- in (* TASSI: FIXME *)
- let b,_ =
- CicReduction.are_convertible context what with_what u
- in
- if b then
- begin
- let replace =
- ProofEngineReduction.replace
- ~equality:(==) ~what:[what] ~with_what:[with_what]
- in
- let ty' = replace ty in
- let context' =
- List.map
- (function
- Some (name,Cic.Def (t,None))->
- Some (name,Cic.Def ((replace t),None))
- | Some (name,Cic.Decl t) -> Some (name,Cic.Decl (replace t))
- | None -> None
- | Some (_,Cic.Def (_,Some _)) -> assert false
- ) context
- in
- let metasenv' =
- List.map
- (function
- (n,_,_) when n = metano -> (metano,context',ty')
- | _ as t -> t
- ) metasenv
- in
- (curi,metasenv',pbo,pty), [metano]
- end
- else
- raise (ProofEngineTypes.Fail "Not convertible")
- in
- mk_tactic (change_tac ~what ~with_what)
-