--- /dev/null
+(* Copyright (C) 2002, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+open CicReduction
+open PrimitiveTactics
+open ProofEngineTypes
+open UriManager
+
+(** DEBUGGING *)
+
+ (** perform debugging output? *)
+let debug = false
+
+ (** debugging print *)
+let warn s =
+ if debug then
+ prerr_endline ("RING WARNING: " ^ s)
+
+(** CIC URIS *)
+
+(**
+ Note: For constructors URIs aren't really URIs but rather triples of
+ the form (uri, typeno, consno). This discrepancy is to preserver an
+ uniformity of invocation of "mkXXX" functions.
+*)
+
+let eqt_uri = uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind"
+let refl_eqt_uri = (eqt_uri, 0, 1)
+let sym_eqt_uri =
+ uri_of_string "cic:/Coq/Init/Logic_Type/Equality_is_a_congruence/sym_eqT.con"
+let bool_uri = uri_of_string "cic:/Coq/Init/Datatypes/bool.ind"
+let true_uri = (bool_uri, 0, 1)
+let false_uri = (bool_uri, 0, 2)
+
+let r_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/R.con"
+let rplus_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/Rplus.con"
+let rmult_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/Rmult.con"
+let ropp_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/Ropp.con"
+let r0_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/R0.con"
+let r1_uri = uri_of_string "cic:/Coq/Reals/Rdefinitions/R1.con"
+let rtheory_uri = uri_of_string "cic:/Coq/Reals/Rbase/RTheory.con"
+
+let apolynomial_uri =
+ uri_of_string
+ "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial.ind"
+let apvar_uri = (apolynomial_uri, 0, 1)
+let ap0_uri = (apolynomial_uri, 0, 2)
+let ap1_uri = (apolynomial_uri, 0, 3)
+let applus_uri = (apolynomial_uri, 0, 4)
+let apmult_uri = (apolynomial_uri, 0, 5)
+let apopp_uri = (apolynomial_uri, 0, 6)
+
+let varmap_uri =
+ uri_of_string "cic:/Coq/ring/Quote/variables_map/varmap.ind"
+let empty_vm_uri = (varmap_uri, 0, 1)
+let node_vm_uri = (varmap_uri, 0, 2)
+let varmap_find_uri =
+ uri_of_string "cic:/Coq/ring/Quote/variables_map/varmap_find.con"
+let index_uri =
+ uri_of_string "cic:/Coq/ring/Quote/variables_map/index.ind"
+let left_idx_uri = (index_uri, 0, 1)
+let right_idx_uri = (index_uri, 0, 2)
+let end_idx_uri = (index_uri, 0, 3)
+
+let interp_ap_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/interp_ap.con"
+let interp_sacs_uri =
+ uri_of_string "cic:/Coq/ring/Ring_abstract/abstract_rings/interp_sacs.con"
+let apolynomial_normalize_uri =
+ uri_of_string
+ "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial_normalize.con"
+let apolynomial_normalize_ok_uri =
+ uri_of_string
+ "cic:/Coq/ring/Ring_abstract/abstract_rings/apolynomial_normalize_ok.con"
+
+(** HELPERS *)
+
+ (**
+ "Some" constructor's inverse
+ @raise Failure "unsome" if None is passed
+ *)
+let unsome = function None -> failwith "unsome" | Some item -> item
+
+(** CIC PREDICATES *)
+
+ (**
+ check whether a term is a constant or not, if argument "uri" is given and is
+ not "None" also check if the constant correspond to the given one or not
+ *)
+let cic_is_const ?(uri: uri option = None) term =
+ match uri with
+ | None ->
+ (match term with
+ | Cic.Const _ -> true
+ | _ -> false)
+ | Some realuri ->
+ (match term with
+ | Cic.Const (u, _) when (eq u realuri) -> true
+ | _ -> false)
+
+(** PROOF AND GOAL ACCESSORS *)
+
+ (**
+ @param proof a proof
+ @return the uri of a given proof
+ *)
+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
+ @return current goal's metasenv
+ *)
+let metasenv_of_status ~status:(proof, goal) =
+ match proof with
+ | None -> failwith "Ring.metasenv_of_status invoked on None goal"
+ | Some (_, m, _, _) -> m
+
+ (**
+ @param status a proof engine status
+ @raise Failure when proof or goal are None
+ @return context corresponding to current goal
+ *)
+let context_of_status ~status:(proof, goal) =
+ let metasenv = metasenv_of_status ~status:(proof, goal) in
+ let _, context, _ =
+ match goal with
+ | None -> failwith "Ring.context_of_status invoked on None goal"
+ | Some metano -> List.find (function (m,_,_) -> m=metano) metasenv
+ in
+ context
+
+(** CIC TERM CONSTRUCTORS *)
+
+ (**
+ Create a Cic term consisting of a constant
+ @param uri URI of the constant
+ @proof current proof
+ *)
+let mkConst ~uri ~proof =
+ let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
+ Cic.Const (uri, cookingsno)
+
+ (**
+ Create a Cic term consisting of a constructor
+ @param uri triple <uri, typeno, consno> where uri is the uri of an inductive
+ type, typeno is the type number in a mutind structure (0 based), consno is
+ the constructor number (1 based)
+ @param proof current proof
+ *)
+let mkCtor ~uri:(uri, typeno, consno) ~proof =
+ let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
+ Cic.MutConstruct (uri, cookingsno, typeno, consno)
+
+ (**
+ Create a Cic term consisting of a type member of a mutual induction
+ @param uri pair <uri, typeno> where uri is the uri of a mutual inductive
+ type and typeno is the type number (0 based) in the mutual induction
+ *)
+let mkMutInd ~uri:(uri, typeno) ~proof =
+ let cookingsno = relative_depth (uri_of_proof ~proof) uri 0 in
+ Cic.MutInd (uri, cookingsno, typeno)
+
+(** EXCEPTIONS *)
+
+ (**
+ raised when the current goal is not ringable; a goal is ringable when is an
+ equality on reals (@see r_uri)
+ *)
+exception GoalUnringable
+
+(** RING's FUNCTIONS LIBRARY *)
+
+ (**
+ Check whether the ring tactic can be applied on a given term (i.e. that is
+ an equality on reals)
+ @param term term to be tested
+ @return true if the term is ringable, false otherwise
+ *)
+let ringable =
+ let is_equality = function
+ | Cic.MutInd uri _ 0 when (eq uri eqt_uri) -> true
+ | _ -> false
+ in
+ let is_real = function
+ | Cic.Const (uri, _) when (eq uri r_uri) -> true
+ | _ -> false
+ in
+ function
+ | Cic.Appl (app::set::_::_::[]) when (is_equality app && is_real set) ->
+ warn "Goal Ringable!";
+ true
+ | _ ->
+ warn "Goal Not Ringable :-((";
+ false
+
+ (**
+ split an equality goal of the form "t1 = t2" in its two subterms t1 and t2
+ after checking that the goal is ringable
+ @param goal the current goal
+ @return a pair (t1,t2) that are two sides of the equality goal
+ @raise GoalUnringable if the goal isn't ringable
+ *)
+let split_eq = function
+ | (Cic.Appl (_::_::t1::t2::[])) as term when ringable term ->
+ warn ("<term1>" ^ (CicPp.ppterm t1) ^ "</term1>");
+ warn ("<term2>" ^ (CicPp.ppterm t2) ^ "</term2>");
+ (t1, t2)
+ | _ -> raise GoalUnringable
+
+ (**
+ @param i an integer index representing a 1 based number of node in a binary
+ search tree counted in a fbs manner (i.e.: 1 is the root, 2 is the left
+ child of the root (if any), 3 is the right child of the root (if any), 4 is
+ the left child of the left child of the root (if any), ....)
+ @param proof the current proof
+ @return an index representing the same node in a varmap (@see varmap_uri),
+ the returned index is as defined in index (@see index_uri)
+ *)
+let path_of_int n proof =
+ let rec digits_of_int n =
+ if n=1 then [] else (n mod 2 = 1)::(digits_of_int (n lsr 1))
+ in
+ List.fold_right
+ (fun digit path ->
+ Cic.Appl [
+ mkCtor (if (digit = true) then right_idx_uri else left_idx_uri) proof;
+ path])
+ (List.rev (digits_of_int n)) (* remove leading true (i.e. digit 1) *)
+ (mkCtor end_idx_uri proof)
+
+ (**
+ Build a variable map (@see varmap_uri) from a variables array.
+ A variable map is almost a binary tree so this function receiving a var list
+ like [v;w;x;y;z] will build a varmap of shape: v
+ / \
+ w x
+ / \
+ y z
+ @param vars variables array
+ @param proof current proof
+ @return a cic term representing the variable map containing vars variables
+ *)
+let btree_of_array ~vars ~proof =
+ let r = mkConst r_uri proof in (* cic objects *)
+ let empty_vm = mkCtor empty_vm_uri proof in
+ let empty_vm_r = Cic.Appl [empty_vm; r] in
+ let node_vm = mkCtor node_vm_uri proof in
+ let node_vm_r = Cic.Appl [node_vm; r] in
+ let size = Array.length vars in
+ let halfsize = size lsr 1 in
+ let rec aux n = (* build the btree starting from position n *)
+ (*
+ n is the position in the vars array _1_based_ in order to access
+ left and right child using (n*2, n*2+1) trick
+ *)
+ if n > size then
+ empty_vm_r
+ else if n > halfsize then (* no more children *)
+ Cic.Appl [node_vm; r; vars.(n-1); empty_vm_r; empty_vm_r]
+ else (* still children *)
+ Cic.Appl [node_vm; r; vars.(n-1); aux (n*2); aux (n*2+1)]
+ in
+ aux 1
+
+ (**
+ abstraction function:
+ concrete polynoms -----> (abstract polynoms, varmap)
+ @param terms list of conrete polynoms
+ @param proof current proof
+ @return a pair <aterms, varmap> where aterms is a list of abstract polynoms
+ and varmap is the variable map needed to interpret them
+ *)
+let abstract_poly ~terms ~proof =
+ let varhash = Hashtbl.create 19 in (* vars hash, to speed up lookup *)
+ let varlist = ref [] in (* vars list in reverse order *)
+ let counter = ref 1 in (* index of next new variable *)
+ let rec aux = function (* TODO not tail recursive *)
+ (* "bop" -> binary operator | "uop" -> unary operator *)
+ | Cic.Appl (bop::t1::t2::[])
+ when (cic_is_const ~uri:(Some rplus_uri) bop) -> (* +. *)
+ Cic.Appl [mkCtor applus_uri proof; aux t1; aux t2]
+ | Cic.Appl (bop::t1::t2::[])
+ when (cic_is_const ~uri:(Some rmult_uri) bop) -> (* *. *)
+ Cic.Appl [mkCtor apmult_uri proof; aux t1; aux t2]
+ | Cic.Appl (uop::t::[])
+ when (cic_is_const ~uri:(Some ropp_uri) uop) -> (* ~-. *)
+ Cic.Appl [mkCtor apopp_uri proof; aux t]
+ | t when (cic_is_const ~uri:(Some r0_uri) t) -> (* 0. *)
+ mkCtor ap0_uri proof
+ | t when (cic_is_const ~uri:(Some r1_uri) t) -> (* 1. *)
+ mkCtor ap1_uri proof
+ | t -> (* variable *)
+ try
+ Hashtbl.find varhash t (* use an old var *)
+ with Not_found -> begin (* create a new var *)
+ let newvar =
+ Cic.Appl [mkCtor apvar_uri proof; path_of_int !counter proof]
+ in
+ incr counter;
+ varlist := t :: !varlist;
+ Hashtbl.add varhash t newvar;
+ newvar
+ end
+ in
+ (List.map aux terms,
+ btree_of_array ~vars:(Array.of_list (List.rev !varlist)) ~proof)
+
+ (**
+ given a list of abstract terms (i.e. apolynomials) build the ring "segments"
+ that is triples like (t', t'', t''') where
+ t' = interp_ap(varmap, at)
+ t'' = interp_sacs(varmap, (apolynomial_normalize at))
+ t''' = apolynomial_normalize_ok(varmap, at)
+ at is the abstract term built from t, t is a single member of aterms
+ *)
+let build_segments ~terms ~proof =
+ let r = mkConst r_uri proof in (* cic objects *)
+ let rplus = mkConst rplus_uri proof in
+ let rmult = mkConst rmult_uri proof in
+ let ropp = mkConst ropp_uri proof in
+ let r0 = mkConst r0_uri proof in
+ let r1 = mkConst r1_uri proof in
+ let interp_ap = mkConst interp_ap_uri proof in
+ let interp_sacs = mkConst interp_sacs_uri proof in
+ let apolynomial_normalize = mkConst apolynomial_normalize_uri proof in
+ let apolynomial_normalize_ok = mkConst apolynomial_normalize_ok_uri proof in
+ let rtheory = mkConst rtheory_uri proof in
+ let lxy_false = (** Cic funcion "fun (x,y):R -> false" *)
+ Cic.Lambda (Cic.Anonimous, r,
+ Cic.Lambda (Cic.Anonimous, r,
+ mkCtor false_uri proof))
+ in
+ let theory_args = [r; rplus; rmult; r1; r0; ropp] in
+ let (aterms, varmap) = abstract_poly ~terms ~proof in (* abstract polys *)
+ List.map (* build ring segments *)
+ (fun t ->
+ Cic.Appl ((interp_ap :: theory_args) @ [varmap; t]),
+ Cic.Appl (
+ interp_sacs ::
+ (theory_args @
+ [varmap; Cic.Appl [apolynomial_normalize; t]])),
+ Cic.Appl (
+ (apolynomial_normalize_ok :: theory_args) @
+ [lxy_false; varmap; rtheory; t]))
+ aterms
+
+(** AUX TACTIC{,AL}S *)
+
+ (**
+ naive implementation of ORELSE tactical, try a sequence of tactics in turn:
+ if one fails pass to the next one and so on, eventually raises (failure "no
+ tactics left")
+ TODO warning: not tail recursive due to "try .. with" boxing
+ *)
+let rec try_tactics ~(tactics: (string * tactic) list) ~status =
+ warn "in Ring.try_tactics";
+ match tactics with
+ | (descr, tac)::tactics ->
+ warn ("Ring.try_tactics IS TRYING " ^ descr);
+ (try
+ let res = tac ~status in
+ warn ("Ring.try_tactics: " ^ descr ^ " succedeed!!!");
+ res
+ with
+ | (Fail _) as e -> begin (* TODO: codice replicato perche' non funge il
+ binding multiplo con "as" *)
+ warn (
+ "Ring.try_tactics failed with exn: " ^
+ Printexc.to_string e);
+ try_tactics ~tactics ~status
+ end
+ | (CicTypeChecker.NotWellTyped _) as e -> begin (* TODO: si puo' togliere? *)
+ warn (
+ "Ring.try_tactics failed with exn: " ^
+ Printexc.to_string e);
+ try_tactics ~tactics ~status
+ end
+ | (CicUnification.UnificationFailed) as e -> begin
+ warn (
+ "Ring.try_tactics failed with exn: " ^
+ Printexc.to_string e);
+ try_tactics ~tactics ~status
+ end
+ )
+ | [] -> raise (Fail "try_tactics: no tactics left")
+
+ (**
+ auxiliary tactic "elim_type"
+ @param status current proof engine status
+ @param term term to cut
+ *)
+let elim_type_tac ~status ~term =
+ warn "in Ring.elim_type_tac";
+ let status' = cut_tac ~term ~status in
+ elim_intros_simpl_tac ~term:(Cic.Rel 1) ~status:status'
+
+ (**
+ move to next goal
+ @param status current proof engine status
+ *)
+let next_goal ~status =
+ warn "in Ring.next_goal";
+ (match status with
+ | ((Some (_, metasenv, _, _)) as proof, goal) ->
+ (match metasenv with
+ | _::(n, _, _)::_ -> (proof, Some n)
+ | _ -> raise (Fail "No other goal available"))
+ | _ -> assert false)
+
+ (**
+ auxiliary tactic, use elim_type and try to close 2nd subgoal using proof
+ @param status current proof engine status
+ @param term term to cut
+ @param proof term used to prove second subgoal generated by elim_type
+ *)
+let elim_type2_tac ~status ~term ~proof =
+ exact_tac ~term:proof ~status:(next_goal (elim_type_tac ~term ~status))
+
+ (**
+ Reflexivity tactic, try to solve current goal using "refl_eqT"
+ Warning: this isn't equale to the coq's Reflexivity because this one tries
+ only refl_eqT, coq's one also try "refl_equal"
+ @param status current proof engine status
+ *)
+let reflexivity_tac ~status:(proof, goal) =
+ warn "in Ring.reflexivity_tac";
+ let refl_eqt = mkCtor ~uri:refl_eqt_uri ~proof:(unsome proof) in
+ try
+ apply_tac ~status:(proof, goal) ~term:refl_eqt
+ with (Fail _) as e ->
+ let e_str = Printexc.to_string e in
+ raise (Fail ("Reflexivity failed with exception: " ^ e_str))
+
+ (** lift an 8-uple of debrujins indexes of n *)
+let lift ~n (a,b,c,d,e,f,g,h) =
+ match (List.map (CicSubstitution.lift n) [a;b;c;d;e;f;g;h]) with
+ | [a;b;c;d;e;f;g;h] -> (a,b,c,d,e,f,g,h)
+ | _ -> assert false
+
+ (**
+ remove hypothesis from a given status starting from the last one
+ @param count number of hypotheses to remove
+ @param status current proof engine status
+ *)
+let purge_hyps ~count ~status:(proof, goal) =
+ let module S = ProofEngineStructuralRules in
+ let rec aux n context status =
+ assert(n>=0);
+ match (n, context) with
+ | (0, _) -> status
+ | (n, hd::tl) -> aux (n-1) tl (S.clear ~status ~hyp:hd)
+ | (_, []) -> failwith "Ring.purge_hyps: no hypotheses left"
+ in
+ let metano =
+ match goal with
+ | None -> failwith "Ring.purge_hyps invoked on None goal"
+ | Some n -> n
+ in
+ match proof with
+ | None -> failwith "Ring.purge_hyps invoked on None proof"
+ | Some (_, metasenv, _, _) ->
+ let (_, context, _) = conj_of_metano metano metasenv in
+ aux count context (proof, goal)
+
+(** THE TACTIC! *)
+
+ (**
+ Ring tactic, does associative and commutative rewritings in Reals ring
+ @param status current proof engine status
+ *)
+let ring_tac ~status:(proof, goal) =
+ warn "in Ring tactic";
+ let status = (proof, goal) in
+ let (proof, goal) = (unsome proof), (unsome goal) in
+ let eqt = mkMutInd (eqt_uri, 0) proof in
+ let r = mkConst r_uri proof in
+ let metasenv = metasenv_of_status ~status in
+ let (metano, context, ty) = conj_of_metano goal metasenv in
+ let (t1, t2) = split_eq ty in (* goal like t1 = t2 *)
+ match (build_segments ~terms:[t1; t2] ~proof) with
+ | (t1', t1'', t1'_eq_t1'')::(t2', t2'', t2'_eq_t2'')::[] -> begin
+ List.iter (* debugging, feel free to remove *)
+ (fun (descr, term) ->
+ warn (descr ^ " " ^ (CicPp.ppterm term)))
+ (List.combine
+ ["t1"; "t1'"; "t1''"; "t1'_eq_t1''";
+ "t2"; "t2'"; "t2''"; "t2'_eq_t2''"]
+ [t1; t1'; t1''; t1'_eq_t1'';
+ t2; t2'; t2''; t2'_eq_t2'']);
+ try
+ let new_hyps = ref 0 in (* number of new hypotheses created *)
+ try_tactics
+ ~status
+ ~tactics:[
+ "reflexivity", reflexivity_tac;
+ "exact t1'_eq_t1''", exact_tac ~term:t1'_eq_t1'';
+ "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'';
+ "exact sym_eqt su t1 ...", exact_tac ~term:(
+ Cic.Appl [
+ mkConst sym_eqt_uri proof; mkConst r_uri proof;
+ t1''; t1; t1'_eq_t1'']);
+ "elim_type eqt su t1 ...", (fun ~status ->
+ let status' = (* status after 1st elim_type use *)
+ let context = context_of_status ~status in
+ if not (are_convertible context t1'' t1) then begin
+ warn "t1'' and t1 are NOT CONVERTIBLE";
+ let newstatus =
+ elim_type2_tac (* 1st elim_type use *)
+ ~status ~proof:t1'_eq_t1''
+ ~term:(Cic.Appl [eqt; r; t1''; t1])
+ in
+ incr new_hyps; (* elim_type add an hyp *)
+ newstatus
+ end else begin
+ warn "t1'' and t1 are CONVERTIBLE";
+ status
+ end
+ in
+ let (t1,t1',t1'',t1'_eq_t1'',t2,t2',t2'',t2'_eq_t2'') =
+ lift 1 (t1,t1',t1'',t1'_eq_t1'', t2,t2',t2'',t2'_eq_t2'')
+ in
+ let status'' =
+ try_tactics (* try to solve 1st subgoal *)
+ ~status:status'
+ ~tactics:[
+ "exact t2'_eq_t2''", exact_tac ~term:t2'_eq_t2'';
+ "exact sym_eqt su t2 ...",
+ exact_tac ~term:(
+ Cic.Appl [
+ mkConst sym_eqt_uri proof;
+ mkConst r_uri proof;
+ t2''; t2; t2'_eq_t2'']);
+ "elim_type eqt su t2 ...", (fun ~status ->
+ let status' =
+ let context = context_of_status ~status in
+ if not (are_convertible context t2'' t2) then begin
+ warn "t2'' and t2 are NOT CONVERTIBLE";
+ let newstatus =
+ elim_type2_tac (* 2nd elim_type use *)
+ ~status ~proof:t2'_eq_t2''
+ ~term:(Cic.Appl [eqt; r; t2''; t2])
+ in
+ incr new_hyps; (* elim_type add an hyp *)
+ newstatus
+ end else begin
+ warn "t2'' and t2 are CONVERTIBLE";
+ status
+ end
+ in
+ try (* try to solve main goal *)
+ warn "trying reflexivity ....";
+ reflexivity_tac ~status:status'
+ with (Fail _) -> (* leave conclusion to the user *)
+ warn "reflexivity failed, solution's left as an ex :-)";
+ purge_hyps ~count:!new_hyps ~status:status')]
+ in
+ status'')]
+ with (Fail _) ->
+ raise (Fail "Ring failure")
+ end
+ | _ -> (* impossible: we are applying ring exacty to 2 terms *)
+ assert false
+
+ (* wrap ring_tac catching GoalUnringable and raising Fail *)
+let ring_tac ~status =
+ try
+ ring_tac ~status
+ with GoalUnringable ->
+ raise (Fail "goal unringable")
+
projects / helm.git / blobdiff