diff options
author | glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2010-09-28 15:32:17 +0000 |
---|---|---|
committer | glondu <glondu@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2010-09-28 15:32:17 +0000 |
commit | 8b78dec71c7922ab335a554d28b320423efbb9d3 (patch) | |
tree | d8cd3e6744cd3e99a608c53baa0ba04b6288922c /plugins | |
parent | 5754edd0bfc8c38cee2e721ef8d2130c97664f05 (diff) |
Remove some occurrences of "open Termops"
Functions from Termops were sometimes fully qualified, sometimes not
in the same module. This commit makes their usage more uniform.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13470 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'plugins')
-rw-r--r-- | plugins/cc/cctac.ml | 39 | ||||
-rw-r--r-- | plugins/dp/dp.ml | 9 | ||||
-rw-r--r-- | plugins/funind/functional_principles_proofs.ml | 25 | ||||
-rw-r--r-- | plugins/funind/functional_principles_types.ml | 23 | ||||
-rw-r--r-- | plugins/funind/invfun.ml | 3 | ||||
-rw-r--r-- | plugins/funind/recdef.ml | 31 | ||||
-rw-r--r-- | plugins/omega/coq_omega.ml | 3 | ||||
-rw-r--r-- | plugins/rtauto/refl_tauto.ml | 5 | ||||
-rw-r--r-- | plugins/setoid_ring/newring.ml4 | 3 | ||||
-rw-r--r-- | plugins/subtac/subtac_classes.ml | 1 | ||||
-rw-r--r-- | plugins/subtac/subtac_command.ml | 3 | ||||
-rw-r--r-- | plugins/subtac/subtac_pretyping_F.ml | 17 | ||||
-rw-r--r-- | plugins/subtac/subtac_utils.ml | 13 |
13 files changed, 81 insertions, 94 deletions
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml index 1054b6ecd..ec31f8917 100644 --- a/plugins/cc/cctac.ml +++ b/plugins/cc/cctac.ml @@ -18,7 +18,6 @@ open Nameops open Inductiveops open Declarations open Term -open Termops open Tacmach open Tactics open Tacticals @@ -64,8 +63,8 @@ let rec decompose_term env sigma t= let tf=decompose_term env sigma f in let targs=Array.map (decompose_term env sigma) args in Array.fold_left (fun s t->Appli (s,t)) tf targs - | Prod (_,a,_b) when not (dependent (mkRel 1) _b) -> - let b = pop _b in + | Prod (_,a,_b) when not (Termops.dependent (mkRel 1) _b) -> + let b = Termops.pop _b in let sort_b = sf_of env sigma b in let sort_a = sf_of env sigma a in Appli(Appli(Product (sort_a,sort_b) , @@ -111,8 +110,8 @@ let rec pattern_of_constr env sigma c = (array_map_to_list (pattern_of_constr env sigma) args) in PApp (pf,List.rev pargs), List.fold_left Intset.union Intset.empty lrels - | Prod (_,a,_b) when not (dependent (mkRel 1) _b) -> - let b =pop _b in + | Prod (_,a,_b) when not (Termops.dependent (mkRel 1) _b) -> + let b = Termops.pop _b in let pa,sa = pattern_of_constr env sigma a in let pb,sb = pattern_of_constr env sigma b in let sort_b = sf_of env sigma b in @@ -258,19 +257,19 @@ let rec proof_tac p gls = | SymAx c -> let l=constr_of_term p.p_lhs and r=constr_of_term p.p_rhs in - let typ = refresh_universes (pf_type_of gls l) in + let typ = Termops.refresh_universes (pf_type_of gls l) in exact_check (mkApp(Lazy.force _sym_eq,[|typ;r;l;c|])) gls | Refl t -> let lr = constr_of_term t in - let typ = refresh_universes (pf_type_of gls lr) in + let typ = Termops.refresh_universes (pf_type_of gls lr) in exact_check (mkApp(Lazy.force _refl_equal,[|typ;constr_of_term t|])) gls | Trans (p1,p2)-> let t1 = constr_of_term p1.p_lhs and t2 = constr_of_term p1.p_rhs and t3 = constr_of_term p2.p_rhs in - let typ = refresh_universes (pf_type_of gls t2) in + let typ = Termops.refresh_universes (pf_type_of gls t2) in let prf = mkApp(Lazy.force _trans_eq,[|typ;t1;t2;t3;_M 1;_M 2|]) in tclTHENS (refine prf) [(proof_tac p1);(proof_tac p2)] gls @@ -279,9 +278,9 @@ let rec proof_tac p gls = and tx1=constr_of_term p2.p_lhs and tf2=constr_of_term p1.p_rhs and tx2=constr_of_term p2.p_rhs in - let typf = refresh_universes (pf_type_of gls tf1) in - let typx = refresh_universes (pf_type_of gls tx1) in - let typfx = refresh_universes (pf_type_of gls (mkApp (tf1,[|tx1|]))) in + let typf = Termops.refresh_universes (pf_type_of gls tf1) in + let typx = Termops.refresh_universes (pf_type_of gls tx1) in + let typfx = Termops.refresh_universes (pf_type_of gls (mkApp (tf1,[|tx1|]))) in let id = pf_get_new_id (id_of_string "f") gls in let appx1 = mkLambda(Name id,typf,mkApp(mkRel 1,[|tx1|])) in let lemma1 = @@ -309,8 +308,8 @@ let rec proof_tac p gls = let ti=constr_of_term prf.p_lhs in let tj=constr_of_term prf.p_rhs in let default=constr_of_term p.p_lhs in - let intype=refresh_universes (pf_type_of gls ti) in - let outtype=refresh_universes (pf_type_of gls default) in + let intype = Termops.refresh_universes (pf_type_of gls ti) in + let outtype = Termops.refresh_universes (pf_type_of gls default) in let special=mkRel (1+nargs-argind) in let proj=build_projection intype outtype cstr special default gls in let injt= @@ -319,7 +318,7 @@ let rec proof_tac p gls = let refute_tac c t1 t2 p gls = let tt1=constr_of_term t1 and tt2=constr_of_term t2 in - let intype=refresh_universes (pf_type_of gls tt1) in + let intype = Termops.refresh_universes (pf_type_of gls tt1) in let neweq= mkApp(Lazy.force _eq, [|intype;tt1;tt2|]) in @@ -330,7 +329,7 @@ let refute_tac c t1 t2 p gls = let convert_to_goal_tac c t1 t2 p gls = let tt1=constr_of_term t1 and tt2=constr_of_term t2 in - let sort=refresh_universes (pf_type_of gls tt2) in + let sort = Termops.refresh_universes (pf_type_of gls tt2) in let neweq=mkApp(Lazy.force _eq,[|sort;tt1;tt2|]) in let e=pf_get_new_id (id_of_string "e") gls in let x=pf_get_new_id (id_of_string "X") gls in @@ -350,14 +349,14 @@ let convert_to_hyp_tac c1 t1 c2 t2 p gls = let discriminate_tac cstr p gls = let t1=constr_of_term p.p_lhs and t2=constr_of_term p.p_rhs in - let intype=refresh_universes (pf_type_of gls t1) in + let intype = Termops.refresh_universes (pf_type_of gls t1) in let concl=pf_concl gls in - let outsort=mkType (new_univ ()) in + let outsort = mkType (Termops.new_univ ()) in let xid=pf_get_new_id (id_of_string "X") gls in let tid=pf_get_new_id (id_of_string "t") gls in let identity=mkLambda(Name xid,outsort,mkLambda(Name tid,mkRel 1,mkRel 1)) in let trivial=pf_type_of gls identity in - let outtype=mkType (new_univ ()) in + let outtype = mkType (Termops.new_univ ()) in let pred=mkLambda(Name xid,outtype,mkRel 1) in let hid=pf_get_new_id (id_of_string "Heq") gls in let proj=build_projection intype outtype cstr trivial concl gls in @@ -412,7 +411,7 @@ let cc_tactic depth additionnal_terms gls= str "\"congruence with (" ++ prlist_with_sep (fun () -> str ")" ++ pr_spc () ++ str "(") - (print_constr_env (pf_env gls)) + (Termops.print_constr_env (pf_env gls)) terms_to_complete ++ str ")\"," end); @@ -454,7 +453,7 @@ let simple_reflexivity () = apply (Lazy.force _refl_equal) let f_equal gl = let cut_eq c1 c2 = - let ty = refresh_universes (pf_type_of gl c1) in + let ty = Termops.refresh_universes (pf_type_of gl c1) in tclTHENTRY (Tactics.cut (mkApp (Lazy.force _eq, [|ty; c1; c2|]))) (simple_reflexivity ()) diff --git a/plugins/dp/dp.ml b/plugins/dp/dp.ml index b800170de..22ae4aaf9 100644 --- a/plugins/dp/dp.ml +++ b/plugins/dp/dp.ml @@ -23,7 +23,6 @@ open Fol open Names open Nameops open Namegen -open Termops open Coqlib open Hipattern open Libnames @@ -148,7 +147,7 @@ let fresh_var = function env names, and returns the new variables together with the new environment *) let coq_rename_vars env vars = - let avoid = ref (ids_of_named_context (Environ.named_context env)) in + let avoid = ref (Termops.ids_of_named_context (Environ.named_context env)) in List.fold_right (fun (na,t) (newvars, newenv) -> let id = next_name_away na !avoid in @@ -183,7 +182,7 @@ let decomp_type_lambdas env t = let decompose_arrows = let rec arrows_rec l c = match kind_of_term c with - | Prod (_,t,c) when not (dependent (mkRel 1) c) -> arrows_rec (t :: l) c + | Prod (_,t,c) when not (Termops.dependent (mkRel 1) c) -> arrows_rec (t :: l) c | Cast (c,_,_) -> arrows_rec l c | _ -> List.rev l, c in @@ -195,8 +194,8 @@ let rec eta_expanse t vars env i = t, vars, env else match kind_of_term (Typing.type_of env Evd.empty t) with - | Prod (n, a, b) when not (dependent (mkRel 1) b) -> - let avoid = ids_of_named_context (Environ.named_context env) in + | Prod (n, a, b) when not (Termops.dependent (mkRel 1) b) -> + let avoid = Termops.ids_of_named_context (Environ.named_context env) in let id = next_name_away n avoid in let env' = Environ.push_named (id, None, a) env in let t' = mkApp (t, [| mkVar id |]) in diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml index bc12fcea9..43658e802 100644 --- a/plugins/funind/functional_principles_proofs.ml +++ b/plugins/funind/functional_principles_proofs.ml @@ -1,7 +1,6 @@ open Printer open Util open Term -open Termops open Namegen open Names open Declarations @@ -263,7 +262,7 @@ let change_eq env sigma hyp_id (context:rel_context) x t end_of_type = in let sub = compute_substitution Intmap.empty (snd t1) (snd t2) in let sub = compute_substitution sub (fst t1) (fst t2) in - let end_of_type_with_pop = pop end_of_type in (*the equation will be removed *) + let end_of_type_with_pop = Termops.pop end_of_type in (*the equation will be removed *) let new_end_of_type = (* Ugly hack to prevent Map.fold order change between ocaml-3.08.3 and ocaml-3.08.4 Can be safely replaced by the next comment for Ocaml >= 3.08.4 @@ -286,7 +285,7 @@ let change_eq env sigma hyp_id (context:rel_context) x t end_of_type = try let witness = Intmap.find i sub in if b' <> None then anomaly "can not redefine a rel!"; - (pop end_of_type,ctxt_size,mkLetIn(x',witness,t',witness_fun)) + (Termops.pop end_of_type,ctxt_size,mkLetIn(x',witness,t',witness_fun)) with Not_found -> (mkProd_or_LetIn decl end_of_type, ctxt_size + 1, mkLambda_or_LetIn decl witness_fun) ) @@ -411,7 +410,7 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma = begin let pte,pte_args = (destApp t_x) in let (* fix_info *) prove_rec_hyp = (Idmap.find (destVar pte) ptes_infos).proving_tac in - let popped_t' = pop t' in + let popped_t' = Termops.pop t' in let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in let prove_new_type_of_hyp = let context_length = List.length context in @@ -461,7 +460,7 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma = (* observe (str "In "++Ppconstr.pr_id hyp_id++ *) (* str " removing useless precond True" *) (* ); *) - let popped_t' = pop t' in + let popped_t' = Termops.pop t' in let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in @@ -489,7 +488,7 @@ let clean_hyp_with_heq ptes_infos eq_hyps hyp_id env sigma = ] else if is_trivial_eq t_x then (* t_x := t = t => we remove this precond *) - let popped_t' = pop t' in + let popped_t' = Termops.pop t' in let real_type_of_hyp = it_mkProd_or_LetIn popped_t' context in @@ -589,7 +588,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos = let fun_body = mkLambda(Anonymous, pf_type_of g' term, - replace_term term (mkRel 1) dyn_infos.info + Termops.replace_term term (mkRel 1) dyn_infos.info ) in let new_body = pf_nf_betaiota g' (mkApp(fun_body,[| new_term_value |])) in @@ -909,8 +908,8 @@ let generalize_non_dep hyp g = let to_revert,_ = Environ.fold_named_context_reverse (fun (clear,keep) (hyp,_,_ as decl) -> if List.mem hyp hyps - or List.exists (occur_var_in_decl env hyp) keep - or occur_var env hyp hyp_typ + or List.exists (Termops.occur_var_in_decl env hyp) keep + or Termops.occur_var env hyp hyp_typ or Termops.is_section_variable hyp (* should be dangerous *) then (clear,decl::keep) else (hyp::clear,keep)) @@ -1300,7 +1299,7 @@ let prove_princ_for_struct interactive_proof fun_num fnames all_funs _nparams : in let fname = destConst (fst (decompose_app (List.hd (List.rev pte_args)))) in tclTHENSEQ - [unfold_in_concl [(all_occurrences,Names.EvalConstRef fname)]; + [unfold_in_concl [(Termops.all_occurrences, Names.EvalConstRef fname)]; let do_prove = build_proof interactive_proof @@ -1400,7 +1399,7 @@ let build_clause eqs = { Tacexpr.onhyps = Some (List.map - (fun id -> (Rawterm.all_occurrences_expr,id),InHyp) + (fun id -> (Rawterm.all_occurrences_expr, id), Termops.InHyp) eqs ); Tacexpr.concl_occs = Rawterm.no_occurrences_expr @@ -1416,7 +1415,7 @@ let rec rewrite_eqs_in_eqs eqs = (fun id gl -> observe_tac (Format.sprintf "rewrite %s in %s " (string_of_id eq) (string_of_id id)) - (tclTRY (Equality.general_rewrite_in true all_occurrences (* dep proofs also: *) true id (mkVar eq) false)) + (tclTRY (Equality.general_rewrite_in true Termops.all_occurrences (* dep proofs also: *) true id (mkVar eq) false)) gl ) eqs @@ -1438,7 +1437,7 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_hyps eqs : tactic = (fun g -> if is_mes then - unfold_in_concl [(all_occurrences, evaluable_of_global_reference (delayed_force ltof_ref))] g + unfold_in_concl [(Termops.all_occurrences, evaluable_of_global_reference (delayed_force ltof_ref))] g else tclIDTAC g ); observe_tac "rew_and_finish" diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml index e0b08599d..6034f19e6 100644 --- a/plugins/funind/functional_principles_types.ml +++ b/plugins/funind/functional_principles_types.ml @@ -1,7 +1,6 @@ open Printer open Util open Term -open Termops open Namegen open Names open Declarations @@ -139,7 +138,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type = in let dummy_var = mkVar (id_of_string "________") in let mk_replacement c i args = - let res = mkApp(rel_to_fun.(i),Array.map pop (array_get_start args)) in + let res = mkApp(rel_to_fun.(i), Array.map Termops.pop (array_get_start args)) in (* observe (str "replacing " ++ pr_lconstr c ++ str " by " ++ pr_lconstr res); *) res in @@ -198,58 +197,58 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type = begin try let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in - let new_x : name = get_name (ids_of_context env) x in + let new_x : name = get_name (Termops.ids_of_context env) x in let new_env = Environ.push_rel (x,None,t) env in let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b - then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b + then (Termops.pop new_b), filter_map (eq_constr (mkRel 1)) Termops.pop binders_to_remove_from_b else ( bind_fun(new_x,new_t,new_b), list_union_eq eq_constr binders_to_remove_from_t - (List.map pop binders_to_remove_from_b) + (List.map Termops.pop binders_to_remove_from_b) ) with | Toberemoved -> (* observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in - new_b, List.map pop binders_to_remove_from_b + new_b, List.map Termops.pop binders_to_remove_from_b | Toberemoved_with_rel (n,c) -> (* observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in - new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) + new_b, list_add_set_eq eq_constr (mkRel n) (List.map Termops.pop binders_to_remove_from_b) end and compute_new_princ_type_for_letin remove env x v t b = begin try let new_t,binders_to_remove_from_t = compute_new_princ_type remove env t in let new_v,binders_to_remove_from_v = compute_new_princ_type remove env v in - let new_x : name = get_name (ids_of_context env) x in + let new_x : name = get_name (Termops.ids_of_context env) x in let new_env = Environ.push_rel (x,Some v,t) env in let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b - then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b + then (Termops.pop new_b),filter_map (eq_constr (mkRel 1)) Termops.pop binders_to_remove_from_b else ( mkLetIn(new_x,new_v,new_t,new_b), list_union_eq eq_constr (list_union_eq eq_constr binders_to_remove_from_t binders_to_remove_from_v) - (List.map pop binders_to_remove_from_b) + (List.map Termops.pop binders_to_remove_from_b) ) with | Toberemoved -> (* observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [dummy_var] 1 b) in - new_b, List.map pop binders_to_remove_from_b + new_b, List.map Termops.pop binders_to_remove_from_b | Toberemoved_with_rel (n,c) -> (* observe (str "Decl of "++Ppconstr.pr_name x ++ str " is removed "); *) let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b) in - new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b) + new_b, list_add_set_eq eq_constr (mkRel n) (List.map Termops.pop binders_to_remove_from_b) end and compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc) = let new_e,to_remove_from_e = compute_new_princ_type remove env e diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml index f0ea133c6..24382f875 100644 --- a/plugins/funind/invfun.ml +++ b/plugins/funind/invfun.ml @@ -16,7 +16,6 @@ open Tacticals open Tactics open Indfun_common open Tacmach -open Termops open Sign open Hiddentac @@ -686,7 +685,7 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic = h_generalize (List.map mkVar ids); thin ids ] - else unfold_in_concl [(all_occurrences,Names.EvalConstRef (destConst f))] + else unfold_in_concl [(Termops.all_occurrences, Names.EvalConstRef (destConst f))] in (* The proof of each branche itself *) let ind_number = ref 0 in diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index e329196ac..c42ecac42 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -9,7 +9,6 @@ (*i camlp4deps: "parsing/grammar.cma" i*) open Term -open Termops open Namegen open Environ open Declarations @@ -374,7 +373,7 @@ let rec mk_intros_and_continue thin_intros (extra_eqn:bool) h_intros thin_intros; tclMAP - (fun eq -> tclTRY (Equality.general_rewrite_in true all_occurrences (* deps proofs also: *) true teq eq false)) + (fun eq -> tclTRY (Equality.general_rewrite_in true Termops.all_occurrences (* deps proofs also: *) true teq eq false)) (List.rev eqs); (fun g1 -> let ty_teq = pf_type_of g1 (mkVar teq) in @@ -382,7 +381,7 @@ let rec mk_intros_and_continue thin_intros (extra_eqn:bool) let _,args = try destApp ty_teq with _ -> Pp.msgnl (Printer.pr_goal g1 ++ fnl () ++ pr_id teq ++ str ":" ++ Printer.pr_lconstr ty_teq); assert false in args.(1),args.(2) in - cont_function (mkVar teq::eqs) (replace_term teq_lhs teq_rhs expr) g1 + cont_function (mkVar teq::eqs) (Termops.replace_term teq_lhs teq_rhs expr) g1 ) ] @@ -435,7 +434,7 @@ let tclUSER tac is_mes l g = clear_tac; if is_mes then tclTHEN - (unfold_in_concl [(all_occurrences, evaluable_of_global_reference + (unfold_in_concl [(Termops.all_occurrences, evaluable_of_global_reference (delayed_force ltof_ref))]) tac else tac @@ -534,7 +533,7 @@ let rec list_cond_rewrite k def pmax cond_eqs le_proofs = Nameops.out_name k_na,Nameops.out_name def_na in tclTHENS - (general_rewrite_bindings false all_occurrences + (general_rewrite_bindings false Termops.all_occurrences (* dep proofs also: *) true (mkVar eq, ExplicitBindings[dummy_loc, NamedHyp k_id, mkVar k; @@ -577,7 +576,7 @@ let rec introduce_all_equalities func eqs values specs bound le_proofs observe_tac "refl equal" (apply (delayed_force refl_equal))] g | spec1::specs -> fun g -> - let ids = ids_of_named_context (pf_hyps g) in + let ids = Termops.ids_of_named_context (pf_hyps g) in let p = next_ident_away_in_goal p_id ids in let ids = p::ids in let pmax = next_ident_away_in_goal pmax_id ids in @@ -623,7 +622,7 @@ let rec introduce_all_values concl_tac is_mes acc_inv func context_fn (List.rev values) (List.rev specs) (delayed_force coq_O) [] [])] | arg::args -> (fun g -> - let ids = ids_of_named_context (pf_hyps g) in + let ids = Termops.ids_of_named_context (pf_hyps g) in let rec_res = next_ident_away_in_goal rec_res_id ids in let ids = rec_res::ids in let hspec = next_ident_away_in_goal hspec_id ids in @@ -836,7 +835,7 @@ let rec instantiate_lambda t l = let whole_start (concl_tac:tactic) nb_args is_mes func input_type relation rec_arg_num : tactic = begin fun g -> - let ids = ids_of_named_context (pf_hyps g) in + let ids = Termops.ids_of_named_context (pf_hyps g) in let func_body = (def_of_const (constr_of_global func)) in let (f_name, _, body1) = destLambda func_body in let f_id = @@ -924,7 +923,7 @@ let clear_goals = | Prod(Name id as na,t',b) -> let b' = clear_goal b in if noccurn 1 b' && (is_rec_res id) - then pop b' + then Termops.pop b' else if b' == b then t else mkProd(na,t',b') | _ -> map_constr clear_goal t @@ -952,7 +951,7 @@ let open_new_goal (build_proof:tactic -> tactic -> unit) using_lemmas ref_ goal_ let sign = Global.named_context () in let sign = clear_proofs sign in let na = next_global_ident_away name [] in - if occur_existential gls_type then + if Termops.occur_existential gls_type then Util.error "\"abstract\" cannot handle existentials"; let hook _ _ = let opacity = @@ -1158,7 +1157,7 @@ let start_equation (f:global_reference) (term_f:global_reference) let x = n_x_id ids nargs in tclTHENLIST [ h_intros x; - unfold_in_concl [(all_occurrences, evaluable_of_global_reference f)]; + unfold_in_concl [(Termops.all_occurrences, evaluable_of_global_reference f)]; observe_tac "simplest_case" (simplest_case (mkApp (terminate_constr, Array.of_list (List.map mkVar x)))); @@ -1200,7 +1199,7 @@ let rec introduce_all_values_eq cont_tac functional termine simpl_iter (onHyp heq2); unfold_in_hyp [((true,[1]), evaluable_of_global_reference (global_of_constr functional))] - (heq2, InHyp); + (heq2, Termops.InHyp); tclTHENS (fun gls -> let t_eq = compute_renamed_type gls (mkVar heq2) in @@ -1208,7 +1207,7 @@ let rec introduce_all_values_eq cont_tac functional termine let _,_,t = destProd t_eq in let def_na,_,_ = destProd t in Nameops.out_name def_na in - observe_tac "rewrite heq" (general_rewrite_bindings false all_occurrences + observe_tac "rewrite heq" (general_rewrite_bindings false Termops.all_occurrences (* dep proofs also: *) true (mkVar heq2, ExplicitBindings[dummy_loc,NamedHyp def_id, f]) false) gls) @@ -1264,7 +1263,7 @@ let rec introduce_all_values_eq cont_tac functional termine f_S(mkVar pmax'); dummy_loc, NamedHyp def_id, f]) in - observe_tac "general_rewrite_bindings" ( (general_rewrite_bindings false all_occurrences (* dep proofs also: *) true + observe_tac "general_rewrite_bindings" ( (general_rewrite_bindings false Termops.all_occurrences (* dep proofs also: *) true c_b false)) g ) @@ -1321,7 +1320,7 @@ let rec prove_eq nb_arg (termine:constr) (f:constr)(functional:global_reference _,[] -> observe_tac "base_leaf_eq(1)" (base_leaf_eq functional eqs f) | fn,args -> fun g -> - let ids = ids_of_named_context (pf_hyps g) in + let ids = Termops.ids_of_named_context (pf_hyps g) in observe_tac "rec_leaf_eq" (rec_leaf_eq termine f ids (constr_of_global functional) eqs expr fn args) g)) @@ -1330,7 +1329,7 @@ let rec prove_eq nb_arg (termine:constr) (f:constr)(functional:global_reference _,[] -> observe_tac "base_leaf_eq(2)" ( base_leaf_eq functional eqs f) | fn,args -> fun g -> - let ids = ids_of_named_context (pf_hyps g) in + let ids = Termops.ids_of_named_context (pf_hyps g) in observe_tac "rec_leaf_eq" (rec_leaf_eq termine f ids (constr_of_global functional) eqs expr fn args) g));; diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml index c457115d3..c36cded17 100644 --- a/plugins/omega/coq_omega.ml +++ b/plugins/omega/coq_omega.ml @@ -20,7 +20,6 @@ open Proof_type open Names open Nameops open Term -open Termops open Declarations open Environ open Sign @@ -131,7 +130,7 @@ let exists_tac c = constructor_tac false (Some 1) 1 (Rawterm.ImplicitBindings [c let generalize_tac t = generalize_time (generalize t) let elim t = elim_time (simplest_elim t) let exact t = exact_time (Tactics.refine t) -let unfold s = Tactics.unfold_in_concl [all_occurrences, Lazy.force s] +let unfold s = Tactics.unfold_in_concl [Termops.all_occurrences, Lazy.force s] let rev_assoc k = let rec loop = function diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml index 3e9cc781f..cd4a7d3b0 100644 --- a/plugins/rtauto/refl_tauto.ml +++ b/plugins/rtauto/refl_tauto.ml @@ -10,7 +10,6 @@ module Search = Explore.Make(Proof_search) open Util open Term -open Termops open Names open Evd open Tacmach @@ -102,7 +101,7 @@ let rec make_form atom_env gls term = let cciterm=special_whd gls term in match kind_of_term cciterm with Prod(_,a,b) -> - if not (dependent (mkRel 1) b) && + if not (Termops.dependent (mkRel 1) b) && Retyping.get_sort_family_of (pf_env gls) (Tacmach.project gls) a = InProp then @@ -142,7 +141,7 @@ let rec make_hyps atom_env gls lenv = function | (id,None,typ)::rest -> let hrec= make_hyps atom_env gls (typ::lenv) rest in - if List.exists (dependent (mkVar id)) lenv || + if List.exists (Termops.dependent (mkVar id)) lenv || (Retyping.get_sort_family_of (pf_env gls) (Tacmach.project gls) typ <> InProp) then diff --git a/plugins/setoid_ring/newring.ml4 b/plugins/setoid_ring/newring.ml4 index 052406867..741d22a8a 100644 --- a/plugins/setoid_ring/newring.ml4 +++ b/plugins/setoid_ring/newring.ml4 @@ -17,7 +17,6 @@ open Environ open Libnames open Tactics open Rawterm -open Termops open Tacticals open Tacexpr open Pcoq @@ -102,7 +101,7 @@ let protect_tac map = Tactics.reduct_option (protect_red map,DEFAULTcast) None ;; let protect_tac_in map id = - Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(id,InHyp));; + Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(id, Termops.InHyp));; TACTIC EXTEND protect_fv diff --git a/plugins/subtac/subtac_classes.ml b/plugins/subtac/subtac_classes.ml index 93f9b586b..31e630741 100644 --- a/plugins/subtac/subtac_classes.ml +++ b/plugins/subtac/subtac_classes.ml @@ -20,7 +20,6 @@ open Constrintern open Subtac_command open Typeclasses open Typeclasses_errors -open Termops open Decl_kinds open Entries open Util diff --git a/plugins/subtac/subtac_command.ml b/plugins/subtac/subtac_command.ml index 634a6ea60..397bda9b0 100644 --- a/plugins/subtac/subtac_command.ml +++ b/plugins/subtac/subtac_command.ml @@ -21,7 +21,6 @@ open Tacmach open Tactic_debug open Topconstr open Term -open Termops open Tacexpr open Safe_typing open Typing @@ -133,7 +132,7 @@ let collect_non_rec env = let i = list_try_find_i (fun i f -> - if List.for_all (fun (_, def) -> not (occur_var env f def)) ldefrec + if List.for_all (fun (_, def) -> not (Termops.occur_var env f def)) ldefrec then i else failwith "try_find_i") 0 lnamerec in diff --git a/plugins/subtac/subtac_pretyping_F.ml b/plugins/subtac/subtac_pretyping_F.ml index 6154b19ad..311889448 100644 --- a/plugins/subtac/subtac_pretyping_F.ml +++ b/plugins/subtac/subtac_pretyping_F.ml @@ -13,7 +13,6 @@ open Names open Sign open Evd open Term -open Termops open Reductionops open Environ open Type_errors @@ -106,7 +105,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct else id let invert_ltac_bound_name env id0 id = - try mkRel (pi1 (lookup_rel_id id (rel_context env))) + try mkRel (pi1 (Termops.lookup_rel_id id (rel_context env))) with Not_found -> errorlabstrm "" (str "Ltac variable " ++ pr_id id0 ++ str " depends on pattern variable name " ++ pr_id id ++ @@ -115,7 +114,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct let pretype_id loc env sigma (lvar,unbndltacvars) id = let id = strip_meta id in (* May happen in tactics defined by Grammar *) try - let (n,_,typ) = lookup_rel_id id (rel_context env) in + let (n,_,typ) = Termops.lookup_rel_id id (rel_context env) in { uj_val = mkRel n; uj_type = lift n typ } with Not_found -> try @@ -151,7 +150,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct let s' = mkProd (Anonymous, ind, s) in let ccl = lift 1 (decomp n pj.uj_val) in let ccl' = mkLambda (Anonymous, ind, ccl) in - {uj_val=it_mkLambda ccl' sign; uj_type=it_mkProd s' sign} + {uj_val=Termops.it_mkLambda ccl' sign; uj_type=Termops.it_mkProd s' sign} (*************************************************************************) (* Main pretyping function *) @@ -224,7 +223,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct match tycon with | Some (None, ty) -> ty | None | Some _ -> - e_new_evar evdref env ~src:(loc,InternalHole) (new_Type ()) in + e_new_evar evdref env ~src:(loc, InternalHole) (Termops.new_Type ()) in { uj_val = e_new_evar evdref env ~src:(loc,k) ty; uj_type = ty } | RRec (loc,fixkind,names,bl,lar,vdef) -> @@ -386,7 +385,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct | RProd(loc,name,k,c1,c2) -> let j = pretype_type empty_valcon env evdref lvar c1 in let var = (name,j.utj_val) in - let env' = push_rel_assum var env in + let env' = Termops.push_rel_assum var env in let j' = pretype_type empty_valcon env' evdref lvar c2 in let resj = try judge_of_product env name j j' @@ -395,7 +394,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct | RLetIn(loc,name,c1,c2) -> let j = pretype empty_tycon env evdref lvar c1 in - let t = refresh_universes j.uj_type in + let t = Termops.refresh_universes j.uj_type in let var = (name,Some j.uj_val,t) in let tycon = lift_tycon 1 tycon in let j' = pretype tycon (push_rel var env) evdref lvar c2 in @@ -503,7 +502,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct let p = match tycon with | Some (None, ty) -> ty | None | Some _ -> - e_new_evar evdref env ~src:(loc,InternalHole) (new_Type ()) + e_new_evar evdref env ~src:(loc,InternalHole) (Termops.new_Type ()) in it_mkLambda_or_LetIn (lift (nar+1) p) psign, p in let pred = nf_evar ( !evdref) pred in @@ -584,7 +583,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct { utj_val = v; utj_type = s } | None -> - let s = new_Type_sort () in + let s = Termops.new_Type_sort () in { utj_val = e_new_evar evdref env ~src:loc (mkSort s); utj_type = s}) | c -> diff --git a/plugins/subtac/subtac_utils.ml b/plugins/subtac/subtac_utils.ml index 689b110f8..106ac4d09 100644 --- a/plugins/subtac/subtac_utils.ml +++ b/plugins/subtac/subtac_utils.ml @@ -414,7 +414,6 @@ let string_of_intset d = open Printer open Ppconstr open Nameops -open Termops open Evd let pr_meta_map evd = @@ -426,11 +425,11 @@ let pr_meta_map evd = | (mv,Cltyp (na,b)) -> hov 0 (pr_meta mv ++ pr_name na ++ str " : " ++ - print_constr b.rebus ++ fnl ()) + Termops.print_constr b.rebus ++ fnl ()) | (mv,Clval(na,b,_)) -> hov 0 (pr_meta mv ++ pr_name na ++ str " := " ++ - print_constr (fst b).rebus ++ fnl ()) + Termops.print_constr (fst b).rebus ++ fnl ()) in prlist pr_meta_binding ml @@ -441,11 +440,11 @@ let pr_evar_info evi = (*pr_idl (List.rev (ids_of_named_context (evar_context evi))) *) Printer.pr_named_context (Global.env()) (evar_context evi) in - let pty = print_constr evi.evar_concl in + let pty = Termops.print_constr evi.evar_concl in let pb = match evi.evar_body with | Evar_empty -> mt () - | Evar_defined c -> spc() ++ str"=> " ++ print_constr c + | Evar_defined c -> spc() ++ str"=> " ++ Termops.print_constr c in hov 2 (str"[" ++ phyps ++ spc () ++ str"|- " ++ pty ++ pb ++ str"]") @@ -459,11 +458,11 @@ let pr_evar_map sigma = let pr_constraints pbs = h 0 (prlist_with_sep pr_fnl (fun (pbty,t1,t2) -> - print_constr t1 ++ spc() ++ + Termops.print_constr t1 ++ spc() ++ str (match pbty with | Reduction.CONV -> "==" | Reduction.CUMUL -> "<=") ++ - spc() ++ print_constr t2) pbs) + spc() ++ Termops.print_constr t2) pbs) let pr_evar_map evd = let pp_evm = |