let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
(match termty with
(C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
match termty with (* an equality *)
(C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
~start:
(fun ~status:((proof,goal) as status) ->
let _,metasenv,_,_ = proof in
- let _,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,gty = CicUtil.lookup_meta goal metasenv in
prerr_endline ("XXXX goal " ^ string_of_int goal) ;
prerr_endline ("XXXX gty " ^ CicPp.ppterm gty) ;
prerr_endline ("XXXX old t1' " ^ CicPp.ppterm t1') ;
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
match termty with
(C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
(match goals' with
[goal'] ->
let _,metasenv',_,_ = proof' in
- let _,context',gty' = List.find (function (m,_,_) -> m=goal') metasenv' in
-prerr_endline ("XXXX gty " ^ CicPp.ppterm gty') ;
-prerr_endline ("XXXX tty " ^ CicPp.ppterm tty) ;
-prerr_endline ("XXXX t1 " ^ CicPp.ppterm t1) ;
-prerr_endline ("XXXX t2 " ^ CicPp.ppterm t2) ;
-ignore (List.map (fun t -> prerr_endline ("XXXX t " ^ CicPp.ppterm t)) pattern) ;
-prerr_endline ("XXXX case " ^ CicPp.ppterm (C.Appl [
- C.Lambda (
- C.Name "x", tty,
- C.MutCase (
- turi, typeno,
- (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
- (C.Rel 1), pattern
- )
- ); t2])) ;
+ let _,context',gty' =
+ CicUtil.lookup_meta goal' metasenv'
+ in
T.then_
~start:
(P.change_tac
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,gty = CicUtil.lookup_meta goal metasenv in
let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
match termty with
(C.Appl [(C.MutInd (uri, 0, [])); _; t1; t2]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let termty = (CicTypeChecker.type_of_aux' metasenv context term) in
match termty with
(C.Appl [(C.MutInd (equri, 0, [])) ; tty ; t1 ; t2])
(match goals' with
[goal'] ->
let _,metasenv',_,_ = proof' in
- let _,context',gty' = List.find (function (m,_,_) -> m=goal') metasenv' in
-prerr_endline ("XXXX gty " ^ CicPp.ppterm gty') ;
-prerr_endline ("XXXX tty " ^ CicPp.ppterm tty) ;
-prerr_endline ("XXXX t1' " ^ CicPp.ppterm t1') ;
-prerr_endline ("XXXX t2' " ^ CicPp.ppterm t2') ;
-ignore (List.map (fun t -> prerr_endline ("XXXX t " ^ CicPp.ppterm t)) pattern) ;
-prerr_endline ("XXXX case " ^ CicPp.ppterm (C.Appl [
- C.Lambda (
- C.Name "x", tty,
- C.MutCase (
- turi, typeno,
- (C.Lambda ((C.Name "x"),tty,(C.Sort C.Prop))),
- (C.Rel 1), pattern
- )
- ); t2'])) ;
+ let _,context',gty' =
+ CicUtil.lookup_meta goal' metasenv'
+ in
T.then_
~start:
(P.change_tac
let module S = ProofEngineStructuralRules in
let module U = UriManager in
let (_,metasenv,_,_) = proof in
- let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
let termty = CicTypeChecker.type_of_aux' metasenv context term in (* per ora non serve *)
T.then_ ~start:(T.repeat_tactic
let module T = Tacticals in
let module S = ProofEngineStructuralRules in
let _,metasenv,_,_ = proof in
- let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
let old_context_len = List.length context in
let termty = CicTypeChecker.type_of_aux' metasenv context term in
warn ("nr_of_hyp_still_to_elim=" ^ (string_of_int nr_of_hyp_still_to_elim));
if nr_of_hyp_still_to_elim <> 0 then
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let old_context_len = List.length context in
let termty = CicTypeChecker.type_of_aux' metasenv context term' in
warn ("elim_clear termty= " ^ CicPp.ppterm termty);
(* clear the hyp that has just been eliminated *)
(fun ~status:((proof,goal) as status) ->
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let new_context_len = List.length context in
warn ("newcon=" ^ (string_of_int new_context_len) ^ " & oldcon=" ^ (string_of_int old_context_len) ^ " & old_nr_of_hyp=" ^ (string_of_int nr_of_hyp_still_to_elim));
let new_nr_of_hyp_still_to_elim = nr_of_hyp_still_to_elim + (new_context_len - old_context_len) - 1 in
let module C = Cic in
let module U = UriManager in
let curi,metasenv,pbo,pty = proof in
- let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,gty = CicUtil.lookup_meta goal metasenv in
let eq_ind_r,ty,t1,t2 =
match CicTypeChecker.type_of_aux' metasenv context equality with
C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
let module C = Cic in
let module U = UriManager in
let curi,metasenv,pbo,pty = proof in
- let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,gty = CicUtil.lookup_meta goal metasenv in
let eq_ind_r,ty,t1,t2 =
match CicTypeChecker.type_of_aux' metasenv context equality with
C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,_ = CicUtil.lookup_meta goal metasenv in
let wty = CicTypeChecker.type_of_aux' metasenv context what in
try
if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what))
let module R = CicReduction in
let module U = UriManager in
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
match (R.whd context ty) with
(C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
PrimitiveTactics.apply_tac ~status:(proof,goal)
let module U = UriManager in
let module T = Tacticals in
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
match (R.whd context ty) with
(C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
T.thens
let pall str ~status:(proof,goal) t =
debug ("tac "^str^" :\n" );
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug ("th = "^ CicPp.ppterm t ^"\n");
debug ("ty = "^ CicPp.ppterm ty^"\n");
in
(debug "2\n";let r = (Tacticals.then_ ~start:(
fun ~status:(proof,goal as status) ->
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty =List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug("!!!!!!!!!1: unify "^CicPp.ppterm _Rle_not_lt^" with "
^ CicPp.ppterm ty ^"\n");
let r = PrimitiveTactics.apply_tac ~term:_Rle_not_lt ~status in
debug("stat tac_zero_infeq_false\n");
let r =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty =List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug("faccio fold di " ^ CicPp.ppterm
(Cic.Appl
let apply_type_tac ~cast:t ~applist:al ~status:(proof,goal) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
let irl =
CicMkImplicit.identity_relocation_list_for_metavariable context in
let my_cut ~term:c ~status:(proof,goal)=
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug("my_cut di "^CicPp.ppterm c^"\n");
let tac_use h ~status:(proof,goal as status) =
debug("Inizio TC_USE\n");
let curi,metasenv,pbo,pty = proof in
-let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug ("hname = "^ CicPp.ppterm h.hname ^"\n");
debug ("ty = "^ CicPp.ppterm ty^"\n");
let module C = Cic in
let proof,goal = status in
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let a_eq_b = C.Appl [ _eqT ; _R ; a ; b ] in
let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
let irl =
(* Galla: moved in variousTactics.ml
let assumption_tac ~status:(proof,goal)=
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let num = ref 0 in
let tac_list = List.map
( fun x -> num := !num + 1;
let rec fourier ~status:(s_proof,s_goal)=
let s_curi,s_metasenv,s_pbo,s_pty = s_proof in
- let s_metano,s_context,s_ty = List.find (function (m,_,_) -> m=s_goal)
- s_metasenv in
-
+ let s_metano,s_context,s_ty = CicUtil.lookup_meta s_goal s_metasenv in
debug ("invoco fourier_tac sul goal "^string_of_int(s_goal)^" e contesto :\n");
debug_pcontext s_context;
(* now we have all the right environment *)
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
(* now we want to convert hp to inequations, but first we must lift
fun ~status ->
debug ("inizio t1 strict\n");
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find
- (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug ("th = "^ CicPp.ppterm _Rfourier_lt ^"\n");
debug ("ty = "^ CicPp.ppterm ty^"\n");
PrimitiveTactics.apply_tac ~term:_Rfourier_lt ~status)
fun ~status ->
debug("INIZIO TAC 1 2\n");
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal)
- metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
debug ("th = "^ CicPp.ppterm _Rfourier_lt_le ^"\n");
debug ("ty = "^ CicPp.ppterm ty^"\n");
PrimitiveTactics.apply_tac ~term:_Rfourier_lt_le ~status)
~continuations:[(*Tacticals.id_tac;Tacticals.id_tac*)(**)Tacticals.then_
~start:(fun ~status:(proof,goal as status) ->
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal)
- metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
PrimitiveTactics.change_tac ~what:ty
~with_what:(Cic.Appl [ _not; ineq]) ~status)
~continuation:(Tacticals.then_
(
fun ~status:(proof,goal as status) ->
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=
- goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
(* check if ty is of type *)
let w1 =
debug("qui c'e' gia' l'or "^CicPp.ppterm ty^"\n");
let module C = Cic in
let module R = CicReduction in
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
match (R.whd context ty) with
(C.MutInd (uri, typeno, exp_named_subst))
| (C.Appl ((C.MutInd (uri, typeno, exp_named_subst))::_)) ->
let module U = UriManager in
let module P = PrimitiveTactics in
let _,metasenv,_,_ = proof in
- let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
if ((CicTypeChecker.type_of_aux' metasenv context term) = (C.Sort C.Prop)) (* ma questo controllo serve?? *)
then P.apply_tac
~term:(C.Appl [(C.Const ((U.uri_of_string "cic:/Coq/Init/Logic/absurd.con") , [] )) ; term ; ty]) ~status
let module R = CicReduction in
let module C = Cic in
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let newmeta = new_meta_of_proof ~proof in
let exp_named_subst_diff,newmeta',newmetasenvfragment,term' =
match term with
let module C = Cic in
let module R = CicReduction in
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let newmeta = new_meta_of_proof ~proof in
let (context',ty',bo') =
lambda_abstract context newmeta ty mk_fresh_name_callback
=
let module C = Cic in
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let newmeta1 = new_meta_of_proof ~proof in
let newmeta2 = newmeta1 + 1 in
let fresh_name =
=
let module C = Cic in
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let _ = CicTypeChecker.type_of_aux' metasenv context term in
let newmeta = new_meta_of_proof ~proof in
let fresh_name =
let exact_tac ~term ~status:(proof, goal) =
(* Assumption: the term bo must be closed in the current context *)
let (_,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let module T = CicTypeChecker in
let module R = CicReduction in
if R.are_convertible context (T.type_of_aux' metasenv context term) ty then
let module R = CicReduction in
let module C = Cic in
let (curi,metasenv,_,_) = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let termty = T.type_of_aux' metasenv context term in
let uri,exp_named_subst,typeno,args =
match termty with
(* way. *)
let meta_of_corpse =
let (_,canonical_context,_) =
- List.find (function (m,_,_) -> m=(lastmeta - 1)) newmetas
+ CicUtil.lookup_meta (lastmeta - 1) newmetas
in
let irl =
CicMkImplicit.identity_relocation_list_for_metavariable
(*CSC: Is that evident? Is that right? Or should it be changed? *)
let change_tac ~what ~with_what ~status:(proof, goal) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
(* are_convertible works only on well-typed terms *)
ignore (CicTypeChecker.type_of_aux' metasenv context with_what) ;
if CicReduction.are_convertible context what with_what then
| Some (_, C.Decl _) -> raise (Fail "No Body To Clear")
| Some (n_to_clear_body, C.Def (term,None)) as hyp_to_clear_body ->
let curi,metasenv,pbo,pty = proof in
- let metano,_,_ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,_,_ = CicUtil.lookup_meta goal metasenv in
let string_of_name =
function
C.Name n -> n
| Some (n_to_clear, _) ->
let curi,metasenv,pbo,pty = proof in
let metano,context,ty =
- List.find (function (m,_,_) -> m=goal) metasenv
+ CicUtil.lookup_meta goal metasenv
in
let string_of_name =
function
(*
let reduction_tac ~reduction ~status:(proof,goal) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let new_ty = reduction context ty in
let new_metasenv =
List.map
(* The default of term is the thesis of the goal to be prooved *)
let reduction_tac ~also_in_hypotheses ~reduction ~terms ~status:(proof,goal) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let terms =
match terms with None -> [ty] | Some l -> l
in
let fold_tac ~reduction ~also_in_hypotheses ~term ~status:(proof,goal) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
let term' = reduction context term in
(* We don't know if [term] is a subterm of [ty] or a subterm of *)
(* the type of one metavariable. So we replace it everywhere. *)
*)
let uri_of_proof ~proof:(uri, _, _, _) = uri
- (**
- @param metano meta list index
- @param metasenv meta list (environment)
- @raise Failure if metano is not found in metasenv
- @return conjecture corresponding to metano in metasenv
- *)
-let conj_of_metano metano =
- try
- List.find (function (m, _, _) -> m = metano)
- with Not_found ->
- failwith (
- "Ring.conj_of_metano: " ^
- (string_of_int metano) ^ " no such meta")
-
(**
@param status current proof engine status
@raise Failure if proof is None
*)
let context_of_status ~status:(proof, goal as status) =
let metasenv = metasenv_of_status ~status:status in
- let _, context, _ = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _, context, _ = CicUtil.lookup_meta goal metasenv in
context
(** CIC TERM CONSTRUCTORS *)
| (_, []) -> failwith "Ring.purge_hyps_tac: no hypotheses left"
in
let (_, metasenv, _, _) = proof in
- let (_, context, _) = conj_of_metano goal metasenv in
+ let (_, context, _) = CicUtil.lookup_meta goal metasenv in
let proof',goal' = aux count context status in
assert (goal = goal') ;
proof',[goal']
let eqt = mkMutInd (Logic_Type.eqt_URI, 0) [] in
let r = Reals.r in
let metasenv = metasenv_of_status ~status in
- let (metano, context, ty) = conj_of_metano goal metasenv in
+ let (metano, context, ty) = CicUtil.lookup_meta goal metasenv in
let (t1, t2) = split_eq ty in (* goal like t1 = t2 *)
match (build_segments ~terms:[t1; t2]) with
| (t1', t1'', t1'_eq_t1'')::(t2', t2'', t2'_eq_t2'')::[] -> begin
(* search arguments on which Apply tactic doesn't fail *)
let matchConclusion mqi_handle ?(output_html = (fun _ -> ())) ~choose_must () ~status =
let ((_, metasenv, _, _), metano) = status in
- let (_, ey ,ty) = List.find (function (m,_,_) -> m=metano) metasenv in
+ let (_, ey ,ty) = CicUtil.lookup_meta metano metasenv in
let list_of_must, only = CGMatchConclusion.get_constraints metasenv ey ty in
let must = choose_must list_of_must only in
let result =
let prova_tac =
let apply_T_tac ~status:((proof,goal) as status) =
let curi,metasenv,pbo,pty = proof in
- let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let metano,context,gty = CicUtil.lookup_meta goal metasenv in
let rel =
let rec find n =
function
let module R = CicReduction in
let module S = CicSubstitution in
let _,metasenv,_,_ = proof in
- let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
let rec find n = function
hd::tl ->
(match hd with
let module P = PrimitiveTactics in
let module T = Tacticals in
let _,metasenv,_,_ = proof in
- let _,context,ty = List.find (function (m,_,_) -> m=goal) metasenv in
+ let _,context,ty = CicUtil.lookup_meta goal metasenv in
let typ =
match terms with
[] -> assert false