From 379c2403b1cd031091a2271353f26ab24afeb1e5 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 22 Oct 2016 10:17:39 +0200 Subject: Port fix for bugs 4763, 5149, previously 0b417c12e Adds a compatibility flag so that the behavior of 8.5 can be obtained too. Original commit: unification.ml: fix for bug #4763, unif regression Do not force all remaining conversions problems to be solved after the _first_ solution of an evar. This was hell to track down, thanks for the help of Maxime. contribs pass and HoTT too. --- pretyping/unification.ml | 6 +++++- test-suite/bugs/closed/4763.v | 13 +++++++++++++ test-suite/bugs/closed/HoTT_coq_117.v | 21 ++++++++++++++++++++- 3 files changed, 38 insertions(+), 2 deletions(-) create mode 100644 test-suite/bugs/closed/4763.v diff --git a/pretyping/unification.ml b/pretyping/unification.ml index e0a81cfbb..cec9f700a 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -1270,7 +1270,11 @@ let solve_simple_evar_eqn ts env evd ev rhs = | UnifFailure (evd,reason) -> error_cannot_unify env evd ~reason (mkEvar ev,rhs); | Success evd -> - Evarconv.consider_remaining_unif_problems env evd + if Flags.version_less_or_equal Flags.V8_5 then + (* We used to force solving unrelated problems at arbitrary times *) + Evarconv.consider_remaining_unif_problems env evd + else (* solve_simple_eqn calls reconsider_conv_pbs itself *) + evd (* [w_merge env sigma b metas evars] merges common instances in metas or in evars, possibly generating new unification problems; if [b] diff --git a/test-suite/bugs/closed/4763.v b/test-suite/bugs/closed/4763.v new file mode 100644 index 000000000..ae8ed0e6e --- /dev/null +++ b/test-suite/bugs/closed/4763.v @@ -0,0 +1,13 @@ +Require Import Coq.Arith.Arith Coq.Classes.Morphisms Coq.Classes.RelationClasses. +Coercion is_true : bool >-> Sortclass. +Global Instance: Transitive leb. +Admitted. + +Goal forall x y z, leb x y -> leb y z -> True. + intros ??? H H'. + lazymatch goal with + | [ H : is_true (?R ?x ?y), H' : is_true (?R ?y ?z) |- _ ] + => pose proof (transitivity H H' : is_true (R x z)) + end. + exact I. +Qed. \ No newline at end of file diff --git a/test-suite/bugs/closed/HoTT_coq_117.v b/test-suite/bugs/closed/HoTT_coq_117.v index 5fbcfef4e..de60fd0ae 100644 --- a/test-suite/bugs/closed/HoTT_coq_117.v +++ b/test-suite/bugs/closed/HoTT_coq_117.v @@ -16,10 +16,29 @@ Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, Admitted. Inductive Empty : Set := . -Instance contr_from_Empty {_ : Funext} (A : Type) : +Fail Instance contr_from_Empty {_ : Funext} (A : Type) : + Contr_internal (Empty -> A) := + BuildContr _ + (Empty_rect (fun _ => A)) + (fun f => path_forall _ f (fun x => Empty_rect _ x)). + +Fail Instance contr_from_Empty {F : Funext} (A : Type) : Contr_internal (Empty -> A) := BuildContr _ (Empty_rect (fun _ => A)) (fun f => path_forall _ f (fun x => Empty_rect _ x)). + +(** This could be disallowed, this uses the Funext argument *) +Instance contr_from_Empty {_ : Funext} (A : Type) : + Contr_internal (Empty -> A) := + BuildContr _ + (Empty_rect (fun _ => A)) + (fun f => path_forall _ f (fun x => Empty_rect (fun _ => _ x = f x) x)). + +Instance contr_from_Empty' {_ : Funext} (A : Type) : + Contr_internal (Empty -> A) := + BuildContr _ + (Empty_rect (fun _ => A)) + (fun f => path_forall _ f (fun x => Empty_rect (fun _ => _ x = f x) x)). (* Toplevel input, characters 15-220: Anomaly: unknown meta ?190. Please report. *) -- cgit v1.2.3 From ccb173a440fa2eb7105a692c979253edbfe475ee Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 19 Oct 2016 13:33:28 +0200 Subject: Unification constraint handling (#4763, #5149) Refine fix for bug #4763, fixing #5149 Tactic [Refine.solve_constraints] and global option Adds a new multi-goal tactic [Refine.solve_constraints] that forces solving of unification constraints and evar candidates to be solved. run_tactic now calls [solve_constraints] at every [.], preserving (mostly) the 8.4/8.5 behavior of tactics. The option allows to unset the forced solving unification constraints at each ".", letting the user control the places where the use of heuristics is done. Fix test-suite files too. --- engine/proofview.ml | 4 ---- engine/proofview.mli | 1 - ltac/extratactics.ml4 | 5 ++++ pretyping/unification.ml | 19 ++++----------- proofs/pfedit.ml | 16 +++++++++++++ proofs/refine.ml | 11 +++++++++ proofs/refine.mli | 5 ++++ test-suite/bugs/closed/2310.v | 6 ++++- test-suite/bugs/closed/3647.v | 3 ++- test-suite/bugs/closed/4416.v | 1 + test-suite/bugs/closed/5149.v | 47 +++++++++++++++++++++++++++++++++++++ test-suite/output/unifconstraints.v | 1 + 12 files changed, 98 insertions(+), 21 deletions(-) create mode 100644 test-suite/bugs/closed/5149.v diff --git a/engine/proofview.ml b/engine/proofview.ml index 855235d2b..c01879765 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -1157,10 +1157,6 @@ let tclLIFT = Proof.lift let tclCHECKINTERRUPT = tclLIFT (NonLogical.make Control.check_for_interrupt) - - - - (*** Compatibility layer with <= 8.2 tactics ***) module V82 = struct type tac = Evar.t Evd.sigma -> Evar.t list Evd.sigma diff --git a/engine/proofview.mli b/engine/proofview.mli index 725445251..90be2f90a 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -373,7 +373,6 @@ val mark_as_unsafe : unit tactic with given up goals cannot be closed. *) val give_up : unit tactic - (** {7 Control primitives} *) (** [tclPROGRESS t] checks the state of the proof after [t]. It it is diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index d0318fb5f..e6498e02b 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -370,6 +370,11 @@ TACTIC EXTEND simple_refine | [ "simple" "refine" uconstr(c) ] -> [ refine_tac ist true c ] END +(* Solve unification constraints using heuristics or fail if any remain *) +TACTIC EXTEND solve_constraints +[ "solve_constraints" ] -> [ Refine.solve_constraints ] +END + (**********************************************************************) (* Inversion lemmas (Leminv) *) diff --git a/pretyping/unification.ml b/pretyping/unification.ml index cec9f700a..fc63015a8 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -1301,7 +1301,6 @@ let w_merge env with_types flags (evd,metas,evars) = if is_mimick_head flags.modulo_delta f then let evd' = mimick_undefined_evar evd flags f (Array.length cl) evk in - (* let evd' = Evarconv.consider_remaining_unif_problems env evd' in *) w_merge_rec evd' metas evars eqns else let evd' = @@ -1397,8 +1396,7 @@ let w_merge env with_types flags (evd,metas,evars) = (* Assign evars in the order of assignments during unification *) (List.rev evars) [] in - if with_types then check_types res - else res + if with_types then check_types res else res let w_unify_meta_types env ?(flags=default_unify_flags ()) evd = let metas,evd = retract_coercible_metas evd in @@ -1456,7 +1454,7 @@ let w_typed_unify_array env evd flags f1 l1 f2 l2 = let subst = Array.fold_left2 fold_subst subst l1 l2 in let evd = w_merge env true flags.merge_unify_flags subst in try_resolve_typeclasses env evd flags.resolve_evars - (mkApp(f1,l1)) (mkApp(f2,l2)) + (mkApp(f1,l1)) (mkApp(f2,l2)) (* takes a substitution s, an open term op and a closed term cl try to find a subterm of cl which matches op, if op is just a Meta @@ -1885,21 +1883,14 @@ let secondOrderAbstraction env evd flags typ (p, oplist) = error_wrong_abstraction_type env evd' (Evd.meta_name evd p) pred typp predtyp; w_merge env false flags.merge_unify_flags - (evd',[p,pred,(Conv,TypeProcessed)],[]) - - (* let evd',metas,evars = *) - (* try unify_0 env evd' CUMUL flags predtyp typp *) - (* with NotConvertible -> *) - (* error_wrong_abstraction_type env evd *) - (* (Evd.meta_name evd p) pred typp predtyp *) - (* in *) - (* w_merge env false flags (evd',(p,pred,(Conv,TypeProcessed))::metas,evars) *) + (evd',[p,pred,(Conv,TypeProcessed)],[]) let secondOrderDependentAbstraction env evd flags typ (p, oplist) = let typp = Typing.meta_type evd p in let evd, pred = abstract_list_all_with_dependencies env evd typp typ oplist in w_merge env false flags.merge_unify_flags - (evd,[p,pred,(Conv,TypeProcessed)],[]) + (evd,[p,pred,(Conv,TypeProcessed)],[]) + let secondOrderAbstractionAlgo dep = if dep then secondOrderDependentAbstraction else secondOrderAbstraction diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml index a3ece1913..9c71e107c 100644 --- a/proofs/pfedit.ml +++ b/proofs/pfedit.ml @@ -13,6 +13,17 @@ open Entries open Environ open Evd +let use_unification_heuristics_ref = ref true +let _ = Goptions.declare_bool_option { + Goptions.optsync = true; Goptions.optdepr = false; + Goptions.optname = "Unification heuristics are applied at every ."; + Goptions.optkey = ["Use";"Unification";"Heuristics"]; + Goptions.optread = (fun () -> !use_unification_heuristics_ref); + Goptions.optwrite = (fun a -> use_unification_heuristics_ref:=a); +} + +let use_unification_heuristics () = !use_unification_heuristics_ref + let refining = Proof_global.there_are_pending_proofs let check_no_pending_proofs = Proof_global.check_no_pending_proof @@ -119,6 +130,11 @@ let solve ?with_end_tac gi info_lvl tac pr = | Vernacexpr.SelectId id -> Proofview.tclFOCUSID id tac | Vernacexpr.SelectAll -> tac in + let tac = + if use_unification_heuristics () then + Proofview.tclTHEN tac Refine.solve_constraints + else tac + in let (p,(status,info)) = Proof.run_tactic (Global.env ()) tac pr in let () = match info_lvl with diff --git a/proofs/refine.ml b/proofs/refine.ml index e5114a2ec..2f2142890 100644 --- a/proofs/refine.ml +++ b/proofs/refine.ml @@ -149,3 +149,14 @@ let refine_casted ?unsafe f = Proofview.Goal.enter { enter = begin fun gl -> } in refine ?unsafe f end } + +(** {7 solve_constraints} + + Ensure no remaining unification problems are left. Run at every "." by default. *) + +let solve_constraints = + let open Proofview in + tclENV >>= fun env -> tclEVARMAP >>= fun sigma -> + try let sigma = Evarconv.consider_remaining_unif_problems env sigma in + Unsafe.tclEVARSADVANCE sigma + with e -> tclZERO e diff --git a/proofs/refine.mli b/proofs/refine.mli index 3d140f036..a44632eff 100644 --- a/proofs/refine.mli +++ b/proofs/refine.mli @@ -43,3 +43,8 @@ val with_type : Environ.env -> Evd.evar_map -> val refine_casted : ?unsafe:bool -> Constr.t Sigma.run -> unit tactic (** Like {!refine} except the refined term is coerced to the conclusion of the current goal. *) + +(** {7 Unification constraint handling} *) + +val solve_constraints : unit tactic +(** Solve any remaining unification problems, applying heuristics. *) diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/2310.v index 0be859edd..9fddede7e 100644 --- a/test-suite/bugs/closed/2310.v +++ b/test-suite/bugs/closed/2310.v @@ -14,4 +14,8 @@ Definition replace a (y:Nest (prod a a)) : a = a -> Nest a. (P:=\a.Nest (prod a a) and P:=\_.Nest (prod a a)) and refine should either leave P as subgoal or choose itself one solution *) -intros. refine (Cons (cast H _ y)). \ No newline at end of file + intros. Fail refine (Cons (cast H _ y)). + Unset Use Unification Heuristics. (* Keep the unification constraint around *) + refine (Cons (cast H _ y)). + intros. + refine (Nest (prod X X)). Qed. \ No newline at end of file diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v index 495e67e09..f2cd41203 100644 --- a/test-suite/bugs/closed/3647.v +++ b/test-suite/bugs/closed/3647.v @@ -650,4 +650,5 @@ Goal forall (ptest : program) (cond : Condition) (value : bool) Grab Existential Variables. subst_body; simpl. - refine (all_behead (projT2 _)). + Fail refine (all_behead (projT2 _)). + Unset Use Unification Heuristics. refine (all_behead (projT2 _)). diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v index b97a8ce64..afe8c62ed 100644 --- a/test-suite/bugs/closed/4416.v +++ b/test-suite/bugs/closed/4416.v @@ -1,3 +1,4 @@ Goal exists x, x. +Unset Use Unification Heuristics. unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. (* Error: Incorrect number of goals (expected 2 tactics). *) \ No newline at end of file diff --git a/test-suite/bugs/closed/5149.v b/test-suite/bugs/closed/5149.v new file mode 100644 index 000000000..01b9d158f --- /dev/null +++ b/test-suite/bugs/closed/5149.v @@ -0,0 +1,47 @@ +Goal forall x x' : nat, x = x' -> S x = S x -> exists y, S y = S x. +intros. +eexists. +rewrite <- H. +eassumption. +Qed. + +Goal forall (base_type_code : Type) (t : base_type_code) (flat_type : Type) + (t' : flat_type) (exprf interp_flat_type0 interp_flat_type1 : +flat_type -> Type) + (v v' : interp_flat_type1 t'), + v = v' -> + forall (interpf : forall t0 : flat_type, exprf t0 -> interp_flat_type1 t0) + (SmartVarVar : forall t0 : flat_type, interp_flat_type1 t0 -> +interp_flat_type0 t0) + (Tbase : base_type_code -> flat_type) (x : exprf (Tbase t)) + (x' : interp_flat_type1 (Tbase t)) (T : Type) + (flatten_binding_list : forall t0 : flat_type, + interp_flat_type0 t0 -> interp_flat_type1 t0 -> list T) + (P : T -> list T -> Prop) (prod : Type -> Type -> Type) + (s : forall x0 : base_type_code, prod (exprf (Tbase x0)) +(interp_flat_type1 (Tbase x0)) -> T) + (pair : forall A B : Type, A -> B -> prod A B), + P (s t (pair (exprf (Tbase t)) (interp_flat_type1 (Tbase t)) x x')) + (flatten_binding_list t' (SmartVarVar t' v') v) -> + (forall (t0 : base_type_code) (t'0 : flat_type) (v0 : interp_flat_type1 +t'0) + (x0 : exprf (Tbase t0)) (x'0 : interp_flat_type1 (Tbase t0)), + P (s t0 (pair (exprf (Tbase t0)) (interp_flat_type1 (Tbase t0)) x0 +x'0)) + (flatten_binding_list t'0 (SmartVarVar t'0 v0) v0) -> interpf +(Tbase t0) x0 = x'0) -> + interpf (Tbase t) x = x'. +Proof. + intros ?????????????????????? interpf_SmartVarVar. + solve [ unshelve (subst; eapply interpf_SmartVarVar; eassumption) ] || fail +"too early". + Undo. + (** Implicitely at the dot. The first fails because unshelve adds a goal, and solve hence fails. The second has an ambiant unification problem that is solved after solve *) + Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. + solve [eapply interpf_SmartVarVar; subst; eassumption]. + Undo. + Unset Use Unification Heuristics. + (* User control of when constraints are solved *) + solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. +Qed. + diff --git a/test-suite/output/unifconstraints.v b/test-suite/output/unifconstraints.v index c76fc74a0..c7fb82ada 100644 --- a/test-suite/output/unifconstraints.v +++ b/test-suite/output/unifconstraints.v @@ -1,4 +1,5 @@ (* Set Printing Existential Instances. *) +Unset Use Unification Heuristics. Axiom veeryyyyyyyyyyyyloooooooooooooonggidentifier : nat. Goal True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = -- cgit v1.2.3 From c9f8f7fe182decedda2e6403d502fda3aff24a6e Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 22 Oct 2016 10:37:17 +0200 Subject: Add Unset Use Unif Heuristics in Compat/Coq85 --- theories/Compat/Coq85.v | 3 +++ 1 file changed, 3 insertions(+) diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v index 400753644..ba58e2d88 100644 --- a/theories/Compat/Coq85.v +++ b/theories/Compat/Coq85.v @@ -27,3 +27,6 @@ Global Set Refolding Reduction. Global Set Typeclasses Legacy Resolution. Global Set Typeclasses Limit Intros. Global Unset Typeclasses Filtered Unification. + +(** Allow silently letting unification constraints float after a "." *) +Global Unset Use Unification Heuristics. \ No newline at end of file -- cgit v1.2.3 From be11ab322fa73804118738e7a08e9910fdf4600d Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 22 Oct 2016 11:03:13 +0200 Subject: Renamings to avoid confusion deprecating old names reconsider_conv_pbs -> reconsider_unif_constraints consider_remaining_unif_problems -> solve_unif_constraints_with_heuristics --- plugins/ssrmatching/ssrmatching.ml4 | 2 +- plugins/ssrmatching/ssrmatching.mli | 2 +- pretyping/evarconv.ml | 8 +++++--- pretyping/evarconv.mli | 3 +++ pretyping/evarsolve.ml | 6 ++++-- pretyping/evarsolve.mli | 3 +++ pretyping/pretyping.ml | 2 +- pretyping/unification.ml | 6 +++--- proofs/refine.ml | 2 +- tactics/class_tactics.ml | 2 +- tactics/equality.ml | 3 ++- toplevel/command.ml | 2 +- toplevel/vernacentries.ml | 2 +- 13 files changed, 27 insertions(+), 16 deletions(-) diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4 index a34fa4cae..88f028b4b 100644 --- a/plugins/ssrmatching/ssrmatching.ml4 +++ b/plugins/ssrmatching/ssrmatching.ml4 @@ -355,7 +355,7 @@ let nf_open_term sigma0 ise c = !s', Evd.evar_universe_context s, c' let unif_end env sigma0 ise0 pt ok = - let ise = Evarconv.consider_remaining_unif_problems env ise0 in + let ise = Evarconv.solve_unif_constraints_with_heuristics env ise0 in let s, uc, t = nf_open_term sigma0 ise pt in let ise1 = create_evar_defs s in let ise1 = Evd.set_universe_context ise1 uc in diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli index 74a603e51..288a04e60 100644 --- a/plugins/ssrmatching/ssrmatching.mli +++ b/plugins/ssrmatching/ssrmatching.mli @@ -213,7 +213,7 @@ val assert_done : 'a option ref -> 'a (** Very low level APIs. these are calls to evarconv's [the_conv_x] followed by - [consider_remaining_unif_problems] and [resolve_typeclasses]. + [solve_unif_constraints_with_heuristics] and [resolve_typeclasses]. In case of failure they raise [NoMatch] *) val unify_HO : env -> evar_map -> constr -> constr -> evar_map diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 3680cd777..07f6d9d38 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1081,7 +1081,7 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs = match evar_conv_x ts env_evar evd CUMUL idty evty with | UnifFailure _ -> error "Cannot find an instance" | Success evd -> - match reconsider_conv_pbs (evar_conv_x ts) evd with + match reconsider_unif_constraints (evar_conv_x ts) evd with | UnifFailure _ -> error "Cannot find an instance" | Success evd -> evd @@ -1208,7 +1208,7 @@ let rec solve_unconstrained_evars_with_candidates ts evd = let conv_algo = evar_conv_x ts in let evd = check_evar_instance evd evk a conv_algo in let evd = Evd.define evk a evd in - match reconsider_conv_pbs conv_algo evd with + match reconsider_unif_constraints conv_algo evd with | Success evd -> solve_unconstrained_evars_with_candidates ts evd | UnifFailure _ -> aux l with @@ -1231,7 +1231,7 @@ let solve_unconstrained_impossible_cases env evd = Evd.define evk ty evd' | _ -> evd') evd evd -let consider_remaining_unif_problems env +let solve_unif_constraints_with_heuristics env ?(ts=Conv_oracle.get_transp_state (Environ.oracle env)) evd = let evd = solve_unconstrained_evars_with_candidates ts evd in let rec aux evd pbs progress stuck = @@ -1263,6 +1263,8 @@ let consider_remaining_unif_problems env check_problems_are_solved env heuristic_solved_evd; solve_unconstrained_impossible_cases env heuristic_solved_evd +let consider_remaining_unif_problems = solve_unif_constraints_with_heuristics + (* Main entry points *) exception UnableToUnify of evar_map * unification_error diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli index 14947c892..2231e5bc3 100644 --- a/pretyping/evarconv.mli +++ b/pretyping/evarconv.mli @@ -33,7 +33,10 @@ val e_cumul : env -> ?ts:transparent_state -> evar_map ref -> constr -> constr - (** Try heuristics to solve pending unification problems and to solve evars with candidates *) +val solve_unif_constraints_with_heuristics : env -> ?ts:transparent_state -> evar_map -> evar_map + val consider_remaining_unif_problems : env -> ?ts:transparent_state -> evar_map -> evar_map +(** @deprecated Alias for [solve_unif_constraints_with_heuristics] *) (** Check all pending unification problems are solved and raise an error otherwise *) diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index f1526facc..f0aa9b564 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -1603,7 +1603,7 @@ let status_changed lev (pbty,_,t1,t2) = (try Evar.Set.mem (head_evar t1) lev with NoHeadEvar -> false) || (try Evar.Set.mem (head_evar t2) lev with NoHeadEvar -> false) -let reconsider_conv_pbs conv_algo evd = +let reconsider_unif_constraints conv_algo evd = let (evd,pbs) = extract_changed_conv_pbs evd status_changed in List.fold_left (fun p (pbty,env,t1,t2 as x) -> @@ -1616,6 +1616,8 @@ let reconsider_conv_pbs conv_algo evd = (Success evd) pbs +let reconsider_conv_pbs = reconsider_unif_constraints + (* Tries to solve problem t1 = t2. * Precondition: t1 is an uninstantiated evar * Returns an optional list of evars that were instantiated, or None @@ -1626,7 +1628,7 @@ let solve_simple_eqn conv_algo ?(choose=false) env evd (pbty,(evk1,args1 as ev1) try let t2 = whd_betaiota evd t2 in (* includes whd_evar *) let evd = evar_define conv_algo ~choose env evd pbty ev1 t2 in - reconsider_conv_pbs conv_algo evd + reconsider_unif_constraints conv_algo evd with | NotInvertibleUsingOurAlgorithm t -> UnifFailure (evd,NotClean (ev1,env,t)) diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index f94c83b6d..b6bdc0788 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -54,7 +54,10 @@ val solve_evar_evar : ?force:bool -> val solve_simple_eqn : conv_fun -> ?choose:bool -> env -> evar_map -> bool option * existential * constr -> unification_result +val reconsider_unif_constraints : conv_fun -> evar_map -> unification_result + val reconsider_conv_pbs : conv_fun -> evar_map -> unification_result +(** @deprecated Alias for [reconsider_unif_constraints] *) val is_unification_pattern_evar : env -> evar_map -> existential -> constr list -> constr -> constr list option diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 6afa55862..95d854323 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -290,7 +290,7 @@ let apply_inference_hook hook evdref pending = let apply_heuristics env evdref fail_evar = (* Resolve eagerly, potentially making wrong choices *) - try evdref := consider_remaining_unif_problems + try evdref := solve_unif_constraints_with_heuristics ~ts:(Typeclasses.classes_transparent_state ()) env !evdref with e when CErrors.noncritical e -> let e = CErrors.push e in if fail_evar then iraise e diff --git a/pretyping/unification.ml b/pretyping/unification.ml index fc63015a8..259318693 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -1220,7 +1220,7 @@ let is_mimick_head ts f = let try_to_coerce env evd c cty tycon = let j = make_judge c cty in let (evd',j') = inh_conv_coerce_rigid_to true Loc.ghost env evd j tycon in - let evd' = Evarconv.consider_remaining_unif_problems env evd' in + let evd' = Evarconv.solve_unif_constraints_with_heuristics env evd' in let evd' = Evd.map_metas_fvalue (nf_evar evd') evd' in (evd',j'.uj_val) @@ -1272,8 +1272,8 @@ let solve_simple_evar_eqn ts env evd ev rhs = | Success evd -> if Flags.version_less_or_equal Flags.V8_5 then (* We used to force solving unrelated problems at arbitrary times *) - Evarconv.consider_remaining_unif_problems env evd - else (* solve_simple_eqn calls reconsider_conv_pbs itself *) + Evarconv.solve_unif_constraints_with_heuristics env evd + else (* solve_simple_eqn calls reconsider_unif_constraints itself *) evd (* [w_merge env sigma b metas evars] merges common instances in metas diff --git a/proofs/refine.ml b/proofs/refine.ml index 2f2142890..3f5527060 100644 --- a/proofs/refine.ml +++ b/proofs/refine.ml @@ -157,6 +157,6 @@ end } let solve_constraints = let open Proofview in tclENV >>= fun env -> tclEVARMAP >>= fun sigma -> - try let sigma = Evarconv.consider_remaining_unif_problems env sigma in + try let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in Unsafe.tclEVARSADVANCE sigma with e -> tclZERO e diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 0944cbe38..9ea402726 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1437,7 +1437,7 @@ let initial_select_evars filter = let resolve_typeclass_evars debug depth unique env evd filter split fail = let evd = - try Evarconv.consider_remaining_unif_problems + try Evarconv.solve_unif_constraints_with_heuristics ~ts:(Typeclasses.classes_transparent_state ()) env evd with e when CErrors.noncritical e -> evd in diff --git a/tactics/equality.ml b/tactics/equality.ml index e9d08d737..bb3cbad92 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -1163,7 +1163,8 @@ let sig_clausal_form env sigma sort_of_ty siglen ty dflt = let dflt_typ = unsafe_type_of env sigma dflt in try let () = evdref := Evarconv.the_conv_x_leq env dflt_typ p_i !evdref in - let () = evdref := Evarconv.consider_remaining_unif_problems env !evdref in + let () = + evdref := Evarconv.solve_unif_constraints_with_heuristics env !evdref in dflt with Evarconv.UnableToUnify _ -> error "Cannot solve a unification problem." diff --git a/toplevel/command.ml b/toplevel/command.ml index 12c387dcf..7ffe680e5 100644 --- a/toplevel/command.ml +++ b/toplevel/command.ml @@ -1129,7 +1129,7 @@ let interp_recursive isfix fixl notations = () in (* Instantiate evars and check all are resolved *) - let evd = consider_remaining_unif_problems env_rec !evdref in + let evd = solve_unif_constraints_with_heuristics env_rec !evdref in let evd, nf = nf_evars_and_universes evd in let fixdefs = List.map (Option.map nf) fixdefs in let fixtypes = List.map nf fixtypes in diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index f69bac437..9d3837d2e 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1497,7 +1497,7 @@ let get_current_context_of_args = function let vernac_check_may_eval redexp glopt rc = let (sigma, env) = get_current_context_of_args glopt in let sigma', c = interp_open_constr env sigma rc in - let sigma' = Evarconv.consider_remaining_unif_problems env sigma' in + let sigma' = Evarconv.solve_unif_constraints_with_heuristics env sigma' in Evarconv.check_problems_are_solved env sigma'; let sigma',nf = Evarutil.nf_evars_and_universes sigma' in let pl, uctx = Evd.universe_context sigma' in -- cgit v1.2.3 From 13738c4afd217ea7d71e654c38fc6a661bd2953c Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Mon, 24 Oct 2016 13:38:07 +0200 Subject: Fix printing of typeclasses eauto debug wrt intro. --- tactics/class_tactics.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 0944cbe38..248635b4e 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1141,7 +1141,8 @@ module Search = struct (true,false,false) info.search_only_classes None decl in let ldb = Hint_db.add_list env s hint info.search_hints in let info' = - { info with search_hints = ldb; last_tac = lazy (str"intro") } + { info with search_hints = ldb; last_tac = lazy (str"intro"); + search_depth = 1 :: 1 :: info.search_depth } in kont info' let intro info kont = -- cgit v1.2.3 From 7e38b6627caaab7d19c4fc0ee542a67d9f8970c2 Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Mon, 24 Oct 2016 17:28:51 +0200 Subject: Remove v62 from stdlib. This old compatibility hint database can be safely removed now that coq-contribs do not depend on it anymore. --- theories/Arith/Between.v | 24 ++++++++++++------------ theories/Arith/EqNat.v | 4 ++-- theories/Arith/Gt.v | 16 ++++++++-------- theories/Arith/Le.v | 12 ++++++------ theories/Arith/Lt.v | 26 +++++++++++++------------- theories/Arith/Max.v | 4 ++-- theories/Arith/Minus.v | 20 ++++++++++---------- theories/Arith/Mult.v | 16 ++++++++-------- theories/Arith/Plus.v | 12 ++++++------ theories/Bool/Bool.v | 30 +++++++++++++++--------------- theories/Bool/IfProp.v | 2 +- theories/Init/Logic_Type.v | 2 +- theories/Init/Peano.v | 3 --- theories/Init/Specif.v | 2 +- theories/Lists/List.v | 16 ++++++++-------- theories/Lists/Streams.v | 2 +- theories/Logic/Eqdep.v | 2 +- theories/Reals/RIneq.v | 12 +++++------- theories/Reals/Raxioms.v | 8 ++++---- theories/Relations/Relation_Definitions.v | 6 +++--- theories/Relations/Relation_Operators.v | 6 +++--- theories/Sets/Classical_sets.v | 2 +- theories/Sets/Constructive_sets.v | 2 +- theories/Sets/Ensembles.v | 5 ++--- theories/Sets/Finite_sets.v | 4 ++-- theories/Sets/Image.v | 2 +- theories/Sets/Multiset.v | 6 +++--- theories/Sets/Partial_Order.v | 4 ++-- theories/Sets/Powerset.v | 22 +++++++++++----------- theories/Sets/Powerset_Classical_facts.v | 14 +++++++------- theories/Sets/Powerset_facts.v | 2 +- theories/Sets/Relations_1.v | 4 ++-- theories/Sets/Relations_2.v | 8 ++++---- theories/Sets/Relations_3.v | 12 ++++++------ theories/ZArith/Zwf.v | 4 ++-- 35 files changed, 155 insertions(+), 161 deletions(-) diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index f998e8619..58d3a2b38 100644 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -20,20 +20,20 @@ Section Between. | bet_emp : between k k | bet_S : forall l, between k l -> P l -> between k (S l). - Hint Constructors between: arith v62. + Hint Constructors between: arith. Lemma bet_eq : forall k l, l = k -> between k l. Proof. induction 1; auto with arith. Qed. - Hint Resolve bet_eq: arith v62. + Hint Resolve bet_eq: arith. Lemma between_le : forall k l, between k l -> k <= l. Proof. induction 1; auto with arith. Qed. - Hint Immediate between_le: arith v62. + Hint Immediate between_le: arith. Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l. Proof. @@ -41,7 +41,7 @@ Section Between. intros; absurd (S k <= k); auto with arith. destruct H; auto with arith. Qed. - Hint Resolve between_Sk_l: arith v62. + Hint Resolve between_Sk_l: arith. Lemma between_restr : forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m. @@ -53,7 +53,7 @@ Section Between. | exists_S : forall l, exists_between k l -> exists_between k (S l) | exists_le : forall l, k <= l -> Q l -> exists_between k (S l). - Hint Constructors exists_between: arith v62. + Hint Constructors exists_between: arith. Lemma exists_le_S : forall k l, exists_between k l -> S k <= l. Proof. @@ -62,13 +62,13 @@ Section Between. Lemma exists_lt : forall k l, exists_between k l -> k < l. Proof exists_le_S. - Hint Immediate exists_le_S exists_lt: arith v62. + Hint Immediate exists_le_S exists_lt: arith. Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l. Proof. intros; apply le_S_n; auto with arith. Qed. - Hint Immediate exists_S_le: arith v62. + Hint Immediate exists_S_le: arith. Definition in_int p q r := p <= r /\ r < q. @@ -76,7 +76,7 @@ Section Between. Proof. red; auto with arith. Qed. - Hint Resolve in_int_intro: arith v62. + Hint Resolve in_int_intro: arith. Lemma in_int_lt : forall p q r, in_int p q r -> p < q. Proof. @@ -95,13 +95,13 @@ Section Between. Proof. induction 1; auto with arith. Qed. - Hint Resolve in_int_S: arith v62. + Hint Resolve in_int_S: arith. Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r. Proof. induction 1; auto with arith. Qed. - Hint Immediate in_int_Sp_q: arith v62. + Hint Immediate in_int_Sp_q: arith. Lemma between_in_int : forall k l, between k l -> forall r, in_int k l r -> P r. @@ -183,5 +183,5 @@ Section Between. End Between. Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le - in_int_S in_int_intro: arith v62. -Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62. + in_int_S in_int_intro: arith. +Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith. diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index 206fc0ab5..f998c19fc 100644 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -25,7 +25,7 @@ Theorem eq_nat_refl n : eq_nat n n. Proof. induction n; simpl; auto. Qed. -Hint Resolve eq_nat_refl: arith v62. +Hint Resolve eq_nat_refl: arith. (** [eq] restricted to [nat] and [eq_nat] are equivalent *) @@ -46,7 +46,7 @@ Proof. apply eq_nat_is_eq. Qed. -Hint Immediate eq_eq_nat eq_nat_eq: arith v62. +Hint Immediate eq_eq_nat eq_nat_eq: arith. Theorem eq_nat_elim : forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m. diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v index dfd576946..67c94fdf6 100644 --- a/theories/Arith/Gt.v +++ b/theories/Arith/Gt.v @@ -133,14 +133,14 @@ Qed. (** * Hints *) -Hint Resolve gt_Sn_O gt_Sn_n gt_n_S : arith v62. -Hint Immediate gt_S_n gt_pred : arith v62. -Hint Resolve gt_irrefl gt_asym : arith v62. -Hint Resolve le_not_gt gt_not_le : arith v62. -Hint Immediate le_S_gt gt_S_le : arith v62. -Hint Resolve gt_le_S le_gt_S : arith v62. -Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62. -Hint Resolve plus_gt_compat_l: arith v62. +Hint Resolve gt_Sn_O gt_Sn_n gt_n_S : arith. +Hint Immediate gt_S_n gt_pred : arith. +Hint Resolve gt_irrefl gt_asym : arith. +Hint Resolve le_not_gt gt_not_le : arith. +Hint Immediate le_S_gt gt_S_le : arith. +Hint Resolve gt_le_S le_gt_S : arith. +Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith. +Hint Resolve plus_gt_compat_l: arith. (* begin hide *) Notation gt_O_eq := gt_0_eq (only parsing). diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index ceb91187b..0fbcec572 100644 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -30,8 +30,8 @@ Notation le_refl := Nat.le_refl (compat "8.4"). Notation le_trans := Nat.le_trans (compat "8.4"). Notation le_antisym := Nat.le_antisymm (compat "8.4"). -Hint Resolve le_trans: arith v62. -Hint Immediate le_antisym: arith v62. +Hint Resolve le_trans: arith. +Hint Immediate le_antisym: arith. (** * Properties of [le] w.r.t 0 *) @@ -59,16 +59,16 @@ Notation le_Sn_n := Nat.nle_succ_diag_l (compat "8.4"). (* ~ S n <= n *) Theorem le_Sn_le : forall n m, S n <= m -> n <= m. Proof Nat.lt_le_incl. -Hint Resolve le_0_n le_Sn_0: arith v62. -Hint Resolve le_n_S le_n_Sn le_Sn_n : arith v62. -Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith v62. +Hint Resolve le_0_n le_Sn_0: arith. +Hint Resolve le_n_S le_n_Sn le_Sn_n : arith. +Hint Immediate le_n_0_eq le_Sn_le le_S_n : arith. (** * Properties of [le] w.r.t predecessor *) Notation le_pred_n := Nat.le_pred_l (compat "8.4"). (* pred n <= n *) Notation le_pred := Nat.pred_le_mono (compat "8.4"). (* n<=m -> pred n <= pred m *) -Hint Resolve le_pred_n: arith v62. +Hint Resolve le_pred_n: arith. (** * A different elimination principle for the order on natural numbers *) diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index f824ee6fb..bfc2b91a9 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -25,7 +25,7 @@ Local Open Scope nat_scope. Notation lt_irrefl := Nat.lt_irrefl (compat "8.4"). (* ~ x < x *) -Hint Resolve lt_irrefl: arith v62. +Hint Resolve lt_irrefl: arith. (** * Relationship between [le] and [lt] *) @@ -44,9 +44,9 @@ Proof. apply Nat.lt_succ_r. Qed. -Hint Immediate lt_le_S: arith v62. -Hint Immediate lt_n_Sm_le: arith v62. -Hint Immediate le_lt_n_Sm: arith v62. +Hint Immediate lt_le_S: arith. +Hint Immediate lt_n_Sm_le: arith. +Hint Immediate le_lt_n_Sm: arith. Theorem le_not_lt n m : n <= m -> ~ m < n. Proof. @@ -58,7 +58,7 @@ Proof. apply Nat.lt_nge. Qed. -Hint Immediate le_not_lt lt_not_le: arith v62. +Hint Immediate le_not_lt lt_not_le: arith. (** * Asymmetry *) @@ -79,8 +79,8 @@ Proof. intros. now apply Nat.neq_sym, Nat.neq_0_lt_0. Qed. -Hint Resolve lt_0_Sn lt_n_0 : arith v62. -Hint Immediate neq_0_lt lt_0_neq: arith v62. +Hint Resolve lt_0_Sn lt_n_0 : arith. +Hint Immediate neq_0_lt lt_0_neq: arith. (** * Order and successor *) @@ -97,8 +97,8 @@ Proof. apply Nat.succ_lt_mono. Qed. -Hint Resolve lt_n_Sn lt_S lt_n_S : arith v62. -Hint Immediate lt_S_n : arith v62. +Hint Resolve lt_n_Sn lt_S lt_n_S : arith. +Hint Immediate lt_S_n : arith. (** * Predecessor *) @@ -117,8 +117,8 @@ Proof. intros. now apply Nat.lt_pred_l, Nat.neq_0_lt_0. Qed. -Hint Immediate lt_pred: arith v62. -Hint Resolve lt_pred_n_n: arith v62. +Hint Immediate lt_pred: arith. +Hint Resolve lt_pred_n_n: arith. (** * Transitivity properties *) @@ -126,7 +126,7 @@ Notation lt_trans := Nat.lt_trans (compat "8.4"). Notation lt_le_trans := Nat.lt_le_trans (compat "8.4"). Notation le_lt_trans := Nat.le_lt_trans (compat "8.4"). -Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62. +Hint Resolve lt_trans lt_le_trans le_lt_trans: arith. (** * Large = strict or equal *) @@ -139,7 +139,7 @@ Qed. Notation lt_le_weak := Nat.lt_le_incl (compat "8.4"). -Hint Immediate lt_le_weak: arith v62. +Hint Immediate lt_le_weak: arith. (** * Dichotomy *) diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index 65534b2e3..49152549a 100644 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -42,7 +42,7 @@ Notation max_SS := Nat.succ_max_distr (only parsing). (* end hide *) Hint Resolve - Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith v62. + Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r : arith. Hint Resolve - Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith v62. + Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r : arith. diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index bc3a318cf..1fc8f7907 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -107,13 +107,13 @@ Qed. (** * Hints *) -Hint Resolve minus_n_O: arith v62. -Hint Resolve minus_Sn_m: arith v62. -Hint Resolve minus_diag_reverse: arith v62. -Hint Resolve minus_plus_simpl_l_reverse: arith v62. -Hint Immediate plus_minus: arith v62. -Hint Resolve minus_plus: arith v62. -Hint Resolve le_plus_minus: arith v62. -Hint Resolve le_plus_minus_r: arith v62. -Hint Resolve lt_minus: arith v62. -Hint Immediate lt_O_minus_lt: arith v62. +Hint Resolve minus_n_O: arith. +Hint Resolve minus_Sn_m: arith. +Hint Resolve minus_diag_reverse: arith. +Hint Resolve minus_plus_simpl_l_reverse: arith. +Hint Immediate plus_minus: arith. +Hint Resolve minus_plus: arith. +Hint Resolve le_plus_minus: arith. +Hint Resolve le_plus_minus_r: arith. +Hint Resolve lt_minus: arith. +Hint Immediate lt_O_minus_lt: arith. diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index 965812432..a173efc10 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -31,13 +31,13 @@ Notation mult_0_r := Nat.mul_0_r (compat "8.4"). (* n * 0 = 0 *) Notation mult_1_l := Nat.mul_1_l (compat "8.4"). (* 1 * n = n *) Notation mult_1_r := Nat.mul_1_r (compat "8.4"). (* n * 1 = n *) -Hint Resolve mult_1_l mult_1_r: arith v62. +Hint Resolve mult_1_l mult_1_r: arith. (** ** Commutativity *) Notation mult_comm := Nat.mul_comm (compat "8.4"). (* n * m = m * n *) -Hint Resolve mult_comm: arith v62. +Hint Resolve mult_comm: arith. (** ** Distributivity *) @@ -53,9 +53,9 @@ Notation mult_minus_distr_r := Notation mult_minus_distr_l := Nat.mul_sub_distr_l (compat "8.4"). (* n*(m-p) = n*m - n*p *) -Hint Resolve mult_plus_distr_r: arith v62. -Hint Resolve mult_minus_distr_r: arith v62. -Hint Resolve mult_minus_distr_l: arith v62. +Hint Resolve mult_plus_distr_r: arith. +Hint Resolve mult_minus_distr_r: arith. +Hint Resolve mult_minus_distr_l: arith. (** ** Associativity *) @@ -66,8 +66,8 @@ Proof. symmetry. apply Nat.mul_assoc. Qed. -Hint Resolve mult_assoc_reverse: arith v62. -Hint Resolve mult_assoc: arith v62. +Hint Resolve mult_assoc_reverse: arith. +Hint Resolve mult_assoc: arith. (** ** Inversion lemmas *) @@ -92,7 +92,7 @@ Lemma mult_O_le n m : m = 0 \/ n <= m * n. Proof. destruct m; [left|right]; simpl; trivial using Nat.le_add_r. Qed. -Hint Resolve mult_O_le: arith v62. +Hint Resolve mult_O_le: arith. Lemma mult_le_compat_l n m p : n <= m -> p * n <= p * m. Proof. diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v index 3b823da6f..600e5e518 100644 --- a/theories/Arith/Plus.v +++ b/theories/Arith/Plus.v @@ -177,12 +177,12 @@ Proof (succ_plus_discr n 3). (** * Compatibility Hints *) -Hint Immediate plus_comm : arith v62. -Hint Resolve plus_assoc plus_assoc_reverse : arith v62. -Hint Resolve plus_le_compat_l plus_le_compat_r : arith v62. -Hint Resolve le_plus_l le_plus_r le_plus_trans : arith v62. -Hint Immediate lt_plus_trans : arith v62. -Hint Resolve plus_lt_compat_l plus_lt_compat_r : arith v62. +Hint Immediate plus_comm : arith. +Hint Resolve plus_assoc plus_assoc_reverse : arith. +Hint Resolve plus_le_compat_l plus_le_compat_r : arith. +Hint Resolve le_plus_l le_plus_r le_plus_trans : arith. +Hint Immediate lt_plus_trans : arith. +Hint Resolve plus_lt_compat_l plus_lt_compat_r : arith. (** For compatibility, we "Require" the same files as before *) diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index 721ab6932..06096c66a 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -39,13 +39,13 @@ Lemma diff_true_false : true <> false. Proof. discriminate. Qed. -Hint Resolve diff_true_false : bool v62. +Hint Resolve diff_true_false : bool. Lemma diff_false_true : false <> true. Proof. discriminate. Qed. -Hint Resolve diff_false_true : bool v62. +Hint Resolve diff_false_true : bool. Hint Extern 1 (false <> true) => exact diff_false_true. Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False. @@ -82,7 +82,7 @@ Definition leb (b1 b2:bool) := | true => b2 = true | false => True end. -Hint Unfold leb: bool v62. +Hint Unfold leb: bool. Lemma leb_implb : forall b1 b2, leb b1 b2 <-> implb b1 b2 = true. Proof. @@ -242,14 +242,14 @@ Lemma orb_true_intro : Proof. intros; apply orb_true_iff; trivial. Qed. -Hint Resolve orb_true_intro: bool v62. +Hint Resolve orb_true_intro: bool. Lemma orb_false_intro : forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false. Proof. intros. subst. reflexivity. Qed. -Hint Resolve orb_false_intro: bool v62. +Hint Resolve orb_false_intro: bool. Lemma orb_false_elim : forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false. @@ -268,7 +268,7 @@ Lemma orb_true_r : forall b:bool, b || true = true. Proof. destr_bool. Qed. -Hint Resolve orb_true_r: bool v62. +Hint Resolve orb_true_r: bool. Lemma orb_true_l : forall b:bool, true || b = true. Proof. @@ -284,13 +284,13 @@ Lemma orb_false_r : forall b:bool, b || false = b. Proof. destr_bool. Qed. -Hint Resolve orb_false_r: bool v62. +Hint Resolve orb_false_r: bool. Lemma orb_false_l : forall b:bool, false || b = b. Proof. destr_bool. Qed. -Hint Resolve orb_false_l: bool v62. +Hint Resolve orb_false_l: bool. Notation orb_b_false := orb_false_r (only parsing). Notation orb_false_b := orb_false_l (only parsing). @@ -301,7 +301,7 @@ Lemma orb_negb_r : forall b:bool, b || negb b = true. Proof. destr_bool. Qed. -Hint Resolve orb_negb_r: bool v62. +Hint Resolve orb_negb_r: bool. Notation orb_neg_b := orb_negb_r (only parsing). @@ -318,7 +318,7 @@ Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3. Proof. destr_bool. Qed. -Hint Resolve orb_comm orb_assoc: bool v62. +Hint Resolve orb_comm orb_assoc: bool. (*******************************) (** * Properties of [andb] *) @@ -392,7 +392,7 @@ Lemma andb_false_elim : Proof. destruct b1; simpl; auto. Defined. -Hint Resolve andb_false_elim: bool v62. +Hint Resolve andb_false_elim: bool. (** Complementation *) @@ -400,7 +400,7 @@ Lemma andb_negb_r : forall b:bool, b && negb b = false. Proof. destr_bool. Qed. -Hint Resolve andb_negb_r: bool v62. +Hint Resolve andb_negb_r: bool. Notation andb_neg_b := andb_negb_r (only parsing). @@ -418,7 +418,7 @@ Proof. destr_bool. Qed. -Hint Resolve andb_comm andb_assoc: bool v62. +Hint Resolve andb_comm andb_assoc: bool. (*******************************************) (** * Properties mixing [andb] and [orb] *) @@ -688,7 +688,7 @@ Lemma andb_prop_intro : Proof. destr_bool; tauto. Qed. -Hint Resolve andb_prop_intro: bool v62. +Hint Resolve andb_prop_intro: bool. Notation andb_true_intro2 := (fun b1 b2 H1 H2 => andb_prop_intro b1 b2 (conj H1 H2)) @@ -699,7 +699,7 @@ Lemma andb_prop_elim : Proof. destr_bool; auto. Qed. -Hint Resolve andb_prop_elim: bool v62. +Hint Resolve andb_prop_elim: bool. Notation andb_prop2 := andb_prop_elim (only parsing). diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v index 11f3d1d6f..4257b4bc1 100644 --- a/theories/Bool/IfProp.v +++ b/theories/Bool/IfProp.v @@ -12,7 +12,7 @@ Inductive IfProp (A B:Prop) : bool -> Prop := | Iftrue : A -> IfProp A B true | Iffalse : B -> IfProp A B false. -Hint Resolve Iftrue Iffalse: bool v62. +Hint Resolve Iftrue Iffalse: bool. Lemma Iftrue_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = true -> A. destruct 1; intros; auto with bool. diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 4a5f2ad69..4536dfc0f 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -64,7 +64,7 @@ Definition identity_rect_r : intros A x P H y H0; case identity_sym with (1 := H0); trivial. Defined. -Hint Immediate identity_sym not_identity_sym: core v62. +Hint Immediate identity_sym not_identity_sym: core. Notation refl_id := identity_refl (compat "8.3"). Notation sym_id := identity_sym (compat "8.3"). diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index 3749baf61..6c4a63501 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -33,7 +33,6 @@ Open Scope nat_scope. Definition eq_S := f_equal S. Definition f_equal_nat := f_equal (A:=nat). -Hint Resolve eq_S: v62. Hint Resolve f_equal_nat: core. (** The predecessor function *) @@ -41,7 +40,6 @@ Hint Resolve f_equal_nat: core. Notation pred := Nat.pred (compat "8.4"). Definition f_equal_pred := f_equal pred. -Hint Resolve f_equal_pred: v62. Theorem pred_Sn : forall n:nat, n = pred (S n). Proof. @@ -85,7 +83,6 @@ Notation plus := Nat.add (compat "8.4"). Infix "+" := Nat.add : nat_scope. Definition f_equal2_plus := f_equal2 plus. -Hint Resolve f_equal2_plus: v62. Definition f_equal2_nat := f_equal2 (A1:=nat) (A2:=nat). Hint Resolve f_equal2_nat: core. diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index d1038186e..9fc00e80c 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -299,7 +299,7 @@ Proof. apply (h2 h1). Defined. -Hint Resolve left right inleft inright: core v62. +Hint Resolve left right inleft inright: core. Hint Resolve exist exist2 existT existT2: core. (* Compatibility *) diff --git a/theories/Lists/List.v b/theories/Lists/List.v index bf21ffb47..30f1dec22 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -340,11 +340,11 @@ Section Facts. End Facts. -Hint Resolve app_assoc app_assoc_reverse: datatypes v62. -Hint Resolve app_comm_cons app_cons_not_nil: datatypes v62. -Hint Immediate app_eq_nil: datatypes v62. -Hint Resolve app_eq_unit app_inj_tail: datatypes v62. -Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes v62. +Hint Resolve app_assoc app_assoc_reverse: datatypes. +Hint Resolve app_comm_cons app_cons_not_nil: datatypes. +Hint Immediate app_eq_nil: datatypes. +Hint Resolve app_eq_unit app_inj_tail: datatypes. +Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes. @@ -1544,7 +1544,7 @@ Section length_order. End length_order. Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: - datatypes v62. + datatypes. (******************************) @@ -1613,7 +1613,7 @@ Section SetIncl. End SetIncl. Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons - incl_app: datatypes v62. + incl_app: datatypes. (**************************************) @@ -2365,7 +2365,7 @@ Notation rev_acc := rev_append (only parsing). Notation rev_acc_rev := rev_append_rev (only parsing). Notation AllS := Forall (only parsing). (* was formerly in TheoryList *) -Hint Resolve app_nil_end : datatypes v62. +Hint Resolve app_nil_end : datatypes. (* end hide *) Section Repeat. diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v index 7ec3d2503..1c302b22f 100644 --- a/theories/Lists/Streams.v +++ b/theories/Lists/Streams.v @@ -51,7 +51,7 @@ Lemma tl_nth_tl : Proof. simple induction n; simpl; auto. Qed. -Hint Resolve tl_nth_tl: datatypes v62. +Hint Resolve tl_nth_tl: datatypes. Lemma Str_nth_tl_plus : forall (n m:nat) (s:Stream), diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v index f3a2783e1..5ef86b8e7 100644 --- a/theories/Logic/Eqdep.v +++ b/theories/Logic/Eqdep.v @@ -33,5 +33,5 @@ Export EqdepTheory. (** Exported hints *) -Hint Resolve eq_dep_eq: eqdep v62. +Hint Resolve eq_dep_eq: eqdep. Hint Resolve inj_pair2 inj_pairT2: eqdep. diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index f26bac2bb..379fee6f4 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -389,7 +389,7 @@ Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. Proof. split; ring. Qed. -Hint Resolve Rplus_ne: real v62. +Hint Resolve Rplus_ne: real. (**********) @@ -425,7 +425,6 @@ Proof. apply (f_equal (fun v => v + r)). Qed. -(*i Old i*)Hint Resolve Rplus_eq_compat_l: v62. (**********) Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2. @@ -501,21 +500,21 @@ Lemma Rmult_0_r : forall r, r * 0 = 0. Proof. intro; ring. Qed. -Hint Resolve Rmult_0_r: real v62. +Hint Resolve Rmult_0_r: real. (**********) Lemma Rmult_0_l : forall r, 0 * r = 0. Proof. intro; ring. Qed. -Hint Resolve Rmult_0_l: real v62. +Hint Resolve Rmult_0_l: real. (**********) Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r. Proof. intro; split; ring. Qed. -Hint Resolve Rmult_ne: real v62. +Hint Resolve Rmult_ne: real. (**********) Lemma Rmult_1_r : forall r, r * 1 = r. @@ -530,7 +529,6 @@ Proof. auto with real. Qed. -(*i Old i*)Hint Resolve Rmult_eq_compat_l: v62. Lemma Rmult_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 * r = r2 * r. Proof. @@ -646,7 +644,7 @@ Lemma Ropp_0 : -0 = 0. Proof. ring. Qed. -Hint Resolve Ropp_0: real v62. +Hint Resolve Ropp_0: real. (**********) Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0. diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index 9d55e4e63..9fbda92a2 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -32,7 +32,7 @@ Hint Resolve Rplus_assoc: real. (**********) Axiom Rplus_opp_r : forall r:R, r + - r = 0. -Hint Resolve Rplus_opp_r: real v62. +Hint Resolve Rplus_opp_r: real. (**********) Axiom Rplus_0_l : forall r:R, 0 + r = r. @@ -44,11 +44,11 @@ Hint Resolve Rplus_0_l: real. (**********) Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1. -Hint Resolve Rmult_comm: real v62. +Hint Resolve Rmult_comm: real. (**********) Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3). -Hint Resolve Rmult_assoc: real v62. +Hint Resolve Rmult_assoc: real. (**********) Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1. @@ -69,7 +69,7 @@ Hint Resolve R1_neq_R0: real. (**********) Axiom Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3. -Hint Resolve Rmult_plus_distr_l: real v62. +Hint Resolve Rmult_plus_distr_l: real. (*********************************************************) (** * Order axioms *) diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index b6005b9d1..9c98879ce 100644 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -66,10 +66,10 @@ Section Relation_Definition. End Relation_Definition. -Hint Unfold reflexive transitive antisymmetric symmetric: sets v62. +Hint Unfold reflexive transitive antisymmetric symmetric: sets. Hint Resolve Build_preorder Build_order Build_equivalence Build_PER preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl - equiv_trans equiv_sym per_sym per_trans: sets v62. + equiv_trans equiv_sym per_sym per_trans: sets. -Hint Unfold inclusion same_relation commut: sets v62. +Hint Unfold inclusion same_relation commut: sets. diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index ffd682d62..88239475c 100644 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -226,9 +226,9 @@ Section Lexicographic_Exponentiation. End Lexicographic_Exponentiation. -Hint Unfold transp union: sets v62. -Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets v62. -Hint Immediate rst_sym: sets v62. +Hint Unfold transp union: sets. +Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets. +Hint Immediate rst_sym: sets. (* begin hide *) (* Compatibility *) diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index 8a4bb9f42..837437a22 100644 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -122,4 +122,4 @@ Section Ensembles_classical. End Ensembles_classical. Hint Resolve Strict_super_set_contains_new_element Subtract_intro - not_SIncl_empty: sets v62. + not_SIncl_empty: sets. diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index 8d2344f93..6291248eb 100644 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -141,4 +141,4 @@ End Ensembles_facts. Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 Intersection_inv Couple_inv Setminus_intro Strict_Included_intro Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty - not_Empty_Add Inhabited_add Included_Empty: sets v62. + not_Empty_Add Inhabited_add Included_Empty: sets. diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index 8f579214a..0fefb354b 100644 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -90,9 +90,8 @@ Section Ensembles. End Ensembles. -Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets - v62. +Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets. Hint Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro - Extensionality_Ensembles: sets v62. + Extensionality_Ensembles: sets. diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index f38dd6fdf..edbc1efec 100644 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -43,8 +43,8 @@ Section Ensembles_finis. End Ensembles_finis. -Hint Resolve Empty_is_finite Union_is_finite: sets v62. -Hint Resolve card_empty card_add: sets v62. +Hint Resolve Empty_is_finite Union_is_finite: sets. +Hint Resolve card_empty card_add: sets. Require Import Constructive_sets. diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index 34ea857d1..e74ef41e4 100644 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -200,4 +200,4 @@ Section Image. End Image. -Hint Resolve Im_def image_empty finite_image: sets v62. +Hint Resolve Im_def image_empty finite_image: sets. diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index ec38b8923..42d0c76dc 100644 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -187,7 +187,7 @@ End multiset_defs. Unset Implicit Arguments. -Hint Unfold meq multiplicity: v62 datatypes. +Hint Unfold meq multiplicity: datatypes. Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right - munion_empty_left: v62 datatypes. -Hint Immediate meq_sym: v62 datatypes. + munion_empty_left: datatypes. +Hint Immediate meq_sym: datatypes. diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index 3610ebce6..335fec5b0 100644 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -51,8 +51,8 @@ Section Partial_orders. End Partial_orders. -Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets v62. -Hint Resolve Definition_of_covers: sets v62. +Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets. +Hint Resolve Definition_of_covers: sets. Section Partial_order_facts. diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v index d636e0468..7c2435da0 100644 --- a/theories/Sets/Powerset.v +++ b/theories/Sets/Powerset.v @@ -175,14 +175,14 @@ Qed. End The_power_set_partial_order. -Hint Resolve Empty_set_minimal: sets v62. -Hint Resolve Power_set_Inhabited: sets v62. -Hint Resolve Inclusion_is_an_order: sets v62. -Hint Resolve Inclusion_is_transitive: sets v62. -Hint Resolve Union_minimal: sets v62. -Hint Resolve Union_increases_l: sets v62. -Hint Resolve Union_increases_r: sets v62. -Hint Resolve Intersection_decreases_l: sets v62. -Hint Resolve Intersection_decreases_r: sets v62. -Hint Resolve Empty_set_is_Bottom: sets v62. -Hint Resolve Strict_inclusion_is_transitive: sets v62. +Hint Resolve Empty_set_minimal: sets. +Hint Resolve Power_set_Inhabited: sets. +Hint Resolve Inclusion_is_an_order: sets. +Hint Resolve Inclusion_is_transitive: sets. +Hint Resolve Union_minimal: sets. +Hint Resolve Union_increases_l: sets. +Hint Resolve Union_increases_r: sets. +Hint Resolve Intersection_decreases_l: sets. +Hint Resolve Intersection_decreases_r: sets. +Hint Resolve Empty_set_is_Bottom: sets. +Hint Resolve Strict_inclusion_is_transitive: sets. diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index 09c90506b..e802beac9 100644 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -90,7 +90,7 @@ Section Sets_as_an_algebra. apply Subtract_intro; auto with sets. red; intro H'1; apply H'; rewrite H'1; auto with sets. Qed. - Hint Resolve incl_soustr_add_r: sets v62. + Hint Resolve incl_soustr_add_r: sets. Lemma add_soustr_2 : forall (X:Ensemble U) (x:U), @@ -328,9 +328,9 @@ Section Sets_as_an_algebra. End Sets_as_an_algebra. -Hint Resolve incl_soustr_in: sets v62. -Hint Resolve incl_soustr: sets v62. -Hint Resolve incl_soustr_add_l: sets v62. -Hint Resolve incl_soustr_add_r: sets v62. -Hint Resolve add_soustr_1 add_soustr_2: sets v62. -Hint Resolve add_soustr_xy: sets v62. +Hint Resolve incl_soustr_in: sets. +Hint Resolve incl_soustr: sets. +Hint Resolve incl_soustr_add_l: sets. +Hint Resolve incl_soustr_add_r: sets. +Hint Resolve add_soustr_1 add_soustr_2: sets. +Hint Resolve add_soustr_xy: sets. diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index 63e84199d..e9696a1ca 100644 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -254,5 +254,5 @@ Section Sets_as_an_algebra. End Sets_as_an_algebra. Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add - singlx incl_add: sets v62. + singlx incl_add: sets. diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v index de96fa560..45fb8134c 100644 --- a/theories/Sets/Relations_1.v +++ b/theories/Sets/Relations_1.v @@ -60,6 +60,6 @@ Section Relations_1. End Relations_1. Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains - same_relation: sets v62. + same_relation: sets. Hint Resolve Definition_of_preorder Definition_of_order - Definition_of_equivalence Definition_of_PER: sets v62. + Definition_of_equivalence Definition_of_PER: sets. diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v index f1026e31a..1e0b83fe5 100644 --- a/theories/Sets/Relations_2.v +++ b/theories/Sets/Relations_2.v @@ -48,7 +48,7 @@ Definition Strongly_confluent : Prop := End Relations_2. -Hint Resolve Rstar_0: sets v62. -Hint Resolve Rstar1_0: sets v62. -Hint Resolve Rstar1_1: sets v62. -Hint Resolve Rplus_0: sets v62. +Hint Resolve Rstar_0: sets. +Hint Resolve Rstar1_0: sets. +Hint Resolve Rstar1_1: sets. +Hint Resolve Rplus_0: sets. diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v index 92b299885..c05b5ee76 100644 --- a/theories/Sets/Relations_3.v +++ b/theories/Sets/Relations_3.v @@ -51,10 +51,10 @@ Section Relations_3. Definition Noetherian : Prop := forall x:U, noetherian x. End Relations_3. -Hint Unfold coherent: sets v62. -Hint Unfold locally_confluent: sets v62. -Hint Unfold confluent: sets v62. -Hint Unfold Confluent: sets v62. -Hint Resolve definition_of_noetherian: sets v62. -Hint Unfold Noetherian: sets v62. +Hint Unfold coherent: sets. +Hint Unfold locally_confluent: sets. +Hint Unfold confluent: sets. +Hint Unfold Confluent: sets. +Hint Resolve definition_of_noetherian: sets. +Hint Unfold Noetherian: sets. diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 1ac00bddd..90754af3b 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -56,7 +56,7 @@ Section wf_proof. End wf_proof. -Hint Resolve Zwf_well_founded: datatypes v62. +Hint Resolve Zwf_well_founded: datatypes. (** We also define the other family of relations: @@ -88,4 +88,4 @@ Section wf_proof_up. End wf_proof_up. -Hint Resolve Zwf_up_well_founded: datatypes v62. +Hint Resolve Zwf_up_well_founded: datatypes. -- cgit v1.2.3 From 2d687dec5709695942aa6a92197a5e5e2a91b616 Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Mon, 24 Oct 2016 17:35:04 +0200 Subject: Remove v62 from the codebase. --- tactics/auto.mli | 8 +++----- tactics/eauto.ml | 4 +--- tactics/hints.ml | 3 +-- 3 files changed, 5 insertions(+), 10 deletions(-) diff --git a/tactics/auto.mli b/tactics/auto.mli index 5384140c2..04791a526 100644 --- a/tactics/auto.mli +++ b/tactics/auto.mli @@ -48,17 +48,15 @@ val new_auto : ?debug:Tacexpr.debug -> (** auto with default search depth and with the hint database "core" *) val default_auto : unit Proofview.tactic -(** auto with all hint databases except the "v62" compatibility database *) +(** auto with all hint databases *) val full_auto : ?debug:Tacexpr.debug -> int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic -(** auto with all hint databases except the "v62" compatibility database - and doing delta *) +(** auto with all hint databases and doing delta *) val new_full_auto : ?debug:Tacexpr.debug -> int -> Tacexpr.delayed_open_constr list -> unit Proofview.tactic -(** auto with default search depth and with all hint databases - except the "v62" compatibility database *) +(** auto with default search depth and with all hint databases *) val default_full_auto : unit Proofview.tactic (** The generic form of auto (second arg [None] means all bases) *) diff --git a/tactics/eauto.ml b/tactics/eauto.ml index c6d244867..480185337 100644 --- a/tactics/eauto.ml +++ b/tactics/eauto.ml @@ -410,9 +410,7 @@ let eauto ?(debug=Off) np lems dbnames = tclTRY (e_search_auto debug np lems db_list) let full_eauto ?(debug=Off) n lems gl = - let dbnames = current_db_names () in - let dbnames = String.Set.remove "v62" dbnames in - let db_list = List.map searchtable_map (String.Set.elements dbnames) in + let db_list = current_pure_db () in tclTRY (e_search_auto debug n lems db_list) gl let gen_eauto ?(debug=Off) np lems = function diff --git a/tactics/hints.ml b/tactics/hints.ml index 89ecc6c0b..1ebd32c37 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -657,8 +657,7 @@ let searchtable_add (name,db) = let current_db_names () = Hintdbmap.domain !searchtable let current_db () = Hintdbmap.bindings !searchtable -let current_pure_db () = - List.map snd (Hintdbmap.bindings (Hintdbmap.remove "v62" !searchtable)) +let current_pure_db () = List.map snd (current_db ()) let error_no_such_hint_database x = errorlabstrm "Hints" (str "No such Hint database: " ++ str x ++ str ".") -- cgit v1.2.3 From 5737c8a41782ee66e96f4e855b00e396a23e8479 Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Mon, 24 Oct 2016 17:39:06 +0200 Subject: Remove v62 from the refman. --- doc/refman/RefMan-tac.tex | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index 2da12c8d6..0aabaf6a8 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -3493,8 +3493,7 @@ hints of the database named {\tt core}. \item {\tt auto with *} - Uses all existing hint databases, minus the special database - {\tt v62}. See Section~\ref{Hints-databases} + Uses all existing hint databases. See Section~\ref{Hints-databases} \item \texttt{auto using} \nterm{lemma}$_1$ {\tt ,} {\ldots} {\tt ,} \nterm{lemma}$_n$ @@ -3962,8 +3961,8 @@ Several hint databases are defined in the \Coq\ standard library. The actual content of a database is the collection of the hints declared to belong to this database in each of the various modules currently loaded. Especially, requiring new modules potentially extend a -database. At {\Coq} startup, only the {\tt core} and {\tt v62} -databases are non empty and can be used. +database. At {\Coq} startup, only the {\tt core} database is non empty +and can be used. \begin{description} @@ -3998,18 +3997,8 @@ databases are non empty and can be used. from the \texttt{Classes} directory. \end{description} -There is also a special database called {\tt v62}. It collects all -hints that were declared in the versions of {\Coq} prior to version -6.2.4 when the databases {\tt core}, {\tt arith}, and so on were -introduced. The purpose of the database {\tt v62} is to ensure -compatibility with further versions of {\Coq} for developments done in -versions prior to 6.2.4 ({\tt auto} being replaced by {\tt auto with v62}). -The database {\tt v62} is intended not to be extended (!). It is not -included in the hint databases list used in the {\tt auto with *} tactic. - -Furthermore, you are advised not to put your own hints in the -{\tt core} database, but use one or several databases specific to your -development. +You are advised not to put your own hints in the {\tt core} database, +but use one or several databases specific to your development. \subsection{\tt Remove Hints \term$_1$ \mbox{\dots} \term$_n$ :~ \ident$_1$ \mbox{\dots} \ident$_m$} -- cgit v1.2.3 From e807f3407fb19f481dac332e7650eddfa9b5fd5d Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 14 Oct 2016 16:53:19 +0200 Subject: Documenting changes in typeclasses --- doc/refman/Classes.tex | 144 +++++++++++++++++++++++++++++++++++++++++++--- doc/refman/RefMan-tac.tex | 2 +- tactics/tactics.ml | 2 +- 3 files changed, 139 insertions(+), 9 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index e8ebb9f99..e90621f04 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -9,10 +9,6 @@ \aauthor{Matthieu Sozeau} \label{typeclasses} -\begin{flushleft} - \em The status of Type Classes is experimental. -\end{flushleft} - This chapter presents a quick reference of the commands related to type classes. For an actual introduction to type classes, there is a description of the system \cite{sozeau08} and the literature on type @@ -382,6 +378,55 @@ projections as instances. This is almost equivalent to {\tt Hint Resolve Declares variables according to the given binding context, which might use implicit generalization (see \ref{SectionContext}). +\asubsection{\tt typeclasses eauto} +\tacindex{typeclasseseauto} + +The {\tt typeclasses eauto} tactic uses a different resolution engine +than {\tt eauto} and {\tt auto}. The main differences are the following: +\begin{itemize} +\item Contrary to {\tt eauto} and {\tt auto}, the resolution is done + entirely in the new proof engine (as of Coq v8.6), meaning that + backtracking is available among dependent subgoals, and shelving goals + is supported. It analyses the dependencies between subgoals to avoid + backtracking on subgoals that are entirely independent. +\item When called with no arguments, {\tt typeclasses eauto} uses the + {\tt typeclass\_instances} database by default (instead of {\tt core}) + and will try to solve \emph{only} typeclass goals. Other subgoals are + automatically shelved and \emph{must be} resolved entirely when the + other typeclass subgoals are resolved. +\item The transparency information of databases is used consistently. + When considering the local hypotheses, we use the transparent + state of the first hint database given. Using an empty database + (created with {\tt Create HintDb} for example) with + unfoldable variables and constants as the first argument of + typeclasses eauto hence makes resolution with the local hypotheses use + full conversion during unification. +\end{itemize} + +\begin{Variants} +\item \label{depth} {\tt typeclasses eauto \zeroone{\num}} + \emph{Warning:} The semantics for the limit {\num} is different than + for {\tt auto}. By default, if no limit is given the search is + unbounded. Contrary to {\tt auto}, introduction steps ({\tt intro}) + are counted, which might result in larger limits being necessary + when searching with {\tt typeclasses eauto} than {\tt auto}. + +\item \label{with} {\tt typeclasses eauto with {\ident}$_1$ \ldots {\ident}$_n$}. + This variant runs resolution with the given hint databases. It does + not treat typeclass subgoals differently than others. +\end{Variants} + +\asubsection{\tt autoapply {\term} with {\ident}} +\tacindex{autoapply} + +The tactic {\tt autoapply} applies a term using the transparency +information of the hint database {\ident}, and does \emph{no} typeclass +resolution. This can be used in {\tt Hint Extern}'s for typeclasse +instances (in hint db {\tt typeclass\_instances}) to +allow backtracking on the typeclass subgoals created by the lemma +application, rather than doing type class resolution locally at the hint +application time. + \subsection{\tt Typeclasses Transparent, Opaque {\ident$_1$ \ldots \ident$_n$}} \comindex{Typeclasses Transparent} \comindex{Typeclasses Opaque} @@ -400,18 +445,103 @@ abbreviate a type, like {\tt relation A := A -> A -> Prop}. This is equivalent to {\tt Hint Transparent,Opaque} {\ident} {\tt: typeclass\_instances}. +\subsection{\tt Set Typeclasses Module Eta} +\optindex{Typeclasses Modulo Eta} + +This allows eta-conversion during unification of type-classes. + +\subsection{\tt Set Typeclasses Dependency Order} +\optindex{Typeclasses Dependency Order} + +This option (now on by default) respects the dependency order between +subgoals, meaning that subgoals which are depended on by other subgoals +come first, while the non-dependent subgoals were put before the +dependent ones previously (Coq v8.5 and below). This can result in quite +different performance behaviors of proof search. + +\subsection{\tt Set Typeclasses Legacy Resolution} +\optindex{Typeclasses Legacy Resolution} + +This option (off by default) uses the 8.5 implementation of resolution. +Use for compatibility purposes only (porting and debugging). + +\subsection{\tt Set Typeclasses Limit Intros} +\optindex{Typeclasses Limit Intros} + +This option (on by default in Coq 8.6 and below), controls the ability +to apply hints while avoiding eta-expansions in the proof term +generated. It does so by allowing hints that conclude in an product to +apply to a goal with a matching product directly, avoiding an +introduction. \emph{Warning:} can be expensive as it requires rebuilding +hint clauses dynamically, and does not benefit from the invertibility +status of the product introduction rule, resulting in more expensive +proof-search (i.e. more useless backtracking). + +\subsection{\tt Set Typeclasses Filtered Unification} +\optindex{Typeclasses Filtered Unification} + +This option, available since Coq 8.6, switches the hint application +procedure to a filter-then-unify strategy. To apply a hint, we first +check that it \emph{matches} syntactically the inferred pattern of the +hint, and only then try to \emph{unify} the goal with the conclusion of +the hint. This can drastically improve performance by calling +unification less often, matching syntactic patterns being very +quick. This also provides more control on the triggering of instances. +For example, forcing a constant to explicitely appear in the pattern +will make it never apply on a goal where there is a hole in that place. + +\subsection{\tt Set Typeclass Resolution After Apply} +\optindex{Typeclasses Resolution After Apply} +\emph{Deprecated since 8.6} + +This option (off by default in Coq 8.6 and 8.5) controls the resolution +of typeclass subgoals generated by the {\tt apply} tactic. + +\subsection{\tt Set Typeclass Resolution For Conversion} +\optindex{Typeclasses Resolution For Conversion} + +This option (on by default) controls the use of typeclass resolution +when a unification problem cannot be solved during +elaboration/type-inference. With this option on, when a unification +fails, typeclass resolution is tried before launching unification once again. + +\subsection{\tt Set Typeclasses Strict Resolution} +\optindex{Typeclasses Strict Resolution} + +Typeclass declarations introduced when this option is set have a +stricter resolution behavior (the option is off by default). When +looking for unifications of a goal with an instance of this class, we +``freeze'' all the existentials appearing in the goals, meaning that +they are considered rigid during unification and cannot be instantiated. + +\subsection{\tt Set Typeclasses Unique Solutions} +\optindex{Typeclasses Unique Solutions} + +When a typeclass resolution is launched we ensure that it has a single +solution or fail. This ensures that the resolution is canonical, but can +make proof search much more expensive. + +\subsection{\tt Set Typeclasses Unique Instances} +\optindex{Typeclasses Unique Instances} + +Typeclass declarations introduced when this option is set have a +more efficient resolution behavior (the option is off by default). When +a solution to the typeclass goal of this class is found, we never +backtrack on it, assuming that it is canonical. + \subsection{\tt Typeclasses eauto := [debug] [dfs | bfs] [\emph{depth}]} \comindex{Typeclasses eauto} \label{TypeclassesEauto} -This command allows customization of the type class resolution tactic, -based on a variant of eauto. The flags semantics are: +This command allows more global customization of the type class +resolution tactic. +The semantics of the options are: \begin{itemize} \item {\tt debug} In debug mode, the trace of successfully applied tactics is printed. \item {\tt dfs, bfs} This sets the search strategy to depth-first search (the default) or breadth-first search. -\item {\emph{depth}} This sets the depth of the search (the default is 100). +\item {\emph{depth}} This sets the depth limit of the search. \end{itemize} \subsection{\tt Set Refine Instance Mode} diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index dd45feebc..c659e19e6 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -3907,7 +3907,7 @@ Abort. \comindex{Hint Cut} \textit{Warning:} these hints currently only apply to typeclass proof search and - the \texttt{typeclasses eauto} tactic. + the \texttt{typeclasses eauto} tactic (\ref{typeclasseseauto}). This command can be used to cut the proof-search tree according to a regular expression matching paths to be cut. The grammar for regular diff --git a/tactics/tactics.ml b/tactics/tactics.ml index d2e5d8525..88e84f418 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -83,7 +83,7 @@ let _ = let apply_solve_class_goals = ref (false) let _ = Goptions.declare_bool_option { - Goptions.optsync = true; Goptions.optdepr = false; + Goptions.optsync = true; Goptions.optdepr = true; Goptions.optname = "Perform typeclass resolution on apply-generated subgoals."; Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"]; -- cgit v1.2.3 From 7ba82ed9f595c7d93bd40846993c2447572a817a Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 2 Nov 2016 15:54:37 +0100 Subject: Put string between quotes when printing an option value. This is a better (more generic) fix to #5061 than my e8b9ee76. --- library/goptions.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/goptions.ml b/library/goptions.ml index 35616558a..dfb3c0e69 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -381,9 +381,9 @@ let msg_option_value (name,v) = | BoolValue false -> str "off" | IntValue (Some n) -> int n | IntValue None -> str "undefined" - | StringValue s -> str s + | StringValue s -> str "\"" ++ str s ++ str "\"" | StringOptValue None -> str"undefined" - | StringOptValue (Some s) -> str s + | StringOptValue (Some s) -> str "\"" ++ str s ++ str "\"" (* | IdentValue r -> pr_global_env Id.Set.empty r *) let print_option_value key = -- cgit v1.2.3 From 2c5eef988f11979175de6d1983bc533ce18b1095 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 2 Nov 2016 15:57:19 +0100 Subject: Fix various shortcomings of the warnings infrastructure. - The flags are now interpreted from left to right, without any other precedence rule. The previous one did not make much sense in interactive mode. - Set Warnings and Set Warnings Append are now synonyms, and have the "append" semantics, which is the most natural one for warnings. - Warnings on unknown warnings are now printed only once (previously the would be repeated on further calls to Set Warnings, sections closing, module requiring...). - Warning status strings are normalized, so that e.g. "+foo,-foo" is reduced to "-foo" (if foo exists, "" otherwise). --- lib/cWarnings.ml | 116 +++++++++++++++++++++++++++++++++++----------- lib/cWarnings.mli | 23 ++------- library/goptions.ml | 7 +-- library/goptions.mli | 14 ++++-- parsing/g_vernac.ml4 | 13 ++++-- toplevel/vernacentries.ml | 2 +- 6 files changed, 118 insertions(+), 57 deletions(-) diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 720f54606..68664d1ab 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -21,7 +21,7 @@ let warnings : (string, t) Hashtbl.t = Hashtbl.create 97 let categories : (string, string list) Hashtbl.t = Hashtbl.create 97 let current_loc = ref Loc.ghost -let flags = ref "default" +let flags = ref "" let set_current_loc = (:=) current_loc @@ -62,7 +62,7 @@ let set_warning_status ~name status = try let w = Hashtbl.find warnings name in Hashtbl.replace warnings name { w with status = status } - with Not_found -> warn_unknown_warning name + with Not_found -> () let reset_default_warnings () = Hashtbl.iter (fun name w -> @@ -74,6 +74,13 @@ let set_all_warnings_status status = Hashtbl.replace warnings name { w with status }) warnings +let set_category_status ~name status = + let names = Hashtbl.find categories name in + List.iter (fun name -> set_warning_status name status) names + +let is_all_keyword name = CString.equal name "all" +let is_none_keyword s = CString.equal s "none" + let parse_flag s = if String.length s > 1 then match String.get s 0 with @@ -82,39 +89,94 @@ let parse_flag s = | _ -> (Enabled, s) else CErrors.error "Invalid warnings flag" -let rec do_all_keyword = function - | [] -> [] - | (status, name as item) :: items -> - if CString.equal name "all" then - (set_all_warnings_status status; do_all_keyword items) - else item :: do_all_keyword items - -let rec do_categories = function - | [] -> [] - | (status, name as item) :: items -> - try - let names = Hashtbl.find categories name in - List.iter (fun name -> set_warning_status name status) names; - do_categories items - with Not_found -> item :: do_categories items +let string_of_flag (status,name) = + match status with + | AsError -> "+" ^ name + | Disabled -> "-" ^ name + | Enabled -> name + +let string_of_flags flags = + String.concat "," (List.map string_of_flag flags) + +let set_status ~name status = + if is_all_keyword name then + set_all_warnings_status status + else + try + set_category_status ~name status + with Not_found -> + try + set_warning_status ~name status + with Not_found -> () + +let split_flags s = + let reg = Str.regexp "[ ,]+" in Str.split reg s + +let check_warning ~silent (_status,name) = + is_all_keyword name || + Hashtbl.mem categories name || + Hashtbl.mem warnings name || + (if not silent then warn_unknown_warning name; false) + +(** [cut_before_all_rev] removes all flags subsumed by a later occurrence of the + "all" flag, and reverses the list. *) +let rec cut_before_all_rev acc = function + | [] -> acc + | (_status,name as w) :: warnings -> + cut_before_all_rev (w :: if is_all_keyword name then [] else acc) warnings + +let cut_before_all_rev warnings = cut_before_all_rev [] warnings + +(** [uniquize_flags_rev] removes flags that are subsumed by later occurrences of + themselves or their categories, and reverses the list. *) +let uniquize_flags_rev flags = + let rec aux acc visited = function + | (_,name as flag)::flags -> + if CString.Set.mem name visited then aux acc visited flags else + let visited = + try + let warnings = Hashtbl.find categories name in + CString.Set.union visited (CString.Set.of_list warnings) + with Not_found -> + visited + in + aux (flag::acc) (CString.Set.add name visited) flags + | [] -> acc + in aux [] CString.Set.empty flags + +(** [normalize_flags] removes unknown or redundant warnings. If [silent] is + true, it emits a warning when an unknown warning is met. *) +let normalize_flags ~silent warnings = + let warnings = List.filter (check_warning ~silent) warnings in + let warnings = cut_before_all_rev warnings in + uniquize_flags_rev warnings + +let flags_of_string s = List.map parse_flag (split_flags s) + +let normalize_flags_string s = + if is_none_keyword s then s + else + let flags = flags_of_string s in + let flags = normalize_flags ~silent:false flags in + string_of_flags flags let rec parse_warnings items = - List.iter (fun (status, name) -> set_warning_status ~name status) items + CList.iter (fun (status, name) -> set_status ~name status) items (* For compatibility, we accept "none" *) -let parse_flags s = - if CString.equal s "none" then begin +let parse_flags s = + if is_none_keyword s then begin Flags.make_warn false; - set_all_warnings_status Disabled + set_all_warnings_status Disabled; + "none" end else begin Flags.make_warn true; - let reg = Str.regexp "[ ,]+" in - let items = List.map parse_flag (Str.split reg s) in - let items = do_all_keyword items in - let items = do_categories items in - parse_warnings items + let flags = flags_of_string s in + let flags = normalize_flags ~silent:true flags in + parse_warnings flags; + string_of_flags flags end let set_flags s = - flags := s; reset_default_warnings (); parse_flags s + reset_default_warnings (); let s = parse_flags s in flags := s diff --git a/lib/cWarnings.mli b/lib/cWarnings.mli index 351554284..3f6cee31b 100644 --- a/lib/cWarnings.mli +++ b/lib/cWarnings.mli @@ -6,29 +6,16 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -type status = - Disabled | Enabled | AsError - -(* -type 'a repr = { - print : 'a -> Pp.std_ppcmds; - kind : string; - enabled : bool; -} - *) +type status = Disabled | Enabled | AsError val set_current_loc : Loc.t -> unit val create : name:string -> category:string -> ?default:status -> ('a -> Pp.std_ppcmds) -> ?loc:Loc.t -> 'a -> unit -(* -val emit : 'a t -> 'a -> unit - -type any = Any : string * string * 'a repr -> any - -val dump : unit -> any list - *) - val get_flags : unit -> string val set_flags : string -> unit + +(** Cleans up a user provided warnings status string, e.g. removing unknown + warnings (in which case a warning is emitted) or subsumed warnings . *) +val normalize_flags_string : string -> string diff --git a/library/goptions.ml b/library/goptions.ml index dfb3c0e69..9dc0f4058 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -247,7 +247,7 @@ let get_locality = function | Some false -> OptGlobal | None -> OptDefault -let declare_option cast uncast append +let declare_option cast uncast append ?(preprocess = fun x -> x) { optsync=sync; optdepr=depr; optname=name; optkey=key; optread=read; optwrite=write } = check_key key; let default = read() in @@ -275,10 +275,11 @@ let declare_option cast uncast append subst_function = subst_options; discharge_function = discharge_options; classify_function = classify_options } in - (fun l m v -> Lib.add_anonymous_leaf (options (l, m, v))) + (fun l m v -> let v = preprocess v in Lib.add_anonymous_leaf (options (l, m, v))) else (fun _ m v -> - match m with + let v = preprocess v in + match m with | OptSet -> write v | OptAppend -> write (append (read ()) v)) in diff --git a/library/goptions.mli b/library/goptions.mli index ca2df0710..3b3651f39 100644 --- a/library/goptions.mli +++ b/library/goptions.mli @@ -122,13 +122,19 @@ type 'a option_sig = { (** When an option is declared synchronous ([optsync] is [true]), the output is a synchronous write function. Otherwise it is [optwrite] *) +(** The [preprocess] function is triggered before setting the option. It can be + used to emit a warning on certain values, and clean-up the final value. *) type 'a write_function = 'a -> unit -val declare_int_option : int option option_sig -> int option write_function -val declare_bool_option : bool option_sig -> bool write_function -val declare_string_option: string option_sig -> string write_function -val declare_stringopt_option: string option option_sig -> string option write_function +val declare_int_option : ?preprocess:(int option -> int option) -> + int option option_sig -> int option write_function +val declare_bool_option : ?preprocess:(bool -> bool) -> + bool option_sig -> bool write_function +val declare_string_option: ?preprocess:(string -> string) -> + string option_sig -> string write_function +val declare_stringopt_option: ?preprocess:(string option -> string option) -> + string option option_sig -> string option write_function (** {6 Special functions supposed to be used only in vernacentries.ml } *) diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index e0d836df8..a33e7257a 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -866,11 +866,16 @@ GEXTEND Gram | "Set"; table = option_table; v = option_value -> begin match v with | StringValue s -> - let (last, prefix) = List.sep_last table in - if String.equal last "Append" && not (List.is_empty prefix) then - VernacSetAppendOption (prefix, s) + (* We make a special case for warnings because appending is their + natural semantics *) + if CString.List.equal table ["Warnings"] then + VernacSetAppendOption (table, s) else - VernacSetOption (table, v) + let (last, prefix) = List.sep_last table in + if String.equal last "Append" && not (List.is_empty prefix) then + VernacSetAppendOption (prefix, s) + else + VernacSetOption (table, v) | _ -> VernacSetOption (table, v) end | "Set"; table = option_table -> diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 4de1d9595..c03f183ff 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1491,7 +1491,7 @@ let _ = optwrite = (fun b -> Constrintern.parsing_explicit := b) } let _ = - declare_string_option + declare_string_option ~preprocess:CWarnings.normalize_flags_string { optsync = true; optdepr = false; optname = "warnings display"; -- cgit v1.2.3 From 6ec511721efc9235f6c2fa922a21dcb9b041bbfd Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Thu, 3 Nov 2016 15:51:39 +0100 Subject: Document options of typeclasses (eauto) With update after J. Gross comments --- doc/refman/Classes.tex | 85 +++++++++++++++++++++++++++++++------------------- 1 file changed, 53 insertions(+), 32 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index e90621f04..144fc22b9 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -387,14 +387,16 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: \item Contrary to {\tt eauto} and {\tt auto}, the resolution is done entirely in the new proof engine (as of Coq v8.6), meaning that backtracking is available among dependent subgoals, and shelving goals - is supported. It analyses the dependencies between subgoals to avoid + is supported. {\tt typeclasses eauto} is a multi-goal tactic. + It analyses the dependencies between subgoals to avoid backtracking on subgoals that are entirely independent. \item When called with no arguments, {\tt typeclasses eauto} uses the {\tt typeclass\_instances} database by default (instead of {\tt core}) and will try to solve \emph{only} typeclass goals. Other subgoals are automatically shelved and \emph{must be} resolved entirely when the - other typeclass subgoals are resolved. -\item The transparency information of databases is used consistently. + other typeclass subgoals are resolved or the proof search will fail. +\item The transparency information of databases is used consistently for + all hints declared in them. It is always used when calling the unifier. When considering the local hypotheses, we use the transparent state of the first hint database given. Using an empty database (created with {\tt Create HintDb} for example) with @@ -412,8 +414,9 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: when searching with {\tt typeclasses eauto} than {\tt auto}. \item \label{with} {\tt typeclasses eauto with {\ident}$_1$ \ldots {\ident}$_n$}. - This variant runs resolution with the given hint databases. It does - not treat typeclass subgoals differently than others. + This variant runs resolution with the given hint databases. It treats + typeclass subgoals the same as other subgoals (no shelving of + non-typeclass goals in particular). \end{Variants} \asubsection{\tt autoapply {\term} with {\ident}} @@ -421,7 +424,7 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: The tactic {\tt autoapply} applies a term using the transparency information of the hint database {\ident}, and does \emph{no} typeclass -resolution. This can be used in {\tt Hint Extern}'s for typeclasse +resolution. This can be used in {\tt Hint Extern}'s for typeclass instances (in hint db {\tt typeclass\_instances}) to allow backtracking on the typeclass subgoals created by the lemma application, rather than doing type class resolution locally at the hint @@ -445,50 +448,59 @@ abbreviate a type, like {\tt relation A := A -> A -> Prop}. This is equivalent to {\tt Hint Transparent,Opaque} {\ident} {\tt: typeclass\_instances}. -\subsection{\tt Set Typeclasses Module Eta} -\optindex{Typeclasses Modulo Eta} - -This allows eta-conversion during unification of type-classes. - \subsection{\tt Set Typeclasses Dependency Order} \optindex{Typeclasses Dependency Order} -This option (now on by default) respects the dependency order between +This option (on by default since 8.6) respects the dependency order between subgoals, meaning that subgoals which are depended on by other subgoals come first, while the non-dependent subgoals were put before the dependent ones previously (Coq v8.5 and below). This can result in quite different performance behaviors of proof search. +\subsection{\tt Set Typeclasses Filtered Unification} +\optindex{Typeclasses Filtered Unification} + +This option, available since Coq 8.6 and off by default, switches the +hint application procedure to a filter-then-unify strategy. To apply a +hint, we first check that the goal \emph{matches} syntactically the +inferred or specified pattern of the hint, and only then try to +\emph{unify} the goal with the conclusion of the hint. This can +drastically improve performance by calling unification less often, +matching syntactic patterns being very quick. This also provides more +control on the triggering of instances. For example, forcing a constant +to explicitely appear in the pattern will make it never apply on a goal +where there is a hole in that place. + \subsection{\tt Set Typeclasses Legacy Resolution} \optindex{Typeclasses Legacy Resolution} This option (off by default) uses the 8.5 implementation of resolution. Use for compatibility purposes only (porting and debugging). +\subsection{\tt Set Typeclasses Module Eta} +\optindex{Typeclasses Modulo Eta} + +This option allows eta-conversion for functions and records during +unification of type-classes. This option is now unsupported in 8.6 with +{\tt Typeclasses Filtered Unification} set, but still affects the +default unification strategy, and the one used in {\tt Legacy + Resolution} mode. It is \emph{unset} by default. If {\tt Typeclasses + Filtered Unification} is set, this has no effect and unification will +find solutions up-to eta conversion. Note however that syntactic +pattern-matching is not up-to eta. + \subsection{\tt Set Typeclasses Limit Intros} \optindex{Typeclasses Limit Intros} -This option (on by default in Coq 8.6 and below), controls the ability -to apply hints while avoiding eta-expansions in the proof term -generated. It does so by allowing hints that conclude in an product to +This option (on by default in Coq 8.6 and below) controls the ability to +apply hints while avoiding (functional) eta-expansions in the generated +proof term. It does so by allowing hints that conclude in a product to apply to a goal with a matching product directly, avoiding an -introduction. \emph{Warning:} can be expensive as it requires rebuilding -hint clauses dynamically, and does not benefit from the invertibility -status of the product introduction rule, resulting in more expensive -proof-search (i.e. more useless backtracking). - -\subsection{\tt Set Typeclasses Filtered Unification} -\optindex{Typeclasses Filtered Unification} - -This option, available since Coq 8.6, switches the hint application -procedure to a filter-then-unify strategy. To apply a hint, we first -check that it \emph{matches} syntactically the inferred pattern of the -hint, and only then try to \emph{unify} the goal with the conclusion of -the hint. This can drastically improve performance by calling -unification less often, matching syntactic patterns being very -quick. This also provides more control on the triggering of instances. -For example, forcing a constant to explicitely appear in the pattern -will make it never apply on a goal where there is a hole in that place. +introduction. \emph{Warning:} this can be expensive as it requires +rebuilding hint clauses dynamically, and does not benefit from the +invertibility status of the product introduction rule, resulting in +potentially more expensive proof-search (i.e. more useless +backtracking). \subsection{\tt Set Typeclass Resolution After Apply} \optindex{Typeclasses Resolution After Apply} @@ -544,6 +556,15 @@ The semantics of the options are: \item {\emph{depth}} This sets the depth limit of the search. \end{itemize} +\subsection{\tt Set Typeclasses Debug [Verbosity {\num}]} +\optindex{Typeclasses Debug} +\optindex{Typeclasses Debug Verbosity} + +These options allow to see the resolution steps of typeclasses that are +performed during search. The {\tt Debug} option is synonymous to +{\tt Debug Verbosity 1}, and {\tt Debug Verbosity 2} provides more +information (tried tactics, shelving of goals, etc\ldots). + \subsection{\tt Set Refine Instance Mode} \optindex{Refine Instance Mode} -- cgit v1.2.3 From d6fe6773c959493ed97108e1032b1bd8c1e78081 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 24 Oct 2016 18:18:33 +0200 Subject: Lets Hints/Instances take an optional pattern In addition to a priority, cleanup the interfaces for passing this information as well. The pattern, if given, takes priority over the inferred one. We only allow Existing Instances gr ... gr | pri. for now, without pattern, as before. Make the API compatible to 8.5 as well. --- doc/refman/Classes.tex | 2 +- doc/refman/RefMan-tac.tex | 6 ++-- intf/vernacexpr.mli | 12 +++++-- ltac/extratactics.ml4 | 3 +- ltac/rewrite.ml | 8 ++--- parsing/g_proofs.ml4 | 10 +++--- parsing/g_vernac.ml4 | 26 +++++++++----- parsing/pcoq.ml | 1 + parsing/pcoq.mli | 1 + pretyping/typeclasses.ml | 48 ++++++++++++------------- pretyping/typeclasses.mli | 17 ++++----- printing/ppvernac.ml | 22 +++++++----- printing/prettyp.ml | 2 +- tactics/class_tactics.ml | 18 ++++++---- tactics/hints.ml | 87 ++++++++++++++++++++++++---------------------- tactics/hints.mli | 36 +++++++++++++------ test-suite/success/Hints.v | 6 +++- toplevel/classes.ml | 33 +++++++++++------- toplevel/classes.mli | 8 ++--- toplevel/record.ml | 5 +-- toplevel/record.mli | 3 +- toplevel/vernacentries.ml | 10 +++--- 22 files changed, 212 insertions(+), 152 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index 144fc22b9..254fca28f 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -379,7 +379,7 @@ Declares variables according to the given binding context, which might use implicit generalization (see \ref{SectionContext}). \asubsection{\tt typeclasses eauto} -\tacindex{typeclasseseauto} +\tacindex{typeclasses eauto} The {\tt typeclasses eauto} tactic uses a different resolution engine than {\tt eauto} and {\tt auto}. The main differences are the following: diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index c659e19e6..0aa179d62 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -3718,12 +3718,14 @@ command to add a hint to some databases \ident$_1$, \dots, \ident$_n$ is The {\hintdef} is one of the following expressions: \begin{itemize} -\item {\tt Resolve \term} +\item {\tt Resolve \term {\zeroone{{\tt |} \zeroone{\num} \zeroone{\pattern}}}} \comindex{Hint Resolve} This command adds {\tt simple apply {\term}} to the hint list with the head symbol of the type of \term. The cost of that hint is - the number of subgoals generated by {\tt simple apply {\term}}. + the number of subgoals generated by {\tt simple apply {\term}} or \num + if specified. The associated pattern is inferred from the conclusion + of the type of \term or the given \pattern if specified. %{\tt auto} actually uses a slightly modified variant of {\tt simple apply} with use_metas_eagerly_in_conv_on_closed_terms set to false In case the inferred type of \term\ does not start with a product diff --git a/intf/vernacexpr.mli b/intf/vernacexpr.mli index 1336c92b6..92e4dd618 100644 --- a/intf/vernacexpr.mli +++ b/intf/vernacexpr.mli @@ -123,8 +123,14 @@ type hint_mode = | ModeNoHeadEvar (* No evar at the head *) | ModeOutput (* Anything *) +type 'a hint_info_gen = + { hint_priority : int option; + hint_pattern : 'a option } + +type hint_info_expr = constr_pattern_expr hint_info_gen + type hints_expr = - | HintsResolve of (int option * bool * reference_or_constr) list + | HintsResolve of (hint_info_expr * bool * reference_or_constr) list | HintsImmediate of reference_or_constr list | HintsUnfold of reference list | HintsTransparency of reference list * bool @@ -368,12 +374,12 @@ type vernac_expr = local_binder list * (* super *) typeclass_constraint * (* instance name, class name, params *) (bool * constr_expr) option * (* props *) - int option (* Priority *) + hint_info_expr | VernacContext of local_binder list | VernacDeclareInstances of - reference list * int option (* instance names, priority *) + (reference * hint_info_expr) list (* instances names, priorities and patterns *) | VernacDeclareClass of reference (* inductive or definition name *) diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index d0318fb5f..063bfbe6d 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -316,7 +316,8 @@ let project_hint pri l2r r = in let ctx = Evd.universe_context_set sigma in let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in - (pri,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c)) + let info = Vernacexpr.({hint_priority = pri; hint_pattern = None}) in + (info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c)) let add_hints_iff l2r lc n bl = Hints.add_hints true bl diff --git a/ltac/rewrite.ml b/ltac/rewrite.ml index 4d7c5d0e4..44efdd383 100644 --- a/ltac/rewrite.ml +++ b/ltac/rewrite.ml @@ -1788,7 +1788,7 @@ let declare_instance a aeq n s = declare_an_instance n s [a;aeq] let anew_instance global binders instance fields = new_instance (Flags.is_universe_polymorphism ()) binders instance (Some (true, CRecord (Loc.ghost,fields))) - ~global ~generalize:false ~refine:false None + ~global ~generalize:false ~refine:false Hints.empty_hint_info let declare_instance_refl global binders a aeq n lemma = let instance = declare_instance a aeq (add_suffix n "_Reflexive") "Coq.Classes.RelationClasses.Reflexive" @@ -1969,7 +1969,7 @@ let add_morphism_infer glob m n = Decl_kinds.IsAssumption Decl_kinds.Logical) in add_instance (Typeclasses.new_instance - (Lazy.force PropGlobal.proper_class) None glob + (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob poly (ConstRef cst)); declare_projection n instance_id (ConstRef cst) else @@ -1980,7 +1980,7 @@ let add_morphism_infer glob m n = let hook _ = function | Globnames.ConstRef cst -> add_instance (Typeclasses.new_instance - (Lazy.force PropGlobal.proper_class) None + (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob poly (ConstRef cst)); declare_projection n instance_id (ConstRef cst) | _ -> assert false @@ -2004,7 +2004,7 @@ let add_morphism glob binders m s n = let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in ignore(new_instance ~global:glob poly binders instance (Some (true, CRecord (Loc.ghost,[]))) - ~generalize:false ~tac ~hook:(declare_projection n instance_id) None) + ~generalize:false ~tac ~hook:(declare_projection n instance_id) Hints.empty_hint_info) (** Bind to "rewrite" too *) diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4 index 1e3c4b880..70c5d5d88 100644 --- a/parsing/g_proofs.ml4 +++ b/parsing/g_proofs.ml4 @@ -103,10 +103,9 @@ GEXTEND Gram (* Declare "Resolve" explicitly so as to be able to later extend with "Resolve ->" and "Resolve <-" *) | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 reference_or_constr; - pri = OPT [ "|"; i = natural -> i ]; - dbnames = opt_hintbases -> + info = hint_info; dbnames = opt_hintbases -> VernacHints (false,dbnames, - HintsResolve (List.map (fun x -> (pri, true, x)) lc)) + HintsResolve (List.map (fun x -> (info, true, x)) lc)) ] ]; obsolete_locality: [ [ IDENT "Local" -> true | -> false ] ] @@ -116,9 +115,8 @@ GEXTEND Gram | c = constr -> HintsConstr c ] ] ; hint: - [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; - pri = OPT [ "|"; i = natural -> i ] -> - HintsResolve (List.map (fun x -> (pri, true, x)) lc) + [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; info = hint_info -> + HintsResolve (List.map (fun x -> (info, true, x)) lc) | IDENT "Immediate"; lc = LIST1 reference_or_constr -> HintsImmediate lc | IDENT "Transparent"; lc = LIST1 global -> HintsTransparency (lc, true) | IDENT "Opaque"; lc = LIST1 global -> HintsTransparency (lc, false) diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index e0d836df8..ffc27d605 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -582,7 +582,7 @@ let warn_deprecated_implicit_arguments = (* Extensions: implicits, coercions, etc. *) GEXTEND Gram - GLOBAL: gallina_ext instance_name; + GLOBAL: gallina_ext instance_name hint_info; gallina_ext: [ [ (* Transparent and Opaque *) @@ -635,17 +635,20 @@ GEXTEND Gram | IDENT "Instance"; namesup = instance_name; ":"; expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200"; - pri = OPT [ "|"; i = natural -> i ] ; + info = hint_info ; props = [ ":="; "{"; r = record_declaration; "}" -> Some (true,r) | ":="; c = lconstr -> Some (false,c) | -> None ] -> - VernacInstance (false,snd namesup,(fst namesup,expl,t),props,pri) + VernacInstance (false,snd namesup,(fst namesup,expl,t),props,info) | IDENT "Existing"; IDENT "Instance"; id = global; - pri = OPT [ "|"; i = natural -> i ] -> - VernacDeclareInstances ([id], pri) + info = hint_info -> + VernacDeclareInstances [id, info] + | IDENT "Existing"; IDENT "Instances"; ids = LIST1 global; - pri = OPT [ "|"; i = natural -> i ] -> - VernacDeclareInstances (ids, pri) + pri = OPT [ "|"; i = natural -> i ] -> + let info = { hint_priority = pri; hint_pattern = None } in + let insts = List.map (fun i -> (i, info)) ids in + VernacDeclareInstances insts | IDENT "Existing"; IDENT "Class"; is = global -> VernacDeclareClass is @@ -786,6 +789,11 @@ GEXTEND Gram (Option.default [] sup) | -> ((!@loc, Anonymous), None), [] ] ] ; + hint_info: + [ [ "|"; i = OPT natural; pat = OPT constr_pattern -> + { hint_priority = i; hint_pattern = pat } + | -> { hint_priority = None; hint_pattern = None } ] ] + ; reserv_list: [ [ bl = LIST1 reserv_tuple -> bl | b = simple_reserv -> [b] ] ] ; @@ -807,8 +815,8 @@ GEXTEND Gram (* Hack! Should be in grammar_ext, but camlp4 factorize badly *) | IDENT "Declare"; IDENT "Instance"; namesup = instance_name; ":"; expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200"; - pri = OPT [ "|"; i = natural -> i ] -> - VernacInstance (true, snd namesup, (fst namesup, expl, t), None, pri) + info = hint_info -> + VernacInstance (true, snd namesup, (fst namesup, expl, t), None, info) (* System directory *) | IDENT "Pwd" -> VernacChdir None diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 9e9a7e723..7dc02190e 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -379,6 +379,7 @@ module Vernac_ = let vernac = gec_vernac "Vernac.vernac" let vernac_eoi = eoi_entry vernac let rec_definition = gec_vernac "Vernac.rec_definition" + let hint_info = gec_vernac "hint_info" (* Main vernac entry *) let main_entry = Gram.entry_create "vernac" let noedit_mode = gec_vernac "noedit_command" diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index 7f6caf63f..ec8dac821 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -213,6 +213,7 @@ module Vernac_ : val vernac_eoi : vernac_expr Gram.entry val noedit_mode : vernac_expr Gram.entry val command_entry : vernac_expr Gram.entry + val hint_info : Vernacexpr.hint_info_expr Gram.entry end (** The main entry: reads an optional vernac command *) diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 31ef3dfdd..b8da6b685 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -65,7 +65,8 @@ type typeclass = { cl_props : Context.Rel.t; (* The method implementaions as projections. *) - cl_projs : (Name.t * (direction * int option) option * constant option) list; + cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option + * constant option) list; cl_strict : bool; @@ -76,10 +77,9 @@ type typeclasses = typeclass Refmap.t type instance = { is_class: global_reference; - is_pri: int option; + is_info: Vernacexpr.hint_info_expr; (* Sections where the instance should be redeclared, - -1 for discard, 0 for none, mutable to avoid redeclarations - when multiple rebuild_object happen. *) + -1 for discard, 0 for none. *) is_global: int; is_poly: bool; is_impl: global_reference; @@ -89,15 +89,15 @@ type instances = (instance Refmap.t) Refmap.t let instance_impl is = is.is_impl -let instance_priority is = is.is_pri +let hint_priority is = is.is_info.Vernacexpr.hint_priority -let new_instance cl pri glob poly impl = +let new_instance cl info glob poly impl = let global = if glob then Lib.sections_depth () else -1 in { is_class = cl.cl_impl; - is_pri = pri ; + is_info = info ; is_global = global ; is_poly = poly; is_impl = impl } @@ -274,7 +274,9 @@ let check_instance env sigma c = not (Evd.has_undefined evd) with e when CErrors.noncritical e -> false -let build_subclasses ~check env sigma glob pri = +open Vernacexpr + +let build_subclasses ~check env sigma glob { hint_priority = pri } = let _id = Nametab.basename_of_global glob in let _next_id = let i = ref (-1) in @@ -297,24 +299,24 @@ let build_subclasses ~check env sigma glob pri = match b with | None -> None | Some (Backward, _) -> None - | Some (Forward, pri') -> + | Some (Forward, info) -> let proj = Option.get proj in let body = it_mkLambda_or_LetIn (mkApp (mkConstU (proj,u), projargs)) rels in if check && check_instance env sigma body then None else - let pri = - match pri, pri' with + let newpri = + match pri, info.hint_priority with | Some p, Some p' -> Some (p + p') | Some p, None -> Some (p + 1) | _, _ -> None in - Some (ConstRef proj, pri, body)) tc.cl_projs + Some (ConstRef proj, { info with hint_priority = newpri }, body)) tc.cl_projs in - let declare_proj hints (cref, pri, body) = + let declare_proj hints (cref, info, body) = let path' = cref :: path in let ty = Retyping.get_type_of env sigma body in let rest = aux pri body ty path' in - hints @ (path', pri, body) :: rest + hints @ (path', info, body) :: rest in List.fold_left declare_proj [] projs in let term = Universes.constr_of_global_univ (glob,Univ.UContext.instance ctx) in @@ -368,11 +370,11 @@ let is_local i = Int.equal i.is_global (-1) let add_instance check inst = let poly = Global.is_polymorphic inst.is_impl in add_instance_hint (IsGlobal inst.is_impl) [inst.is_impl] (is_local inst) - inst.is_pri poly; + inst.is_info poly; List.iter (fun (path, pri, c) -> add_instance_hint (IsConstr c) path (is_local inst) pri poly) (build_subclasses ~check:(check && not (isVarRef inst.is_impl)) - (Global.env ()) (Evd.from_env (Global.env ())) inst.is_impl inst.is_pri) + (Global.env ()) (Evd.from_env (Global.env ())) inst.is_impl inst.is_info) let rebuild_instance (action, inst) = let () = match action with @@ -404,26 +406,22 @@ let remove_instance i = Lib.add_anonymous_leaf (instance_input (RemoveInstance, i)); remove_instance_hint i.is_impl -let declare_instance pri local glob = +let declare_instance info local glob = let ty = Global.type_of_global_unsafe glob in + let info = Option.default {hint_priority = None; hint_pattern = None} info in match class_of_constr ty with | Some (rels, ((tc,_), args) as _cl) -> - add_instance (new_instance tc pri (not local) (Flags.use_polymorphic_flag ()) glob) -(* let path, hints = build_subclasses (not local) (Global.env ()) Evd.empty glob in *) -(* let entries = List.map (fun (path, pri, c) -> (pri, local, path, c)) hints in *) -(* Auto.add_hints local [typeclasses_db] (Auto.HintsResolveEntry entries); *) -(* Auto.add_hints local [typeclasses_db] *) -(* (Auto.HintsCutEntry (PathSeq (PathStar (PathAtom PathAny), path))) *) + add_instance (new_instance tc info (not local) (Flags.use_polymorphic_flag ()) glob) | None -> () let add_class cl = add_class cl; List.iter (fun (n, inst, body) -> match inst with - | Some (Backward, pri) -> + | Some (Backward, info) -> (match body with | None -> CErrors.error "Non-definable projection can not be declared as a subinstance" - | Some b -> declare_instance pri false (ConstRef b)) + | Some b -> declare_instance (Some info) false (ConstRef b)) | _ -> ()) cl.cl_projs diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 2530f5dfa..620bc367b 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -32,7 +32,7 @@ type typeclass = { Some may be undefinable due to sorting restrictions or simply undefined if no name is provided. The [int option option] indicates subclasses whose hint has the given priority. *) - cl_projs : (Name.t * (direction * int option) option * constant option) list; + cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option * constant option) list; (** Whether we use matching or full unification during resolution *) cl_strict : bool; @@ -50,7 +50,7 @@ val all_instances : unit -> instance list val add_class : typeclass -> unit -val new_instance : typeclass -> int option -> bool -> Decl_kinds.polymorphic -> +val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic -> global_reference -> instance val add_instance : instance -> unit val remove_instance : instance -> unit @@ -71,7 +71,7 @@ val class_of_constr : constr -> (Context.Rel.t * (typeclass puniverses * constr val instance_impl : instance -> global_reference -val instance_priority : instance -> int option +val hint_priority : instance -> int option val is_class : global_reference -> bool val is_instance : global_reference -> bool @@ -113,21 +113,22 @@ val classes_transparent_state : unit -> transparent_state val add_instance_hint_hook : (global_reference_or_constr -> global_reference list -> - bool (* local? *) -> int option -> Decl_kinds.polymorphic -> unit) Hook.t + bool (* local? *) -> Vernacexpr.hint_info_expr -> Decl_kinds.polymorphic -> unit) Hook.t val remove_instance_hint_hook : (global_reference -> unit) Hook.t val add_instance_hint : global_reference_or_constr -> global_reference list -> - bool -> int option -> Decl_kinds.polymorphic -> unit + bool -> Vernacexpr.hint_info_expr -> Decl_kinds.polymorphic -> unit val remove_instance_hint : global_reference -> unit val solve_all_instances_hook : (env -> evar_map -> evar_filter -> bool -> bool -> bool -> evar_map) Hook.t val solve_one_instance_hook : (env -> evar_map -> types -> bool -> open_constr) Hook.t -val declare_instance : int option -> bool -> global_reference -> unit +val declare_instance : Vernacexpr.hint_info_expr option -> bool -> global_reference -> unit (** Build the subinstances hints for a given typeclass object. check tells if we should check for existence of the subinstances and add only the missing ones. *) -val build_subclasses : check:bool -> env -> evar_map -> global_reference -> int option (* priority *) -> - (global_reference list * int option * constr) list +val build_subclasses : check:bool -> env -> evar_map -> global_reference -> + Vernacexpr.hint_info_expr -> + (global_reference list * Vernacexpr.hint_info_expr * constr) list diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index 5455ab891..3494ad006 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -166,14 +166,17 @@ module Make | ModeNoHeadEvar -> str"!" | ModeOutput -> str"-" + let pr_hint_info pr_pat { hint_priority = pri; hint_pattern = pat } = + pr_opt (fun x -> str"|" ++ int x) pri ++ + pr_opt (fun y -> (if Option.is_empty pri then str"| " else mt()) ++ pr_pat y) pat + let pr_hints db h pr_c pr_pat = let opth = pr_opt_hintbases db in let pph = match h with | HintsResolve l -> keyword "Resolve " ++ prlist_with_sep sep - (fun (pri, _, c) -> pr_reference_or_constr pr_c c ++ - match pri with Some x -> spc () ++ str"(" ++ int x ++ str")" | None -> mt ()) + (fun (info, _, c) -> pr_reference_or_constr pr_c c ++ pr_hint_info pr_pat info) l | HintsImmediate l -> keyword "Immediate" ++ spc() ++ @@ -888,7 +891,7 @@ module Make spc() ++ pr_class_rawexpr c2) ) - | VernacInstance (abst, sup, (instid, bk, cl), props, pri) -> + | VernacInstance (abst, sup, (instid, bk, cl), props, info) -> return ( hov 1 ( (if abst then keyword "Declare" ++ spc () else mt ()) ++ @@ -899,7 +902,7 @@ module Make pr_and_type_binders_arg sup ++ str":" ++ spc () ++ (match bk with Implicit -> str "! " | Explicit -> mt ()) ++ - pr_constr cl ++ pr_priority pri ++ + pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info ++ (match props with | Some (true,CRecord (_,l)) -> spc () ++ str":=" ++ spc () ++ str"{" ++ pr_record_body l ++ str "}" | Some (true,_) -> assert false @@ -913,11 +916,14 @@ module Make keyword "Context" ++ spc () ++ pr_and_type_binders_arg l) ) - | VernacDeclareInstances (ids, pri) -> - return ( + | VernacDeclareInstances insts -> + let pr_inst (id, info) = + pr_reference id ++ pr_hint_info pr_constr_pattern_expr info + in + return ( hov 1 (keyword "Existing" ++ spc () ++ - keyword(String.plural (List.length ids) "Instance") ++ - spc () ++ prlist_with_sep spc pr_reference ids ++ pr_priority pri) + keyword(String.plural (List.length insts) "Instance") ++ + spc () ++ prlist_with_sep (fun () -> str", ") pr_inst insts) ) | VernacDeclareClass id -> diff --git a/printing/prettyp.ml b/printing/prettyp.ml index b590a8c93..e117f1dcb 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -872,7 +872,7 @@ let pr_instance env i = (* gallina_print_constant_with_infos i.is_impl *) (* lighter *) print_ref false (instance_impl i) ++ - begin match instance_priority i with + begin match hint_priority i with | None -> mt () | Some i -> spc () ++ str "|" ++ spc () ++ int i end diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 9cb6b7fe7..da91674f5 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -539,10 +539,16 @@ let make_resolve_hyp env sigma st flags only_classes pri decl = let name = PathHints [VarRef id] in let hints = if is_class then - let hints = build_subclasses ~check:false env sigma (VarRef id) None in + let hints = build_subclasses ~check:false env sigma (VarRef id) empty_hint_info in (List.map_append - (fun (path,pri, c) -> make_resolves env sigma ~name:(PathHints path) - (true,false,Flags.is_verbose()) pri false + (fun (path,info,c) -> + let info = + { info with Vernacexpr.hint_pattern = + Option.map (Constrintern.intern_constr_pattern env) + info.Vernacexpr.hint_pattern } + in + make_resolves env sigma ~name:(PathHints path) + (true,false,Flags.is_verbose()) info false (IsConstr (c,Univ.ContextSet.empty))) hints) else [] @@ -567,7 +573,7 @@ let make_hints g st only_classes sign = in if consider then let hint = - pf_apply make_resolve_hyp g st (true,false,false) only_classes None hyp + pf_apply make_resolve_hyp g st (true,false,false) only_classes empty_hint_info hyp in hint @ hints else hints) ([]) sign @@ -636,7 +642,7 @@ module V85 = struct let env = Goal.V82.env s g' in let context = Environ.named_context_of_val (Goal.V82.hyps s g') in let hint = make_resolve_hyp env s (Hint_db.transparent_state info.hints) - (true,false,false) info.only_classes None (List.hd context) in + (true,false,false) info.only_classes empty_hint_info (List.hd context) in let ldb = Hint_db.add_list env s hint info.hints in (g', { info with is_evar = None; hints = ldb; auto_last_tac = lazy (str"intro") })) gls @@ -1140,7 +1146,7 @@ module Search = struct let decl = Tacmach.New.pf_last_hyp gl in let hint = make_resolve_hyp env s (Hint_db.transparent_state info.search_hints) - (true,false,false) info.search_only_classes None decl in + (true,false,false) info.search_only_classes empty_hint_info decl in let ldb = Hint_db.add_list env s hint info.search_hints in let info' = { info with search_hints = ldb; last_tac = lazy (str"intro") } diff --git a/tactics/hints.ml b/tactics/hints.ml index 823af0b0a..9cbfe20d9 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -84,6 +84,8 @@ let secvars_of_hyps hyps = if all then Id.Pred.full (* If the whole section context is available *) else pred +let empty_hint_info = Vernacexpr.{ hint_priority = None; hint_pattern = None } + (************************************************************************) (* The Type of Constructions Autotactic Hints *) (************************************************************************) @@ -736,7 +738,7 @@ let secvars_of_constr env c = let secvars_of_global env gr = secvars_of_idset (vars_of_global_reference env gr) -let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) = +let make_exact_entry env sigma info poly ?(name=PathAny) (c, cty, ctx) = let secvars = secvars_of_constr env c in let cty = strip_outer_cast cty in match kind_of_term cty with @@ -747,16 +749,17 @@ let make_exact_entry env sigma pri poly ?(name=PathAny) (c, cty, ctx) = try head_pattern_bound pat with BoundPattern -> failwith "make_exact_entry" in - (Some hd, - { pri = (match pri with None -> 0 | Some p -> p); - poly = poly; - pat = Some pat; - name = name; - db = None; - secvars; - code = with_uid (Give_exact (c, cty, ctx)); }) + let pri = match info.hint_priority with None -> 0 | Some p -> p in + let pat = match info.hint_pattern with + | Some pat -> snd pat + | None -> pat + in + (Some hd, + { pri; poly; pat = Some pat; name; + db = None; secvars; + code = with_uid (Give_exact (c, cty, ctx)); }) -let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c, cty, ctx) = +let make_apply_entry env sigma (eapply,hnf,verbose) info poly ?(name=PathAny) (c, cty, ctx) = let cty = if hnf then hnf_constr env sigma cty else cty in match kind_of_term cty with | Prod _ -> @@ -769,12 +772,13 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c, with BoundPattern -> failwith "make_apply_entry" in let nmiss = List.length (clenv_missing ce) in let secvars = secvars_of_constr env c in + let pri = match info.hint_priority with None -> nb_hyp cty + nmiss | Some p -> p in + let pat = match info.hint_pattern with + | Some p -> snd p | None -> pat + in if Int.equal nmiss 0 then (Some hd, - { pri = (match pri with None -> nb_hyp cty | Some p -> p); - poly = poly; - pat = Some pat; - name = name; + { pri; poly; pat = Some pat; name; db = None; secvars; code = with_uid (Res_pf(c,cty,ctx)); }) @@ -784,12 +788,8 @@ let make_apply_entry env sigma (eapply,hnf,verbose) pri poly ?(name=PathAny) (c, Feedback.msg_info (str "the hint: eapply " ++ pr_lconstr c ++ str " will only be used by eauto"); (Some hd, - { pri = (match pri with None -> nb_hyp cty + nmiss | Some p -> p); - poly = poly; - pat = Some pat; - name = name; - db = None; - secvars; + { pri; poly; pat = Some pat; name; + db = None; secvars; code = with_uid (ERes_pf(c,cty,ctx)); }) end | _ -> failwith "make_apply_entry" @@ -840,14 +840,14 @@ let fresh_global_or_constr env sigma poly cr = (c, Univ.ContextSet.empty) end -let make_resolves env sigma flags pri poly ?name cr = +let make_resolves env sigma flags info poly ?name cr = let c, ctx = fresh_global_or_constr env sigma poly cr in let cty = Retyping.get_type_of env sigma c in let try_apply f = try Some (f (c, cty, ctx)) with Failure _ -> None in let ents = List.map_filter try_apply - [make_exact_entry env sigma pri poly ?name; - make_apply_entry env sigma flags pri poly ?name] + [make_exact_entry env sigma info poly ?name; + make_apply_entry env sigma flags info poly ?name] in if List.is_empty ents then errorlabstrm "Hint" @@ -861,7 +861,7 @@ let make_resolve_hyp env sigma decl = let hname = get_id decl in let c = mkVar hname in try - [make_apply_entry env sigma (true, true, false) None false + [make_apply_entry env sigma (true, true, false) empty_hint_info false ~name:(PathHints [VarRef hname]) (c, get_type decl, Univ.ContextSet.empty)] with @@ -1145,16 +1145,17 @@ let add_transparency l b local dbnames = Lib.add_anonymous_leaf (inAutoHint hint)) dbnames -let add_extern pri pat tacast local dbname = - let pat = match pat with +let add_extern info tacast local dbname = + let pat = match info.hint_pattern with | None -> None | Some (_, pat) -> Some pat in - let hint = make_hint ~local dbname (AddHints [make_extern pri pat tacast]) in + let hint = make_hint ~local dbname + (AddHints [make_extern (Option.get info.hint_priority) pat tacast]) in Lib.add_anonymous_leaf (inAutoHint hint) -let add_externs pri pat tacast local dbnames = - List.iter (add_extern pri pat tacast local) dbnames +let add_externs info tacast local dbnames = + List.iter (add_extern info tacast local) dbnames let add_trivials env sigma l local dbnames = List.iter @@ -1168,15 +1169,16 @@ let (forward_intern_tac, extern_intern_tac) = Hook.make () type hnf = bool +type hint_info = (patvar list * constr_pattern) hint_info_gen + type hints_entry = - | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * hint_term) list + | HintsResolveEntry of (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list | HintsCutEntry of hints_path | HintsUnfoldEntry of evaluable_global_reference list | HintsTransparencyEntry of evaluable_global_reference list * bool | HintsModeEntry of global_reference * hint_mode list - | HintsExternEntry of - int * (patvar list * constr_pattern) option * glob_tactic_expr + | HintsExternEntry of hint_info * glob_tactic_expr let default_prepare_hint_ident = Id.of_string "H" @@ -1240,11 +1242,12 @@ let interp_hints poly = (PathHints [gr], poly, IsGlobRef gr) | HintsConstr c -> (PathAny, poly, f poly c) in - let fres (pri, b, r) = + let fp = Constrintern.intern_constr_pattern (Global.env()) in + let fres (info, b, r) = let path, poly, gr = fi r in - (pri, poly, b, path, gr) + let info = { info with hint_pattern = Option.map fp info.hint_pattern } in + (info, poly, b, path, gr) in - let fp = Constrintern.intern_constr_pattern (Global.env()) in match h with | HintsResolve lhints -> HintsResolveEntry (List.map fres lhints) | HintsImmediate lhints -> HintsImmediateEntry (List.map fi lhints) @@ -1260,14 +1263,14 @@ let interp_hints poly = List.init (nconstructors ind) (fun i -> let c = (ind,i+1) in let gr = ConstructRef c in - None, mib.Declarations.mind_polymorphic, true, + empty_hint_info, mib.Declarations.mind_polymorphic, true, PathHints [gr], IsGlobRef gr) in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid)) | HintsExtern (pri, patcom, tacexp) -> let pat = Option.map fp patcom in let l = match pat with None -> [] | Some (l, _) -> l in let tacexp = Hook.get forward_intern_tac l tacexp in - HintsExternEntry (pri, pat, tacexp) + HintsExternEntry ({ hint_priority = Some pri; hint_pattern = pat }, tacexp) let add_hints local dbnames0 h = if String.List.mem "nocore" dbnames0 then @@ -1283,8 +1286,8 @@ let add_hints local dbnames0 h = | HintsUnfoldEntry lhints -> add_unfolds lhints local dbnames | HintsTransparencyEntry (lhints, b) -> add_transparency lhints b local dbnames - | HintsExternEntry (pri, pat, tacexp) -> - add_externs pri pat tacexp local dbnames + | HintsExternEntry (info, tacexp) -> + add_externs info tacexp local dbnames let expand_constructor_hints env sigma lems = List.map_append (fun (evd,lem) -> @@ -1308,7 +1311,7 @@ let add_hint_lemmas env sigma eapply lems hint_db = let lems = expand_constructor_hints env sigma lems in let hintlist' = List.map_append (fun (poly, lem) -> - make_resolves env sigma (eapply,true,false) None poly lem) lems in + make_resolves env sigma (eapply,true,false) empty_hint_info poly lem) lems in Hint_db.add_list env sigma hintlist' hint_db let make_local_hint_db env sigma ts eapply lems = @@ -1362,7 +1365,9 @@ let pr_hint h = match h.obj with (str "(*external*) " ++ Pptactic.pr_glb_generic env tac) let pr_id_hint (id, v) = - (pr_hint v.code ++ str"(level " ++ int v.pri ++ str", id " ++ int id ++ str ")" ++ spc ()) + let pr_pat p = str", pattern " ++ pr_lconstr_pattern p in + (pr_hint v.code ++ str"(level " ++ int v.pri ++ pr_opt_no_spc pr_pat v.pat + ++ str", id " ++ int id ++ str ")" ++ spc ()) let pr_hint_list hintlist = (str " " ++ hov 0 (prlist pr_id_hint hintlist) ++ fnl ()) diff --git a/tactics/hints.mli b/tactics/hints.mli index 8145ae193..42a2896ed 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -27,6 +27,8 @@ val decompose_app_bound : constr -> global_reference * constr array val secvars_of_hyps : Context.Named.t -> Id.Pred.t +val empty_hint_info : 'a hint_info_gen + (** Pre-created hint databases *) type 'a hint_ast = @@ -129,20 +131,21 @@ type hint_db = Hint_db.t type hnf = bool +type hint_info = (patvar list * constr_pattern) hint_info_gen + type hint_term = | IsGlobRef of global_reference | IsConstr of constr * Univ.universe_context_set type hints_entry = - | HintsResolveEntry of (int option * polymorphic * hnf * hints_path_atom * - hint_term) list + | HintsResolveEntry of + (hint_info * polymorphic * hnf * hints_path_atom * hint_term) list | HintsImmediateEntry of (hints_path_atom * polymorphic * hint_term) list | HintsCutEntry of hints_path | HintsUnfoldEntry of evaluable_global_reference list | HintsTransparencyEntry of evaluable_global_reference list * bool | HintsModeEntry of global_reference * hint_mode list - | HintsExternEntry of - int * (patvar list * constr_pattern) option * Tacexpr.glob_tactic_expr + | HintsExternEntry of hint_info * Tacexpr.glob_tactic_expr val searchtable_map : hint_db_name -> hint_db @@ -169,23 +172,34 @@ val prepare_hint : bool (* Check no remaining evars *) -> (bool * bool) (* polymorphic or monomorphic, local or global *) -> env -> evar_map -> open_constr -> hint_term -(** [make_exact_entry pri (c, ctyp, ctx, secvars)]. +(** [make_exact_entry info (c, ctyp, ctx)]. [c] is the term given as an exact proof to solve the goal; [ctyp] is the type of [c]. - [ctx] is its (refreshable) universe context. *) -val make_exact_entry : env -> evar_map -> int option -> polymorphic -> ?name:hints_path_atom -> + [ctx] is its (refreshable) universe context. + In info: + [hint_priority] is the hint's desired priority, it is 0 if unspecified + [hint_pattern] is the hint's desired pattern, it is inferred if not specified +*) + +val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hints_path_atom -> (constr * types * Univ.universe_context_set) -> hint_entry -(** [make_apply_entry (eapply,hnf,verbose) pri (c,cty,ctx,secvars)]. +(** [make_apply_entry (eapply,hnf,verbose) info (c,cty,ctx))]. [eapply] is true if this hint will be used only with EApply; [hnf] should be true if we should expand the head of cty before searching for products; [c] is the term given as an exact proof to solve the goal; [cty] is the type of [c]. - [ctx] is its (refreshable) universe context. *) + [ctx] is its (refreshable) universe context. + In info: + [hint_priority] is the hint's desired priority, it is computed as the number of products in [cty] + if unspecified + [hint_pattern] is the hint's desired pattern, it is inferred from the conclusion of [cty] + if not specified +*) val make_apply_entry : - env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> + env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom -> (constr * types * Univ.universe_context_set) -> hint_entry (** A constr which is Hint'ed will be: @@ -196,7 +210,7 @@ val make_apply_entry : has missing arguments. *) val make_resolves : - env -> evar_map -> bool * bool * bool -> int option -> polymorphic -> ?name:hints_path_atom -> + env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom -> hint_term -> hint_entry list (** [make_resolve_hyp hname htyp]. diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v index 89b8bd7ac..91edc06bf 100644 --- a/test-suite/success/Hints.v +++ b/test-suite/success/Hints.v @@ -8,6 +8,10 @@ Hint Unfold eq_sym: core. Hint Constructors eq: foo bar. Hint Extern 3 (_ = _) => apply eq_refl: foo bar. +Hint Resolve eq_refl | 4 (_ = _) : baz. +Hint Resolve eq_sym eq_trans : baz. +Hint Extern 3 (_ = _) => apply eq_sym : baz. + (* Old-style syntax *) Hint Resolve eq_refl eq_sym. Hint Resolve eq_refl eq_sym: foo. @@ -105,4 +109,4 @@ Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e) Timeout 1 Fail apply _. (* 0.06s *) Abort. -End HintCut. \ No newline at end of file +End HintCut. diff --git a/toplevel/classes.ml b/toplevel/classes.ml index d6a6162f9..1f13ab637 100644 --- a/toplevel/classes.ml +++ b/toplevel/classes.ml @@ -46,25 +46,32 @@ let set_typeclass_transparency c local b = let _ = Hook.set Typeclasses.add_instance_hint_hook - (fun inst path local pri poly -> + (fun inst path local info poly -> let inst' = match inst with IsConstr c -> Hints.IsConstr (c, Univ.ContextSet.empty) | IsGlobal gr -> Hints.IsGlobRef gr in - Flags.silently (fun () -> + let info = + Vernacexpr.{ info with hint_pattern = + Option.map + (Constrintern.intern_constr_pattern (Global.env())) info.hint_pattern } in + Flags.silently (fun () -> Hints.add_hints local [typeclasses_db] (Hints.HintsResolveEntry - [pri, poly, false, Hints.PathHints path, inst'])) ()); + [info, poly, false, Hints.PathHints path, inst'])) ()); Hook.set Typeclasses.set_typeclass_transparency_hook set_typeclass_transparency; Hook.set Typeclasses.classes_transparent_state_hook (fun () -> Hints.Hint_db.transparent_state (Hints.searchtable_map typeclasses_db)) - + +open Vernacexpr + (** TODO: add subinstances *) -let existing_instance glob g pri = +let existing_instance glob g info = let c = global g in + let info = Option.default Hints.empty_hint_info info in let instance = Global.type_of_global_unsafe c in let _, r = decompose_prod_assum instance in match class_of_constr r with - | Some (_, ((tc,u), _)) -> add_instance (new_instance tc pri glob + | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob (*FIXME*) (Flags.use_polymorphic_flag ()) c) | None -> user_err_loc (loc_of_reference g, "declare_instance", Pp.str "Constant does not build instances of a declared type class.") @@ -98,12 +105,12 @@ let id_of_class cl = open Pp -let instance_hook k pri global imps ?hook cst = +let instance_hook k info global imps ?hook cst = Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps; - Typeclasses.declare_instance pri (not global) cst; + Typeclasses.declare_instance (Some info) (not global) cst; (match hook with Some h -> h cst | None -> ()) -let declare_instance_constant k pri global imps ?hook id pl poly evm term termtype = +let declare_instance_constant k info global imps ?hook id pl poly evm term termtype = let kind = IsDefinition Instance in let evm = let levels = Univ.LSet.union (Universes.universes_of_constr termtype) @@ -118,7 +125,7 @@ let declare_instance_constant k pri global imps ?hook id pl poly evm term termty let kn = Declare.declare_constant id cdecl in Declare.definition_message id; Universes.register_universe_binders (ConstRef kn) pl; - instance_hook k pri global imps ?hook (ConstRef kn); + instance_hook k info global imps ?hook (ConstRef kn); id let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) poly ctx (instid, bk, cl) props @@ -130,7 +137,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p let evars = ref (Evd.from_ctx uctx) in let tclass, ids = match bk with - | Implicit -> + | Decl_kinds.Implicit -> Implicit_quantifiers.implicit_application Id.Set.empty ~allow_partial:false (fun avoid (clname, _) -> match clname with @@ -299,7 +306,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p let hook vis gr _ = let cst = match gr with ConstRef kn -> kn | _ -> assert false in Impargs.declare_manual_implicits false gr ~enriching:false [imps]; - Typeclasses.declare_instance pri (not global) (ConstRef cst) + Typeclasses.declare_instance (Some pri) (not global) (ConstRef cst) in let obls, constr, typ = match term with @@ -378,7 +385,7 @@ let context poly l = let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id decl in match class_of_constr t with | Some (rels, ((tc,_), args) as _cl) -> - add_instance (Typeclasses.new_instance tc None false (*FIXME*) + add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (*FIXME*) poly (ConstRef cst)); status (* declare_subclasses (ConstRef cst) cl *) diff --git a/toplevel/classes.mli b/toplevel/classes.mli index 7beb873e6..d2cb788ea 100644 --- a/toplevel/classes.mli +++ b/toplevel/classes.mli @@ -20,12 +20,12 @@ val mismatched_props : env -> constr_expr list -> Context.Rel.t -> 'a (** Instance declaration *) -val existing_instance : bool -> reference -> int option -> unit -(** globality, reference, priority *) +val existing_instance : bool -> reference -> Vernacexpr.hint_info_expr option -> unit +(** globality, reference, optional priority and pattern information *) val declare_instance_constant : typeclass -> - int option -> (** priority *) + Vernacexpr.hint_info_expr -> (** priority *) bool -> (** globality *) Impargs.manual_explicitation list -> (** implicits *) ?hook:(Globnames.global_reference -> unit) -> @@ -48,7 +48,7 @@ val new_instance : ?generalize:bool -> ?tac:unit Proofview.tactic -> ?hook:(Globnames.global_reference -> unit) -> - int option -> + Vernacexpr.hint_info_expr -> Id.t (** Setting opacity *) diff --git a/toplevel/record.ml b/toplevel/record.ml index 9c4d41ea5..63564fba1 100644 --- a/toplevel/record.ml +++ b/toplevel/record.ml @@ -565,8 +565,9 @@ let definition_structure (kind,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cfs,id typecheck_params_and_fields (kind = Class true) idstruc pl s ps notations fs) () in let sign = structure_signature (fields@params) in let gr = match kind with - | Class def -> - let gr = declare_class finite def poly ctx (loc,idstruc) idbuild + | Class def -> + let priorities = List.map (fun id -> {hint_priority = id; hint_pattern = None}) priorities in + let gr = declare_class finite def poly ctx (loc,idstruc) idbuild implpars params arity template implfs fields is_coe coers priorities sign in gr | _ -> diff --git a/toplevel/record.mli b/toplevel/record.mli index b09425563..c50e57786 100644 --- a/toplevel/record.mli +++ b/toplevel/record.mli @@ -38,7 +38,8 @@ val declare_structure : inductive val definition_structure : - inductive_kind * Decl_kinds.polymorphic * Decl_kinds.recursivity_kind * plident with_coercion * local_binder list * + inductive_kind * Decl_kinds.polymorphic * Decl_kinds.recursivity_kind * + plident with_coercion * local_binder list * (local_decl_expr with_instance with_priority with_notation) list * Id.t * constr_expr option -> global_reference diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 4de1d9595..973f73ef6 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -841,9 +841,9 @@ let vernac_instance abst locality poly sup inst props pri = let vernac_context poly l = if not (Classes.context poly l) then Feedback.feedback Feedback.AddedAxiom -let vernac_declare_instances locality ids pri = +let vernac_declare_instances locality insts = let glob = not (make_section_locality locality) in - List.iter (fun id -> Classes.existing_instance glob id pri) ids + List.iter (fun (id, info) -> Classes.existing_instance glob id (Some info)) insts let vernac_declare_class id = Record.declare_existing_class (Nametab.global id) @@ -1989,10 +1989,10 @@ let interp ?proof ~loc locality poly c = vernac_identity_coercion locality poly local id s t (* Type classes *) - | VernacInstance (abst, sup, inst, props, pri) -> - vernac_instance abst locality poly sup inst props pri + | VernacInstance (abst, sup, inst, props, info) -> + vernac_instance abst locality poly sup inst props info | VernacContext sup -> vernac_context poly sup - | VernacDeclareInstances (ids, pri) -> vernac_declare_instances locality ids pri + | VernacDeclareInstances insts -> vernac_declare_instances locality insts | VernacDeclareClass id -> vernac_declare_class id (* Solving *) -- cgit v1.2.3 From b57c7005d81b35b2ae6c45e6ac3088a73b3c43b2 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 18:31:03 +0200 Subject: Fix Typeclasses eauto := bfs. --- ltac/g_class.ml4 | 13 ++++++++++++- tactics/class_tactics.ml | 6 ++++++ tactics/class_tactics.mli | 4 ++++ 3 files changed, 22 insertions(+), 1 deletion(-) diff --git a/ltac/g_class.ml4 b/ltac/g_class.ml4 index 18df596eb..1adf197d6 100644 --- a/ltac/g_class.ml4 +++ b/ltac/g_class.ml4 @@ -44,11 +44,22 @@ ARGUMENT EXTEND debug TYPED AS bool PRINTED BY pr_debug | [ ] -> [ false ] END +let pr_search_strategy _prc _prlc _prt = function + | Dfs -> Pp.str "dfs" + | Bfs -> Pp.str "bfs" + +ARGUMENT EXTEND eauto_search_strategy PRINTED BY pr_search_strategy +| [ "bfs" ] -> [ Bfs ] +| [ "dfs" ] -> [ Dfs ] +| [ ] -> [ Dfs ] +END + (* true = All transparent, false = Opaque if possible *) VERNAC COMMAND EXTEND Typeclasses_Settings CLASSIFIED AS SIDEFF - | [ "Typeclasses" "eauto" ":=" debug(d) int_opt(depth) ] -> [ + | [ "Typeclasses" "eauto" ":=" debug(d) eauto_search_strategy(s) int_opt(depth) ] -> [ set_typeclasses_debug d; + set_typeclasses_strategy s; set_typeclasses_depth depth ] END diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index da91674f5..c1ba645be 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -181,6 +181,12 @@ let set_typeclasses_depth = optread = get_typeclasses_depth; optwrite = set_typeclasses_depth; } +type search_strategy = Dfs | Bfs + +let set_typeclasses_strategy = function + | Dfs -> set_typeclasses_iterative_deepening true + | Bfs -> set_typeclasses_iterative_deepening false + let pr_ev evs ev = Printer.pr_constr_env (Goal.V82.env evs ev) evs (Evarutil.nf_evar evs (Goal.V82.concl evs ev)) diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli index 8db264ad9..565415a95 100644 --- a/tactics/class_tactics.mli +++ b/tactics/class_tactics.mli @@ -20,6 +20,10 @@ val get_typeclasses_debug : unit -> bool val set_typeclasses_depth : int option -> unit val get_typeclasses_depth : unit -> int option +type search_strategy = Dfs | Bfs + +val set_typeclasses_strategy : search_strategy -> unit + val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> depth:(Int.t option) -> Hints.hint_db_name list -> unit Proofview.tactic -- cgit v1.2.3 From ced1e16d43bd896b7e8473921a29749a0ba35643 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 18:31:46 +0200 Subject: Fix bugs in Filtered Unification and cleanup code --- tactics/class_tactics.ml | 58 ++++++++++++++++++++++++++++++------------------ 1 file changed, 36 insertions(+), 22 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index c1ba645be..264df5215 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -246,12 +246,11 @@ let unify_resolve poly flags = { enter = begin fun gls (c,_,clenv) -> end } (** Application of a lemma using [refine] instead of the old [w_unify] *) -let unify_resolve_refine poly flags = +let unify_resolve_refine poly flags gls ((c, t, ctx),n,clenv) = let open Clenv in - { enter = begin fun gls ((c, t, ctx),n,clenv) -> - let env = Proofview.Goal.env gls in - let concl = Proofview.Goal.concl gls in - Refine.refine ~unsafe:true { Sigma.run = fun sigma -> + let env = Proofview.Goal.env gls in + let concl = Proofview.Goal.concl gls in + Refine.refine ~unsafe:true { Sigma.run = fun sigma -> let sigma = Sigma.to_evar_map sigma in let sigma, term, ty = if poly then @@ -266,15 +265,20 @@ let unify_resolve_refine poly flags = let sigma', cl = Clenv.make_evar_clause env sigma ?len:n ty in let term = applistc term (List.map (fun x -> x.hole_evar) cl.cl_holes) in let sigma' = - let evdref = ref sigma' in - if not (Evarconv.e_cumul env ~ts:flags.core_unify_flags.modulo_delta - evdref cl.cl_concl concl) then - Type_errors.error_actual_type env - {Environ.uj_val = term; Environ.uj_type = cl.cl_concl} - concl; - !evdref + Evarconv.the_conv_x_leq env ~ts:flags.core_unify_flags.modulo_delta + cl.cl_concl concl sigma' in Sigma.here term (Sigma.Unsafe.of_evar_map sigma') } - end } + +let unify_resolve_refine poly flags gl clenv = + Proofview.tclORELSE + (unify_resolve_refine poly flags gl clenv) + (fun ie -> + match fst ie with + | Evarconv.UnableToUnify _ -> + Tacticals.New.tclZEROMSG (str "Unable to unify") + | e when CErrors.noncritical e -> + Tacticals.New.tclZEROMSG (str "Unexpected error") + | _ -> iraise ie) (** Dealing with goals of the form A -> B and hints of the form C -> A -> B. @@ -295,9 +299,11 @@ let clenv_of_prods poly nprods (c, clenv) gl = let with_prods nprods poly (c, clenv) f = if get_typeclasses_limit_intros () then Proofview.Goal.nf_enter { enter = begin fun gl -> - match clenv_of_prods poly nprods (c, clenv) gl with - | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses") - | Some (diff, clenv') -> f.enter gl (c, diff, clenv') end } + try match clenv_of_prods poly nprods (c, clenv) gl with + | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses") + | Some (diff, clenv') -> f.enter gl (c, diff, clenv') + with e when CErrors.noncritical e -> + Tacticals.New.tclFAIL 0 (CErrors.print e) end } else Proofview.Goal.nf_enter { enter = begin fun gl -> if Int.equal nprods 0 then f.enter gl (c, None, clenv) @@ -312,7 +318,7 @@ let matches_pattern concl pat = if Constr_matching.is_matching env sigma pat concl then Proofview.tclUNIT () else - Tacticals.New.tclZEROMSG (str "conclPattern") + Tacticals.New.tclZEROMSG (str "pattern does not match") in Proofview.Goal.enter { enter = fun gl -> let env = Proofview.Goal.env gl in @@ -405,8 +411,8 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co let tac = with_prods nprods poly (term,cl) ({ enter = fun gl clenv -> - (matches_pattern concl p) <*> - ((unify_resolve_refine poly flags).enter gl clenv)}) + matches_pattern concl p <*> + unify_resolve_refine poly flags gl clenv}) in Tacticals.New.tclTHEN tac Proofview.shelve_unifiable else let tac = @@ -420,8 +426,8 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co if get_typeclasses_filtered_unification () then let tac = (with_prods nprods poly (term,cl) ({ enter = fun gl clenv -> - (matches_pattern concl p) <*> - ((unify_resolve_refine poly flags).enter gl clenv)})) in + matches_pattern concl p <*> + unify_resolve_refine poly flags gl clenv})) in Tacticals.New.tclTHEN tac Proofview.shelve_unifiable else let tac = @@ -431,7 +437,15 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co else Proofview.tclBIND (Proofview.with_shelf tac) (fun (gls, ()) -> shelve_dependencies gls) - | Give_exact c -> Proofview.V82.tactic (e_give_exact flags poly c) + | Give_exact (c,clenv) -> + if get_typeclasses_filtered_unification () then + let tac = + matches_pattern concl p <*> + Proofview.Goal.nf_enter + { enter = fun gl -> unify_resolve_refine poly flags gl (c,None,clenv) } in + Tacticals.New.tclTHEN tac Proofview.shelve_unifiable + else + Proofview.V82.tactic (e_give_exact flags poly (c,clenv)) | Res_pf_THEN_trivial_fail (term,cl) -> let fst = with_prods nprods poly (term,cl) (unify_e_resolve poly flags) in let snd = if complete then Tacticals.New.tclIDTAC -- cgit v1.2.3 From 59b4938c3a763e0ed35dd8f91f5d45b286df01a6 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 18:32:31 +0200 Subject: TCS: error handling and debug printing in resolution --- tactics/class_tactics.ml | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 264df5215..8ec005a60 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1044,13 +1044,18 @@ module Search = struct let foundone = ref false in let rec onetac e (tac, pat, b, name, pp) tl = let derivs = path_derivate info.search_cut name in - (if !typeclasses_debug > 1 then - Feedback.msg_debug - (pr_depth (!idx :: info.search_depth) ++ str": trying " ++ + let pr_error ie = + if !typeclasses_debug > 1 then + let msg = + pr_depth (!idx :: info.search_depth) ++ str": " ++ Lazy.force pp ++ (if !foundone != true then str" on" ++ spc () ++ pr_ev s (Proofview.Goal.goal gl) - else mt ()))); + else mt ()) + in + Feedback.msg_debug (msg ++ str " failed with " ++ CErrors.iprint ie) + else () + in let tac_of gls i j = Goal.nf_enter { enter = fun gl' -> let sigma' = Goal.sigma gl' in let s' = Sigma.to_evar_map sigma' in @@ -1136,7 +1141,9 @@ module Search = struct else ortac (with_shelf tac >>= fun s -> let i = !idx in incr idx; result s i None) - (fun e' -> aux (merge_exceptions e e') tl) + (fun e' -> if CErrors.noncritical (fst e') then + (pr_error e'; aux (merge_exceptions e e') tl) + else iraise e') and aux e = function | x :: xs -> onetac e x xs | [] -> -- cgit v1.2.3 From 8aa945902d40765f69cd16ce7647d3c28248eb54 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 18:33:08 +0200 Subject: Handle Unique Solutions flag. --- tactics/class_tactics.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 8ec005a60..c1a2f7ff2 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -9,7 +9,6 @@ (* TODO: - Find an interface allowing eauto to backtrack when shelved goals remain, e.g. to force instantiations. - - unique solutions *) open Pp @@ -1256,6 +1255,9 @@ module Search = struct Tacticals.New.tclFAIL 0 (str"Proof search failed" ++ (if Option.is_empty depth then mt() else str" without reaching its limit")) + | Proofview.MoreThanOneSuccess -> + Tacticals.New.tclFAIL 0 (str"Proof search failed: " ++ + str"more than one success found.") | e -> Proofview.tclZERO ~info:ie e in Proofview.tclOR tac error @@ -1273,6 +1275,11 @@ module Search = struct let _, pv = Proofview.init evm' [] in let pv = Proofview.unshelve goals pv in try + let tac = + if unique then + Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac + else tac + in let (), pv', (unsafe, shelved, gaveup), _ = Proofview.apply (Global.env ()) tac pv in @@ -1292,7 +1299,7 @@ module Search = struct with Logic_monad.TacticFailure _ -> raise Not_found let eauto depth only_classes unique dep st hints p evd = - let eauto_tac = eauto_tac ~st ~only_classes ~depth ~dep hints in + let eauto_tac = eauto_tac ~st ~only_classes ~depth ~dep:(unique || dep) hints in let res = run_on_evars ~unique p evd eauto_tac in match res with | None -> evd -- cgit v1.2.3 From c5802966f23b9a8dc34f55961d4861997a3df01f Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 18:34:13 +0200 Subject: Test new syntax for hints and typeclass options --- test-suite/success/Hints.v | 81 ++++++++++++++++++++++++++++++++++++---- test-suite/success/Typeclasses.v | 47 +++++++++++++++++++++++ 2 files changed, 121 insertions(+), 7 deletions(-) diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v index 91edc06bf..1abe14774 100644 --- a/test-suite/success/Hints.v +++ b/test-suite/success/Hints.v @@ -1,4 +1,12 @@ (* Checks syntax of Hints commands *) +(* Old-style syntax *) +Hint Resolve eq_refl eq_sym. +Hint Resolve eq_refl eq_sym: foo. +Hint Immediate eq_refl eq_sym. +Hint Immediate eq_refl eq_sym: foo. +Hint Unfold fst eq_sym. +Hint Unfold fst eq_sym: foo. + (* Checks that qualified names are accepted *) (* New-style syntax *) @@ -8,17 +16,76 @@ Hint Unfold eq_sym: core. Hint Constructors eq: foo bar. Hint Extern 3 (_ = _) => apply eq_refl: foo bar. +(* Extended new syntax with patterns *) Hint Resolve eq_refl | 4 (_ = _) : baz. Hint Resolve eq_sym eq_trans : baz. Hint Extern 3 (_ = _) => apply eq_sym : baz. -(* Old-style syntax *) -Hint Resolve eq_refl eq_sym. -Hint Resolve eq_refl eq_sym: foo. -Hint Immediate eq_refl eq_sym. -Hint Immediate eq_refl eq_sym: foo. -Hint Unfold fst eq_sym. -Hint Unfold fst eq_sym: foo. +Parameter pred : nat -> Prop. +Parameter pred0 : pred 0. +Parameter f : nat -> nat. +Parameter predf : forall n, pred n -> pred (f n). + +(* No conversion on let-bound variables and constants in pred (the default) *) +Hint Resolve pred0 | 1 (pred _) : pred. +Hint Resolve predf | 0 : pred. + +(* Allow full conversion on let-bound variables and constants *) +Create HintDb predconv discriminated. +Hint Resolve pred0 | 1 (pred _) : predconv. +Hint Resolve predf | 0 : predconv. + +Goal exists n, pred n. + eexists. + Fail Timeout 1 typeclasses eauto with pred. + Set Typeclasses Filtered Unification. + Set Typeclasses Debug Verbosity 2. + (* predf is not tried as it doesn't match the goal *) + typeclasses eauto with pred. +Qed. + +Parameter predconv : forall n, pred n -> pred (0 + S n). + +(* The inferred pattern contains 0 + ?n, syntactic match will fail to see convertible + terms *) +Hint Resolve pred0 : pred2. +Hint Resolve predconv : pred2. + +(** In this database we allow predconv to apply to pred (S _) goals, more generally + than the inferred pattern (pred (0 + S _)). *) +Create HintDb pred2conv discriminated. +Hint Resolve pred0 : pred2conv. +Hint Resolve predconv | 1 (pred (S _)) : pred2conv. + +Goal pred 3. + Fail typeclasses eauto with pred2. + typeclasses eauto with pred2conv. +Abort. + +Set Typeclasses Filtered Unification. +Set Typeclasses Debug Verbosity 2. +Hint Resolve predconv | 1 (pred _) : pred. +Hint Resolve predconv | 1 (pred (S _)) : predconv. +Test Typeclasses Limit Intros. +Goal pred 3. + (* predf is not tried as it doesn't match the goal *) + (* predconv is tried but fails as the transparent state doesn't allow + unfolding + *) + Fail typeclasses eauto with pred. + (* Here predconv succeeds as it matches (pred (S _)) and then + full unification is allowed *) + typeclasses eauto with predconv. +Qed. + +(** The other way around: goal contains redexes instead of instances *) +Goal exists n, pred (0 + n). + eexists. + (* predf is applied indefinitely *) + Fail Timeout 1 typeclasses eauto with pred. + (* pred0 (pred _) matches the goal *) + typeclasses eauto with predconv. +Qed. + (* Checks that local names are accepted *) Section A. diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index 3eaa04144..651bbf7d2 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -1,3 +1,16 @@ +Module onlyclasses. + + Variable Foo : Type. + Variable foo : Foo. + Hint Extern 0 Foo => exact foo : typeclass_instances. + Goal Foo * Foo. + split. shelve. + Fail typeclasses eauto. + typeclasses eauto with typeclass_instances. + Unshelve. typeclasses eauto with typeclass_instances. + Abort. +End onlyclasses. + Module bt. Require Import Equivalence. @@ -104,6 +117,40 @@ Section sec. Check U (fun x => e x) _. End sec. +Module UniqueSolutions. + Set Typeclasses Unique Solutions. + Class Eq (A : Type) : Set. + Instance eqa : Eq nat := {}. + Instance eqb : Eq nat := {}. + + Goal Eq nat. + try apply _. + Fail exactly_once typeclasses eauto. + Abort. +End UniqueSolutions. + + +Module UniqueInstances. + (** Optimize proof search on this class by never backtracking on (closed) goals + for it. *) + Set Typeclasses Unique Instances. + Class Eq (A : Type) : Set. + Instance eqa : Eq nat := _. constructor. Qed. + Instance eqb : Eq nat := {}. + Class Foo (A : Type) (e : Eq A) : Set. + Instance fooa : Foo _ eqa := {}. + + Tactic Notation "refineu" open_constr(c) := unshelve refine c. + + Set Typeclasses Debug. + Goal { e : Eq nat & Foo nat e }. + unshelve refineu (existT _ _ _). + all:simpl. + (** Does not backtrack on the (wrong) solution eqb *) + Fail all:typeclasses eauto. + Abort. +End UniqueInstances. + Module IterativeDeepening. Class A. -- cgit v1.2.3 From a477dca64bb71a98fb92875df438d44d1fe54400 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 26 Oct 2016 19:20:08 +0200 Subject: Fix handling of only_classes at toplevel --- ltac/extratactics.ml4 | 21 ++++-- tactics/class_tactics.ml | 99 ++++++++++++++++++---------- tactics/class_tactics.mli | 2 + test-suite/bugs/closed/3513.v | 31 +++++++-- test-suite/success/Typeclasses.v | 30 ++++++++- test-suite/success/eauto.v | 135 +++++++++++++++++++++++++++------------ 6 files changed, 234 insertions(+), 84 deletions(-) diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index 063bfbe6d..d9780dcc8 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -348,11 +348,12 @@ let constr_flags = { Pretyping.fail_evar = false; Pretyping.expand_evars = true } -let refine_tac ist simple c = +let refine_tac ist simple with_classes c = Proofview.Goal.nf_enter { enter = begin fun gl -> let concl = Proofview.Goal.concl gl in let env = Proofview.Goal.env gl in - let flags = constr_flags in + let flags = + { constr_flags with Pretyping.use_typeclasses = with_classes } in let expected_type = Pretyping.OfType concl in let c = Pretyping.type_uconstr ~flags ~expected_type ist c in let update = { run = fun sigma -> c.delayed env sigma } in @@ -364,11 +365,23 @@ let refine_tac ist simple c = end } TACTIC EXTEND refine -| [ "refine" uconstr(c) ] -> [ refine_tac ist false c ] +| [ "refine" uconstr(c) ] -> + [ refine_tac ist false true c ] END TACTIC EXTEND simple_refine -| [ "simple" "refine" uconstr(c) ] -> [ refine_tac ist true c ] +| [ "simple" "refine" uconstr(c) ] -> + [ refine_tac ist true true c ] +END + +TACTIC EXTEND notcs_refine +| [ "notypeclasses" "refine" uconstr(c) ] -> + [ refine_tac ist false false c ] +END + +TACTIC EXTEND notcs_simple_refine +| [ "simple" "notypeclasses" "refine" uconstr(c) ] -> + [ refine_tac ist true false c ] END (**********************************************************************) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index c1a2f7ff2..103368e02 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -92,7 +92,7 @@ open Goptions let _ = declare_bool_option { optsync = true; - optdepr = false; + optdepr = true; optname = "do typeclass search modulo eta conversion"; optkey = ["Typeclasses";"Modulo";"Eta"]; optread = get_typeclasses_modulo_eta; @@ -183,8 +183,8 @@ let set_typeclasses_depth = type search_strategy = Dfs | Bfs let set_typeclasses_strategy = function - | Dfs -> set_typeclasses_iterative_deepening true - | Bfs -> set_typeclasses_iterative_deepening false + | Dfs -> set_typeclasses_iterative_deepening false + | Bfs -> set_typeclasses_iterative_deepening true let pr_ev evs ev = Printer.pr_constr_env (Goal.V82.env evs ev) evs @@ -302,7 +302,7 @@ let with_prods nprods poly (c, clenv) f = | None -> Tacticals.New.tclZEROMSG (str"Not enough premisses") | Some (diff, clenv') -> f.enter gl (c, diff, clenv') with e when CErrors.noncritical e -> - Tacticals.New.tclFAIL 0 (CErrors.print e) end } + Tacticals.New.tclZEROMSG (CErrors.print e) end } else Proofview.Goal.nf_enter { enter = begin fun gl -> if Int.equal nprods 0 then f.enter gl (c, None, clenv) @@ -345,8 +345,8 @@ let pr_gls sigma gls = let shelve_dependencies gls = let open Proofview in tclEVARMAP >>= fun sigma -> - (if !typeclasses_debug > 1 then - Feedback.msg_debug (str" shelving goals: " ++ pr_gls sigma gls); + (if !typeclasses_debug > 1 && List.length gls > 0 then + Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls); shelve_goals gls) (** Hack to properly solve dependent evars that are typeclasses *) @@ -1011,6 +1011,17 @@ module Search = struct Evd.add sigma gl evi') sigma goals + let shelve_nonclass info = + Proofview.Goal.enter { enter = fun gl -> + let gl = Proofview.Goal.assume gl in + let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in + if is_class_type sigma (Proofview.Goal.concl gl) then + Proofview.tclUNIT () + else (if !typeclasses_debug > 1 then + Feedback.msg_debug (pr_depth info.search_depth ++ str": shelving non-class subgoal " ++ + pr_ev sigma (Proofview.Goal.goal gl)); + Proofview.shelve) } + (** The general hint application tactic. tac1 + tac2 .... The choice of OR or ORELSE is determined depending on the dependencies of the goal and the unique/Prop @@ -1121,7 +1132,7 @@ module Search = struct in the subgoals, turn them into subgoals now. *) let shelved, goals = List.split_when (fun (ev, s) -> s) remaining in let shelved = List.map fst shelved and goals = List.map fst goals in - if !typeclasses_debug > 1 then + if !typeclasses_debug > 1 && not (List.is_empty goals) then Feedback.msg_debug (str"Adding shelved subgoals to the search: " ++ prlist_with_sep spc (pr_ev sigma) goals ++ @@ -1137,12 +1148,18 @@ module Search = struct in res <*> tclEVARMAP >>= finish in if path_matches derivs [] then aux e tl - else ortac - (with_shelf tac >>= fun s -> + else + let filter = + if info.search_only_classes then shelve_nonclass info + else Proofview.tclUNIT () + in + ortac + (with_shelf (tac <*> filter) >>= fun s -> let i = !idx in incr idx; result s i None) - (fun e' -> if CErrors.noncritical (fst e') then - (pr_error e'; aux (merge_exceptions e e') tl) - else iraise e') + (fun e' -> + if CErrors.noncritical (fst e') then + (pr_error e'; aux (merge_exceptions e e') tl) + else (Printf.printf "raising again\n%!"; iraise e')) and aux e = function | x :: xs -> onetac e x xs | [] -> @@ -1203,9 +1220,12 @@ module Search = struct unit Proofview.tactic = let open Proofview in let open Proofview.Notations in - let dep = dep || Proofview.unifiable sigma (Goal.goal gl) gls in - let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in - search_tac hints depth 1 info + if only_classes && not (is_class_type sigma (Goal.concl gl)) then + Proofview.shelve + else + let dep = dep || Proofview.unifiable sigma (Goal.goal gl) gls in + let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in + search_tac hints depth 1 info let search_tac ?(st=full_transparent_state) only_classes dep hints depth = let open Proofview in @@ -1236,7 +1256,22 @@ module Search = struct | (e,ie) -> Proofview.tclZERO ~info:ie e) in aux 1 - let eauto_tac ?(st=full_transparent_state) ~only_classes ~depth ~dep hints = + let disallow_shelved tac = + let open Proofview in + with_shelf (tclONCE tac) >>= fun (shelved,result) -> + (if not (List.is_empty shelved) then + begin + Proofview.tclEVARMAP >>= fun sigma -> + let gls = prlist_with_sep spc (pr_ev sigma) shelved in + (if !typeclasses_debug > 0 then + Feedback.msg_debug (str"Non-empty shelf at end of resolution:" ++ gls)); + Tacticals.New.tclFAIL 1 (str"Proof search failed: " ++ + str"shelved goals remain: " ++ gls) + end + else tclUNIT result) + + let eauto_tac ?(st=full_transparent_state) ?(unique=false) ~only_classes ~depth ~dep hints = + let open Proofview in let tac = let search = search_tac ~st only_classes dep hints in if get_typeclasses_iterative_deepening () then @@ -1257,11 +1292,19 @@ module Search = struct else str" without reaching its limit")) | Proofview.MoreThanOneSuccess -> Tacticals.New.tclFAIL 0 (str"Proof search failed: " ++ - str"more than one success found.") + str"more than one success found") | e -> Proofview.tclZERO ~info:ie e - in Proofview.tclOR tac error + in + let tac = Proofview.tclOR tac error in + let tac = + if unique then + Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac + else tac + in + let tac = if only_classes then disallow_shelved tac else tac in + tac - let run_on_evars ?(unique=false) p evm tac = + let run_on_evars p evm tac = match evars_to_goals p evm with | None -> None (* This happens only because there's no evar having p *) | Some (goals, evm') -> @@ -1275,11 +1318,6 @@ module Search = struct let _, pv = Proofview.init evm' [] in let pv = Proofview.unshelve goals pv in try - let tac = - if unique then - Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac - else tac - in let (), pv', (unsafe, shelved, gaveup), _ = Proofview.apply (Global.env ()) tac pv in @@ -1298,16 +1336,15 @@ module Search = struct else raise Not_found with Logic_monad.TacticFailure _ -> raise Not_found - let eauto depth only_classes unique dep st hints p evd = - let eauto_tac = eauto_tac ~st ~only_classes ~depth ~dep:(unique || dep) hints in - let res = run_on_evars ~unique p evd eauto_tac in + let evars_eauto depth only_classes unique dep st hints p evd = + let eauto_tac = eauto_tac ~st ~unique ~only_classes ~depth ~dep:(unique || dep) hints in + let res = run_on_evars p evd eauto_tac in match res with | None -> evd | Some evd' -> evd' - (* TODO treat unique solutions *) let typeclasses_eauto ?depth unique st hints p evd = - eauto depth true unique false st hints p evd + evars_eauto depth true unique false st hints p evd (** Typeclasses eauto is an eauto which tries to resolve only goals of typeclass type, and assumes that the initially selected evars in evd are independent of the rest of the evars *) @@ -1318,8 +1355,6 @@ module Search = struct end (** Binding to either V85 or Search implementations. *) -let eauto depth ~only_classes ~st ~dep dbs = - Search.eauto_tac ~st ~only_classes ~depth ~dep dbs let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) ~depth dbs = @@ -1336,7 +1371,7 @@ let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) try V85.eauto85 depth ~only_classes ~st dbs gl with Not_found -> Refiner.tclFAIL 0 (str"Proof search failed") gl) - else eauto depth ~only_classes ~st ~dep:true dbs + else Search.eauto_tac ~st ~only_classes ~depth ~dep:true dbs (** We compute dependencies via a union-find algorithm. Beware of the imperative effects on the partition structure, diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli index 565415a95..21c5d2172 100644 --- a/tactics/class_tactics.mli +++ b/tactics/class_tactics.mli @@ -40,6 +40,8 @@ module Search : sig val eauto_tac : ?st:Names.transparent_state -> (** The transparent_state used when working with local hypotheses *) + ?unique:bool -> + (** Should we force a unique solution *) only_classes:bool -> (** Should non-class goals be shelved and resolved at the end *) depth:Int.t option -> diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v index fcdfa0057..ff515038e 100644 --- a/test-suite/bugs/closed/3513.v +++ b/test-suite/bugs/closed/3513.v @@ -1,4 +1,3 @@ -Require Import TestSuite.admit. (* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines *) Require Coq.Setoids.Setoid. Import Coq.Setoids.Setoid. @@ -35,7 +34,7 @@ Local Existing Instance ILFun_Ops. Local Existing Instance ILFun_ILogic. Definition catOP (P Q: OPred) : OPred := admit. Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. -admit. +apply admit. Defined. Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. Class IsPointed (T : Type) := point : T. @@ -69,8 +68,26 @@ Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) pose P; refine (P _ _) end; unfold Basics.flip. - 2: solve [ apply reflexivity ]. - Undo. - 2: reflexivity. (* Toplevel input, characters 18-29: -Error: -Tactic failure: The relation lentails is not a declared reflexive relation. Maybe you need to require the Setoid library. *) \ No newline at end of file + Focus 2. + Set Typeclasses Debug. + Set Typeclasses Legacy Resolution. + apply reflexivity. + (* Debug: 1.1: apply @IsPointed_catOP on +(IsPointed (exists x0 : Actions, (catOP ?Goal O2 : OPred) x0)) +Debug: 1.1.1.1: apply OPred_inhabited on (IsPointed (exists x0 : Actions, ?Goal x0)) +Debug: 1.1.2.1: apply OPred_inhabited on (IsPointed (exists x : Actions, O2 x)) +Debug: 2.1: apply @Equivalence_Reflexive on (Reflexive lentails) +Debug: 2.1.1: no match for (Equivalence lentails) , 5 possibilities +Debug: Backtracking after apply @Equivalence_Reflexive +Debug: 2.2: apply @PreOrder_Reflexive on (Reflexive lentails) +Debug: 2.2.1.1: apply @lentailsPre on (PreOrder lentails) +Debug: 2.2.1.1.1.1: apply ILFun_ILogic on (ILogic OPred) +*) + Undo. Unset Typeclasses Legacy Resolution. + Test Typeclasses Unique Solutions. + Test Typeclasses Unique Instances. + Show Existentials. + Set Typeclasses Debug Verbosity 2. + Set Printing All. + Fail apply reflexivity. + \ No newline at end of file diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index 651bbf7d2..4581a7ce4 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -5,12 +5,40 @@ Module onlyclasses. Hint Extern 0 Foo => exact foo : typeclass_instances. Goal Foo * Foo. split. shelve. - Fail typeclasses eauto. + Set Typeclasses Debug. + typeclasses eauto. typeclasses eauto with typeclass_instances. Unshelve. typeclasses eauto with typeclass_instances. Abort. End onlyclasses. +Module shelve_non_class_subgoals. + Variable Foo : Type. + Variable foo : Foo. + Hint Extern 0 Foo => exact foo : typeclass_instances. + Class Bar := {}. + Instance bar1 (f:Foo) : Bar. + + Typeclasses eauto := debug. + Set Typeclasses Debug Verbosity 2. + Goal Bar. + (* Solution has shelved subgoals *) + Fail typeclasses eauto. + Abort. +End shelve_non_class_subgoals. + +Module shelve_non_class_subgoals2. + Class Bar := {}. + + Instance bar1 (t:Type) : Bar. + Hint Extern 0 => exact True : typeclass_instances. + Typeclasses eauto := debug. + Goal Bar. + Fail typeclasses eauto. + debug eauto with typeclass_instances. + Qed. +End shelve_non_class_subgoals2. + Module bt. Require Import Equivalence. diff --git a/test-suite/success/eauto.v b/test-suite/success/eauto.v index 4db547f4e..9bcecfe1f 100644 --- a/test-suite/success/eauto.v +++ b/test-suite/success/eauto.v @@ -5,7 +5,6 @@ (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -Require Import List. Class A (A : Type). Instance an: A nat. @@ -31,6 +30,8 @@ Defined. Hint Extern 0 (_ /\ _) => constructor : typeclass_instances. +Existing Class and. + Goal exists (T : Type) (t : T), A T /\ B T t. Proof. eexists. eexists. typeclasses eauto. @@ -46,7 +47,7 @@ Class C {T} `(a : A T) (t : T). Require Import Classes.Init. Hint Extern 0 { x : ?A & _ } => unshelve class_apply @existT : typeclass_instances. - +Existing Class sigT. Set Typeclasses Debug. Instance can: C an 0. (* Backtrack on instance implementation *) @@ -63,41 +64,6 @@ Proof. Defined. -Parameter in_list : list (nat * nat) -> nat -> Prop. -Definition not_in_list (l : list (nat * nat)) (n : nat) : Prop := - ~ in_list l n. - -(* Hints Unfold not_in_list. *) - -Axiom - lem1 : - forall (l1 l2 : list (nat * nat)) (n : nat), - not_in_list (l1 ++ l2) n -> not_in_list l1 n. - -Axiom - lem2 : - forall (l1 l2 : list (nat * nat)) (n : nat), - not_in_list (l1 ++ l2) n -> not_in_list l2 n. - -Axiom - lem3 : - forall (l : list (nat * nat)) (n p q : nat), - not_in_list ((p, q) :: l) n -> not_in_list l n. - -Axiom - lem4 : - forall (l1 l2 : list (nat * nat)) (n : nat), - not_in_list l1 n -> not_in_list l2 n -> not_in_list (l1 ++ l2) n. - -Hint Resolve lem1 lem2 lem3 lem4: essai. - -Goal -forall (l : list (nat * nat)) (n p q : nat), -not_in_list ((p, q) :: l) n -> not_in_list l n. - intros. - eauto with essai. -Qed. - (* Example from Nicolas Magaud on coq-club - Jul 2000 *) Definition Nat : Set := nat. @@ -126,6 +92,9 @@ Qed. Full backtracking on dependent subgoals. *) Require Import Coq.Classes.Init. + +Module NTabareau. + Set Typeclasses Dependency Order. Unset Typeclasses Iterative Deepening. Notation "x .1" := (projT1 x) (at level 3). @@ -149,7 +118,8 @@ Hint Extern 5 (Bar ?D.1) => Hint Extern 5 (Qux ?D.1) => destruct D; simpl : typeclass_instances. -Hint Extern 1 myType => unshelve refine (fooTobar _ _).1 : typeclass_instances. +Hint Extern 1 myType => + unshelve refine (fooTobar _ _).1 : typeclass_instances. Hint Extern 1 myType => unshelve refine (barToqux _ _).1 : typeclass_instances. @@ -158,8 +128,93 @@ Hint Extern 0 { x : _ & _ } => simple refine (existT _ _ _) : typeclass_instance Unset Typeclasses Debug. Definition trivial a (H : Foo a) : {b : myType & Qux b}. Proof. - Time typeclasses eauto 10. + Time typeclasses eauto 10 with typeclass_instances. Undo. Set Typeclasses Iterative Deepening. - Time typeclasses eauto. + Time typeclasses eauto with typeclass_instances. Defined. +End NTabareau. + +Module NTabareauClasses. + +Set Typeclasses Dependency Order. +Unset Typeclasses Iterative Deepening. +Notation "x .1" := (projT1 x) (at level 3). +Notation "x .2" := (projT2 x) (at level 3). + +Parameter myType: Type. +Existing Class myType. + +Class Foo (a:myType) := {}. + +Class Bar (a:myType) := {}. + +Class Qux (a:myType) := {}. + +Parameter fooTobar : forall a (H : Foo a), {b: myType & Bar b}. + +Parameter barToqux : forall a (H : Bar a), {b: myType & Qux b}. + +Hint Extern 5 (Bar ?D.1) => + destruct D; simpl : typeclass_instances. + +Hint Extern 5 (Qux ?D.1) => + destruct D; simpl : typeclass_instances. + +Hint Extern 1 myType => + unshelve notypeclasses refine (fooTobar _ _).1 : typeclass_instances. + +Hint Extern 1 myType => + unshelve notypeclasses refine (barToqux _ _).1 : typeclass_instances. + +Hint Extern 0 { x : _ & _ } => + unshelve notypeclasses refine (existT _ _ _) : typeclass_instances. + +Unset Typeclasses Debug. + +Definition trivial a (H : Foo a) : {b : myType & Qux b}. +Proof. + Time typeclasses eauto 10 with typeclass_instances. + Undo. Set Typeclasses Iterative Deepening. + Time typeclasses eauto with typeclass_instances. +Defined. + +End NTabareauClasses. + + +Require Import List. + +Parameter in_list : list (nat * nat) -> nat -> Prop. +Definition not_in_list (l : list (nat * nat)) (n : nat) : Prop := + ~ in_list l n. + +(* Hints Unfold not_in_list. *) + +Axiom + lem1 : + forall (l1 l2 : list (nat * nat)) (n : nat), + not_in_list (l1 ++ l2) n -> not_in_list l1 n. + +Axiom + lem2 : + forall (l1 l2 : list (nat * nat)) (n : nat), + not_in_list (l1 ++ l2) n -> not_in_list l2 n. + +Axiom + lem3 : + forall (l : list (nat * nat)) (n p q : nat), + not_in_list ((p, q) :: l) n -> not_in_list l n. + +Axiom + lem4 : + forall (l1 l2 : list (nat * nat)) (n : nat), + not_in_list l1 n -> not_in_list l2 n -> not_in_list (l1 ++ l2) n. + +Hint Resolve lem1 lem2 lem3 lem4: essai. + +Goal +forall (l : list (nat * nat)) (n p q : nat), +not_in_list ((p, q) :: l) n -> not_in_list l n. + intros. + eauto with essai. +Qed. -- cgit v1.2.3 From c0f3d5fb81c543d1b05b0ff7041efee086514f3a Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 29 Oct 2016 11:48:26 +0200 Subject: Fix [typeclasses eauto with] and nopattern hints This was the source of a bug in #5115#c7. --- tactics/class_tactics.ml | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 103368e02..72e410160 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -349,6 +349,15 @@ let shelve_dependencies gls = Feedback.msg_debug (str" shelving dependent subgoals: " ++ pr_gls sigma gls); shelve_goals gls) +let hintmap_of hdc secvars concl = + match hdc with + | None -> fun db -> Hint_db.map_none secvars db + | Some hdc -> + fun db -> + if Hint_db.use_dn db then (* Using dnet *) + Hint_db.map_eauto secvars hdc concl db + else Hint_db.map_existential secvars hdc concl db + (** Hack to properly solve dependent evars that are typeclasses *) let rec e_trivial_fail_db only_classes db_list local_db secvars = let open Tacticals.New in @@ -384,20 +393,20 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co let nprods = List.length prods in let freeze = try - let cl = Typeclasses.class_info (fst hdc) in - if cl.cl_strict then - Evd.evars_of_term concl - else Evar.Set.empty + match hdc with + | Some (hd,_) when only_classes -> + let cl = Typeclasses.class_info hd in + if cl.cl_strict then + Evd.evars_of_term concl + else Evar.Set.empty + | _ -> Evar.Set.empty with e when CErrors.noncritical e -> Evar.Set.empty in + let hint_of_db = hintmap_of hdc secvars concl in let hintl = List.map_append (fun db -> - let tacs = - if Hint_db.use_dn db then (* Using dnet *) - Hint_db.map_eauto secvars hdc concl db - else Hint_db.map_existential secvars hdc concl db - in + let tacs = hint_of_db db in let flags = auto_unif_flags freeze (Hint_db.transparent_state db) in List.map (fun x -> (flags, x)) tacs) (local_db::db_list) @@ -469,16 +478,16 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co in List.map tac_of_hint hintl and e_trivial_resolve db_list local_db secvars only_classes sigma concl = + let hd = try Some (decompose_app_bound concl) with Bound -> None in try - e_my_find_search db_list local_db secvars - (decompose_app_bound concl) true only_classes sigma concl - with Bound | Not_found -> [] + e_my_find_search db_list local_db secvars hd true only_classes sigma concl + with Not_found -> [] let e_possible_resolve db_list local_db secvars only_classes sigma concl = + let hd = try Some (decompose_app_bound concl) with Bound -> None in try - e_my_find_search db_list local_db secvars - (decompose_app_bound concl) false only_classes sigma concl - with Bound | Not_found -> [] + e_my_find_search db_list local_db secvars hd false only_classes sigma concl + with Not_found -> [] let cut_of_hints h = List.fold_left (fun cut db -> PathOr (Hint_db.cut db, cut)) PathEmpty h -- cgit v1.2.3 From 98305374e2fdec4b64d7d086ddca0c4e812b178e Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 29 Oct 2016 11:51:38 +0200 Subject: typeclasses eauto Implem/doc of shelving strategy Now [typeclasses eauto] mimicks what happens during resolution faithfully, and the shelving behavior/requirements for a successful proof-search are documented. --- doc/refman/Classes.tex | 13 ++++++++++- tactics/class_tactics.ml | 47 +++++++++++++++++++++++++++------------- test-suite/success/Typeclasses.v | 17 ++++++++------- test-suite/success/bteauto.v | 10 ++++++--- test-suite/success/eauto.v | 1 + 5 files changed, 61 insertions(+), 27 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index 254fca28f..d6a553e1a 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -394,7 +394,18 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: {\tt typeclass\_instances} database by default (instead of {\tt core}) and will try to solve \emph{only} typeclass goals. Other subgoals are automatically shelved and \emph{must be} resolved entirely when the - other typeclass subgoals are resolved or the proof search will fail. + other typeclass subgoals are resolved or the proof search will fail + \emph{globally}, \emph{without} the possibility to find another + complete solution with no shelved subgoals. + + \emph{Note: } As of Coq 8.6, {\tt all:once (typeclasses eauto)} + faithfully mimicks what happens during typeclass resolution when it is + called during refinement/type-inference. It might move to {\tt + all:typeclasses eauto} in future versions when the refinement engine + will be able to backtrack. +\item When called with specific databases (e.g. {\tt with}), {\tt + typeclasses eauto} allows shelved goals to remain at any point + during search and treat typeclasses goals like any other. \item The transparency information of databases is used consistently for all hints declared in them. It is always used when calling the unifier. When considering the local hypotheses, we use the transparent diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 72e410160..91eb388b3 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1265,21 +1265,29 @@ module Search = struct | (e,ie) -> Proofview.tclZERO ~info:ie e) in aux 1 - let disallow_shelved tac = + let disallow_shelved initshelf tac = let open Proofview in - with_shelf (tclONCE tac) >>= fun (shelved,result) -> - (if not (List.is_empty shelved) then - begin - Proofview.tclEVARMAP >>= fun sigma -> - let gls = prlist_with_sep spc (pr_ev sigma) shelved in - (if !typeclasses_debug > 0 then - Feedback.msg_debug (str"Non-empty shelf at end of resolution:" ++ gls)); - Tacticals.New.tclFAIL 1 (str"Proof search failed: " ++ - str"shelved goals remain: " ++ gls) - end - else tclUNIT result) - - let eauto_tac ?(st=full_transparent_state) ?(unique=false) ~only_classes ~depth ~dep hints = + let casefn = function + | Fail (e,info) -> tclZERO ~info e + | Next ((shelved, result), k) -> + if not (List.is_empty shelved) then + begin + Proofview.tclEVARMAP >>= fun sigma -> + let gls = prlist_with_sep spc (pr_ev sigma) shelved in + (if !typeclasses_debug > 0 then + let initgls = prlist_with_sep spc (pr_ev sigma) initshelf in + Feedback.msg_debug (str"Non-empty shelf at end of resolution:" ++ gls + ++ str" initially: " ++ initgls ++ str".")); + Tacticals.New.tclZEROMSG (str"Proof search failed: " ++ + str"shelved goals remain: " ++ gls) + end + else + tclOR (tclUNIT result) (fun e -> k e >>= fun (gls, result) -> tclUNIT result) + in + tclCASE (with_shelf tac) >>= casefn + + let eauto_tac ?(st=full_transparent_state) ?(unique=false) + ~only_classes ~depth ~dep hints = let open Proofview in let tac = let search = search_tac ~st only_classes dep hints in @@ -1310,7 +1318,16 @@ module Search = struct Proofview.tclEXACTLY_ONCE Proofview.MoreThanOneSuccess tac else tac in - let tac = if only_classes then disallow_shelved tac else tac in + with_shelf numgoals >>= fun (initshelf, i) -> + (if !typeclasses_debug > 1 then + Feedback.msg_debug (str"Starting resolution with " ++ int i ++ + str" goal(s) under focus and " ++ + int (List.length initshelf) ++ str " shelved goal(s)" ++ + if only_classes then str " in only_classes mode" else + str " in regular mode" ++ + match depth with None -> str ", unbounded" + | Some i -> str ", with depth limit " ++ int i)); + let tac = if only_classes then disallow_shelved initshelf tac else tac in tac let run_on_evars p evm tac = diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index 4581a7ce4..6885717ec 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -6,10 +6,10 @@ Module onlyclasses. Goal Foo * Foo. split. shelve. Set Typeclasses Debug. - typeclasses eauto. + Fail typeclasses eauto. typeclasses eauto with typeclass_instances. Unshelve. typeclasses eauto with typeclass_instances. - Abort. + Qed. End onlyclasses. Module shelve_non_class_subgoals. @@ -22,22 +22,23 @@ Module shelve_non_class_subgoals. Typeclasses eauto := debug. Set Typeclasses Debug Verbosity 2. Goal Bar. - (* Solution has shelved subgoals *) + (* Solution has shelved subgoals (of non typeclass type) *) Fail typeclasses eauto. Abort. End shelve_non_class_subgoals. -Module shelve_non_class_subgoals2. +Module Leivantex2PR339. + (** Was a bug preventing to find hints associated with no pattern *) Class Bar := {}. - Instance bar1 (t:Type) : Bar. Hint Extern 0 => exact True : typeclass_instances. Typeclasses eauto := debug. Goal Bar. Fail typeclasses eauto. - debug eauto with typeclass_instances. - Qed. -End shelve_non_class_subgoals2. + Set Typeclasses Debug Verbosity 2. + typeclasses eauto with typeclass_instances. + Qed. +End Leivantex2PR339. Module bt. Require Import Equivalence. diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v index bb1cf0654..f97f764b4 100644 --- a/test-suite/success/bteauto.v +++ b/test-suite/success/bteauto.v @@ -8,7 +8,7 @@ Module Backtracking. Qed. Arguments foo A : clear implicits. - + Require Import Program.Tactics. Example find42 : exists n, n = 42. Proof. eexists. @@ -20,9 +20,13 @@ Module Backtracking. Fail reflexivity. Undo 2. (* Without multiple successes it fails *) - Fail all:((once typeclasses eauto) + apply eq_refl). + Set Typeclasses Debug Verbosity 2. + Fail all:((once (typeclasses eauto with typeclass_instances)) + + apply eq_refl). (* Does backtrack if other goals fail *) - all:((typeclasses eauto) + reflexivity). + all:[> typeclasses eauto + reflexivity .. ]. + Undo 1. + all:(typeclasses eauto + reflexivity). (* Note "+" is a focussing combinator *) Show Proof. Qed. diff --git a/test-suite/success/eauto.v b/test-suite/success/eauto.v index 9bcecfe1f..160f2d9de 100644 --- a/test-suite/success/eauto.v +++ b/test-suite/success/eauto.v @@ -176,6 +176,7 @@ Definition trivial a (H : Foo a) : {b : myType & Qux b}. Proof. Time typeclasses eauto 10 with typeclass_instances. Undo. Set Typeclasses Iterative Deepening. + (* Much faster in iteratove deepening mode *) Time typeclasses eauto with typeclass_instances. Defined. -- cgit v1.2.3 From 0ab187ee578f0ef49ecf484278b8d3569630ee48 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 29 Oct 2016 11:55:29 +0200 Subject: Fixed bug #4095. --- test-suite/bugs/closed/4095.v | 87 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 test-suite/bugs/closed/4095.v diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v new file mode 100644 index 000000000..83d4ed69d --- /dev/null +++ b/test-suite/bugs/closed/4095.v @@ -0,0 +1,87 @@ +(* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) +(* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 + coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) +Require Import TestSuite.admit. +Require Import Coq.Setoids.Setoid. +Generalizable All Variables. +Axiom admit : forall {T}, T. +Class Equiv (A : Type) := equiv : relation A. +Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. +Class ILogicOps Frm := { lentails: relation Frm; + ltrue: Frm; + land: Frm -> Frm -> Frm; + lor: Frm -> Frm -> Frm }. +Infix "|--" := lentails (at level 79, no associativity). +Class ILogic Frm {ILOps: ILogicOps Frm} := { lentailsPre:> PreOrder lentails }. +Definition lequiv `{ILogic Frm} P Q := P |-- Q /\ Q |-- P. +Infix "-|-" := lequiv (at level 85, no associativity). +Instance lequiv_inverse_lentails `{ILogic Frm} : subrelation lequiv (inverse lentails) := admit. +Record ILFunFrm (T : Type) `{e : Equiv T} `{ILOps : ILogicOps Frm} := mkILFunFrm { ILFunFrm_pred :> T -> Frm }. +Section ILogic_Fun. + Context (T: Type) `{TType: type T}. + Context `{IL: ILogic Frm}. + Local Instance ILFun_Ops : ILogicOps (@ILFunFrm T _ Frm _) := admit. + Definition ILFun_ILogic : ILogic (@ILFunFrm T _ Frm _) := admit. +End ILogic_Fun. +Implicit Arguments ILFunFrm [[ILOps] [e]]. +Instance ILogicOps_Prop : ILogicOps Prop | 2 := {| lentails P Q := (P : Prop) -> Q; + ltrue := True; + land P Q := P /\ Q; + lor P Q := P \/ Q |}. +Axiom Action : Set. +Definition Actions := list Action. +Instance ActionsEquiv : Equiv Actions := { equiv a1 a2 := a1 = a2 }. +Definition OPred := ILFunFrm Actions Prop. +Local Existing Instance ILFun_Ops. +Local Existing Instance ILFun_ILogic. +Definition catOP (P Q: OPred) : OPred := admit. +Add Parametric Morphism : catOP with signature lentails ==> lentails ==> lentails as catOP_entails_m. +admit. +Defined. +Definition catOPA (P Q R : OPred) : catOP (catOP P Q) R -|- catOP P (catOP Q R) := admit. +Class IsPointed (T : Type) := point : T. +Notation IsPointed_OPred P := (IsPointed (exists x : Actions, (P : OPred) x)). +Record PointedOPred := mkPointedOPred { + OPred_pred :> OPred; + OPred_inhabited: IsPointed_OPred OPred_pred + }. +Existing Instance OPred_inhabited. +Canonical Structure default_PointedOPred O `{IsPointed_OPred O} : PointedOPred + := {| OPred_pred := O ; OPred_inhabited := _ |}. +Instance IsPointed_catOP `{IsPointed_OPred P, IsPointed_OPred Q} : IsPointed_OPred (catOP P Q) := admit. +Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) + (tr : T -> T) (O2 : PointedOPred) (x : T) + (H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0), + exists e1 e2, + catOP (O0 e1) (OPred_pred e2) |-- catOP (O1 x) O2. + intros; do 2 esplit. + rewrite <- catOPA. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => @Morphisms.proper_prf (OPred -> OPred -> OPred) + (@Morphisms.respectful OPred (OPred -> OPred) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop)) + (@lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop) ==> + @lentails OPred + (@ILFun_Ops Actions ActionsEquiv Prop ILogicOps_Prop))) catOP + catOP_entails_m_Proper a a' H b b' H') in + pose P; + refine (P _ _) + end. + Undo. + lazymatch goal with + | |- ?R (?f ?a ?b) (?f ?a' ?b') => + let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in + set(p:=P) + end. (* Toplevel input, characters 15-182: +Error: Cannot infer an instance of type +"PointedOPred" for the variable p in environment: +T : Type +O0 : T -> OPred +O1 : T -> PointedOPred +tr : T -> T +O2 : PointedOPred +x0 : T +H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *) \ No newline at end of file -- cgit v1.2.3 From d51c384e52003668bd97ca44da77a14c91e5cb14 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 29 Oct 2016 12:37:46 +0200 Subject: Fix test-suite files relying on tcs bugs - One was expecting shelved goals to remain after resolution (from refine). - The other too were relying on the wrong classification of subgoals as typeclass subgoals at toplevel. --- test-suite/bugs/closed/3699.v | 12 ++++-------- test-suite/bugs/closed/4863.v | 7 ++++--- test-suite/success/bteauto.v | 2 +- 3 files changed, 9 insertions(+), 12 deletions(-) diff --git a/test-suite/bugs/closed/3699.v b/test-suite/bugs/closed/3699.v index 8dadc2419..efa432526 100644 --- a/test-suite/bugs/closed/3699.v +++ b/test-suite/bugs/closed/3699.v @@ -34,8 +34,7 @@ Module NonPrim. : forall b:B, P b. Proof. intros b. - unshelve (refine (pr1 (isconnected_elim _ _))). - exact b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). intro x. exact (transport P x.2 (d x.1)). Defined. @@ -47,8 +46,7 @@ Module NonPrim. : forall b:B, P b. Proof. intros b. - unshelve (refine (pr1 (isconnected_elim _ _))). - exact b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). intros [a p]. exact (transport P p (d a)). Defined. @@ -111,8 +109,7 @@ Module Prim. : forall b:B, P b. Proof. intros b. - unshelve (refine (pr1 (isconnected_elim _ _))). - exact b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). intro x. exact (transport P x.2 (d x.1)). Defined. @@ -124,8 +121,7 @@ Module Prim. : forall b:B, P b. Proof. intros b. - unshelve (refine (pr1 (isconnected_elim _ _))). - exact b. + unshelve (refine (pr1 (isconnected_elim (A:=hfiber f b) _ _))). intros [a p]. exact (transport P p (d a)). Defined. diff --git a/test-suite/bugs/closed/4863.v b/test-suite/bugs/closed/4863.v index e884355fd..1e47f2957 100644 --- a/test-suite/bugs/closed/4863.v +++ b/test-suite/bugs/closed/4863.v @@ -3,14 +3,14 @@ Require Import Classes.DecidableClass. Inductive Foo : Set := | foo1 | foo2. -Instance Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. +Lemma Decidable_sumbool : forall P, {P}+{~P} -> Decidable P. Proof. intros P H. refine (Build_Decidable _ (if H then true else false) _). intuition congruence. Qed. -Hint Extern 100 ({?A = ?B}+{~ ?A = ?B}) => abstract (abstract (abstract (decide equality))) : typeclass_instances. +Hint Extern 100 (Decidable (?A = ?B)) => abstract (abstract (abstract (apply Decidable_sumbool; decide equality))) : typeclass_instances. Goal forall (a b : Foo), {a=b}+{a<>b}. intros. @@ -21,7 +21,8 @@ Check ltac:(abstract (exact I)) : True. Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). intros. -split. typeclasses eauto. typeclasses eauto. Qed. +split. typeclasses eauto. +typeclasses eauto. Qed. Goal forall (a b : Foo), Decidable (a=b) * Decidable (a=b). intros. diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v index f97f764b4..3178c6fc1 100644 --- a/test-suite/success/bteauto.v +++ b/test-suite/success/bteauto.v @@ -1,3 +1,4 @@ +Require Import Program.Tactics. Module Backtracking. Class A := { foo : nat }. @@ -8,7 +9,6 @@ Module Backtracking. Qed. Arguments foo A : clear implicits. - Require Import Program.Tactics. Example find42 : exists n, n = 42. Proof. eexists. -- cgit v1.2.3 From f6916774eea2ecc1262377cb14c2d494a0486358 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 29 Oct 2016 19:07:21 +0200 Subject: Do not shelve non-class subgoals but fail, it should be the instance writer's responsibility to not generated non-dependent non-class subgoals (otherwise we loose compatibility as shown in e.g. MathClasses, which goes into loops because of unexpectedly unconstrained goals). Reflect it in the doc. --- doc/refman/Classes.tex | 12 +++++++----- tactics/class_tactics.ml | 9 +++++---- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index d6a553e1a..58ae7191f 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -392,11 +392,13 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: backtracking on subgoals that are entirely independent. \item When called with no arguments, {\tt typeclasses eauto} uses the {\tt typeclass\_instances} database by default (instead of {\tt core}) - and will try to solve \emph{only} typeclass goals. Other subgoals are - automatically shelved and \emph{must be} resolved entirely when the - other typeclass subgoals are resolved or the proof search will fail - \emph{globally}, \emph{without} the possibility to find another - complete solution with no shelved subgoals. + and will try to solve \emph{only} typeclass goals. If some subgoal of + a hint/instance is non-dependent and not of class type, that hint + application will fail. Dependent subgoals are automatically shelved + and \emph{must be} resolved entirely when the other typeclass subgoals + are resolved or the proof search will fail \emph{globally}, + \emph{without} the possibility to find another complete solution with + no shelved subgoals. \emph{Note: } As of Coq 8.6, {\tt all:once (typeclasses eauto)} faithfully mimicks what happens during typeclass resolution when it is diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 91eb388b3..fe12b54a1 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1020,16 +1020,17 @@ module Search = struct Evd.add sigma gl evi') sigma goals - let shelve_nonclass info = + let fail_if_nonclass info = Proofview.Goal.enter { enter = fun gl -> let gl = Proofview.Goal.assume gl in let sigma = Sigma.to_evar_map (Proofview.Goal.sigma gl) in if is_class_type sigma (Proofview.Goal.concl gl) then Proofview.tclUNIT () else (if !typeclasses_debug > 1 then - Feedback.msg_debug (pr_depth info.search_depth ++ str": shelving non-class subgoal " ++ + Feedback.msg_debug (pr_depth info.search_depth ++ + str": failure due to non-class subgoal " ++ pr_ev sigma (Proofview.Goal.goal gl)); - Proofview.shelve) } + Proofview.tclZERO NotApplicableEx) } (** The general hint application tactic. tac1 + tac2 .... The choice of OR or ORELSE is determined @@ -1159,7 +1160,7 @@ module Search = struct if path_matches derivs [] then aux e tl else let filter = - if info.search_only_classes then shelve_nonclass info + if info.search_only_classes then fail_if_nonclass info else Proofview.tclUNIT () in ortac -- cgit v1.2.3 From 919545d39c77a9168e70141e78d2c9589dad7c4e Mon Sep 17 00:00:00 2001 From: Théo Zimmermann Date: Thu, 27 Oct 2016 14:14:50 +0200 Subject: Internal API change to typeclasses eauto. This commit makes the traversing strategy of typeclasses eauto an optional argument of the function that implements it. This change should be non-breaking. --- tactics/class_tactics.ml | 9 +++++++-- tactics/class_tactics.mli | 3 +++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index fe12b54a1..5d5511d78 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1288,11 +1288,16 @@ module Search = struct tclCASE (with_shelf tac) >>= casefn let eauto_tac ?(st=full_transparent_state) ?(unique=false) - ~only_classes ~depth ~dep hints = + ~only_classes ?dfs ~depth ~dep hints = let open Proofview in let tac = let search = search_tac ~st only_classes dep hints in - if get_typeclasses_iterative_deepening () then + let bfs = + match dfs with + | None -> get_typeclasses_iterative_deepening () + | Some v -> v + in + if bfs then match depth with | None -> fix_iterative search | Some l -> fix_iterative_limit l search diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli index 21c5d2172..1b2fa035b 100644 --- a/tactics/class_tactics.mli +++ b/tactics/class_tactics.mli @@ -44,6 +44,9 @@ module Search : sig (** Should we force a unique solution *) only_classes:bool -> (** Should non-class goals be shelved and resolved at the end *) + ?dfs:bool -> + (** Is a traversing-strategy specified? + If yes, true means dfs, false means bfs, i.e iterative deepening *) depth:Int.t option -> (** Bounded or unbounded search *) dep:bool -> -- cgit v1.2.3 From a4cecc13cde3239d6a86f98ba6bba0e4554306bd Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Thu, 3 Nov 2016 16:25:06 +0100 Subject: Rework search_strategy option handling --- ltac/g_class.ml4 | 17 +++++++------ tactics/class_tactics.ml | 64 ++++++++++++++++++++++++++--------------------- tactics/class_tactics.mli | 7 +++--- 3 files changed, 49 insertions(+), 39 deletions(-) diff --git a/ltac/g_class.ml4 b/ltac/g_class.ml4 index 1adf197d6..7e26b5d18 100644 --- a/ltac/g_class.ml4 +++ b/ltac/g_class.ml4 @@ -45,13 +45,14 @@ ARGUMENT EXTEND debug TYPED AS bool PRINTED BY pr_debug END let pr_search_strategy _prc _prlc _prt = function - | Dfs -> Pp.str "dfs" - | Bfs -> Pp.str "bfs" + | Some Dfs -> Pp.str "dfs" + | Some Bfs -> Pp.str "bfs" + | None -> Pp.mt () ARGUMENT EXTEND eauto_search_strategy PRINTED BY pr_search_strategy -| [ "bfs" ] -> [ Bfs ] -| [ "dfs" ] -> [ Dfs ] -| [ ] -> [ Dfs ] +| [ "(bfs)" ] -> [ Some Bfs ] +| [ "(dfs)" ] -> [ Some Dfs ] +| [ ] -> [ None ] END (* true = All transparent, false = Opaque if possible *) @@ -59,15 +60,17 @@ END VERNAC COMMAND EXTEND Typeclasses_Settings CLASSIFIED AS SIDEFF | [ "Typeclasses" "eauto" ":=" debug(d) eauto_search_strategy(s) int_opt(depth) ] -> [ set_typeclasses_debug d; - set_typeclasses_strategy s; + Option.iter set_typeclasses_strategy s; set_typeclasses_depth depth ] END (** Compatibility: typeclasses eauto has 8.5 and 8.6 modes *) TACTIC EXTEND typeclasses_eauto + | [ "typeclasses" "eauto" "bfs" int_or_var_opt(d) "with" ne_preident_list(l) ] -> + [ typeclasses_eauto ~strategy:Bfs ~depth:d l ] | [ "typeclasses" "eauto" int_or_var_opt(d) "with" ne_preident_list(l) ] -> - [ typeclasses_eauto d l ] + [ typeclasses_eauto ~depth:d l ] | [ "typeclasses" "eauto" int_or_var_opt(d) ] -> [ typeclasses_eauto ~only_classes:true ~depth:d [Hints.typeclasses_db] ] END diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 5d5511d78..63994bafe 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -914,19 +914,20 @@ module V85 = struct let eauto_tac hints = then_tac normevars_tac (or_tac (hints_tac hints) intro_tac) - let eauto_tac depth hints = - if get_typeclasses_iterative_deepening () then - match depth with - | None -> fix_iterative (eauto_tac hints) - | Some depth -> fix_iterative_limit depth (eauto_tac hints) - else - match depth with - | None -> fix (eauto_tac hints) - | Some depth -> fix_limit depth (eauto_tac hints) - - let real_eauto ?depth unique st hints p evd = + let eauto_tac strategy depth hints = + match strategy with + | Bfs -> + begin match depth with + | None -> fix_iterative (eauto_tac hints) + | Some depth -> fix_iterative_limit depth (eauto_tac hints) end + | Dfs -> + match depth with + | None -> fix (eauto_tac hints) + | Some depth -> fix_limit depth (eauto_tac hints) + + let real_eauto ?depth strategy unique st hints p evd = let res = - run_on_evars ~st ~unique p evd hints (eauto_tac depth hints) + run_on_evars ~st ~unique p evd hints (eauto_tac strategy depth hints) in match res with | None -> evd @@ -939,12 +940,18 @@ module V85 = struct let resolve_all_evars_once debug depth unique p evd = let db = searchtable_map typeclasses_db in - real_eauto ?depth unique (Hint_db.transparent_state db) [db] p evd - - let eauto85 ?(only_classes=true) ?st depth hints g = + let strategy = if get_typeclasses_iterative_deepening () then Bfs else Dfs in + real_eauto ?depth strategy unique (Hint_db.transparent_state db) [db] p evd + + let eauto85 ?(only_classes=true) ?st ?strategy depth hints g = + let strategy = + match strategy with + | None -> if get_typeclasses_iterative_deepening () then Bfs else Dfs + | Some s -> s + in let gl = { it = make_autogoal ~only_classes ?st (cut_of_hints hints) None g; sigma = project g; } in - match run_tac (eauto_tac depth hints) gl with + match run_tac (eauto_tac strategy depth hints) gl with | None -> raise Not_found | Some {it = goals; sigma = s; } -> {it = List.map fst goals; sigma = s;} @@ -1288,22 +1295,23 @@ module Search = struct tclCASE (with_shelf tac) >>= casefn let eauto_tac ?(st=full_transparent_state) ?(unique=false) - ~only_classes ?dfs ~depth ~dep hints = + ~only_classes ?strategy ~depth ~dep hints = let open Proofview in let tac = let search = search_tac ~st only_classes dep hints in - let bfs = - match dfs with - | None -> get_typeclasses_iterative_deepening () - | Some v -> v + let dfs = + match strategy with + | None -> not (get_typeclasses_iterative_deepening ()) + | Some Dfs -> true + | Some Bfs -> false in - if bfs then + if dfs then + let depth = match depth with None -> -1 | Some d -> d in + search depth + else match depth with | None -> fix_iterative search | Some l -> fix_iterative_limit l search - else - let depth = match depth with None -> -1 | Some d -> d in - search depth in let error (e, ie) = match e with @@ -1389,7 +1397,7 @@ end (** Binding to either V85 or Search implementations. *) let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) - ~depth dbs = + ?strategy ~depth dbs = let dbs = List.map_filter (fun db -> try Some (searchtable_map db) with e when CErrors.noncritical e -> None) @@ -1400,10 +1408,10 @@ let typeclasses_eauto ?(only_classes=false) ?(st=full_transparent_state) if get_typeclasses_legacy_resolution () then Proofview.V82.tactic (fun gl -> - try V85.eauto85 depth ~only_classes ~st dbs gl + try V85.eauto85 depth ~only_classes ~st ?strategy dbs gl with Not_found -> Refiner.tclFAIL 0 (str"Proof search failed") gl) - else Search.eauto_tac ~st ~only_classes ~depth ~dep:true dbs + else Search.eauto_tac ~st ~only_classes ?strategy ~depth ~dep:true dbs (** We compute dependencies via a union-find algorithm. Beware of the imperative effects on the partition structure, diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli index 1b2fa035b..76760db02 100644 --- a/tactics/class_tactics.mli +++ b/tactics/class_tactics.mli @@ -24,7 +24,7 @@ type search_strategy = Dfs | Bfs val set_typeclasses_strategy : search_strategy -> unit -val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> +val typeclasses_eauto : ?only_classes:bool -> ?st:transparent_state -> ?strategy:search_strategy -> depth:(Int.t option) -> Hints.hint_db_name list -> unit Proofview.tactic @@ -44,9 +44,8 @@ module Search : sig (** Should we force a unique solution *) only_classes:bool -> (** Should non-class goals be shelved and resolved at the end *) - ?dfs:bool -> - (** Is a traversing-strategy specified? - If yes, true means dfs, false means bfs, i.e iterative deepening *) + ?strategy:search_strategy -> + (** Is a traversing-strategy specified? *) depth:Int.t option -> (** Bounded or unbounded search *) dep:bool -> -- cgit v1.2.3 From dd558cc1a9b87d2b1dda5d1ff2baf9f02a32e519 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 3 Nov 2016 18:20:36 +0100 Subject: Remove an OCaml 4.02 construct. This was not detected by running coq-contribs, so it probably means that we are not testing with the right version of OCaml. --- lib/cWarnings.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 68664d1ab..1a1944d61 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -136,7 +136,7 @@ let uniquize_flags_rev flags = let visited = try let warnings = Hashtbl.find categories name in - CString.Set.union visited (CString.Set.of_list warnings) + List.fold_left (fun v w -> CString.Set.add w v) visited warnings with Not_found -> visited in -- cgit v1.2.3 From 962a5d3526290b83967a92ef1eb772894d10362b Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Tue, 27 Sep 2016 19:09:40 -0400 Subject: Silence option deprecation warnings in the compat file Some options are expected to be deprecated --- theories/Compat/Coq85.v | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v index 400753644..1bc6fee0c 100644 --- a/theories/Compat/Coq85.v +++ b/theories/Compat/Coq85.v @@ -12,6 +12,10 @@ are likely needed to make them behave like Coq 8.5. *) Require Export Coq.Compat.Coq86. +(** We use some deprecated options in this file, so we disable the + corresponding warning, to silence the build of this file. *) +Local Set Warnings "-deprecated-option". + (* In 8.5, "intros [|]", taken e.g. on a goal "A\/B->C", does not behave as "intros [H|H]" but leave instead hypotheses quantified in the goal, here producing subgoals A->C and B->C. *) -- cgit v1.2.3 From 5939d426ac785ec063e66a302f3692b645993c56 Mon Sep 17 00:00:00 2001 From: Cyprien Mangin Date: Wed, 28 Sep 2016 16:56:22 +0200 Subject: Add documentation for [Set Warnings] and the -w option. --- doc/refman/RefMan-com.tex | 6 ++++++ doc/refman/RefMan-oth.tex | 13 +++++++++++++ toplevel/usage.ml | 2 +- 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/doc/refman/RefMan-com.tex b/doc/refman/RefMan-com.tex index 6f8584988..c1e552a5d 100644 --- a/doc/refman/RefMan-com.tex +++ b/doc/refman/RefMan-com.tex @@ -199,6 +199,12 @@ The following command-line options are recognized by the commands {\tt available for {\tt coqc} only; it is the counterpart of {\tt -compile-verbose}. + \item[{\tt -w} (all|none|w$_1$,\ldots,w$_n$)]\ % + + Configure the display of warnings. This option expects {\tt all}, {\tt none} + or a comma-separated list of warning names or categories (see + Section~\ref{SetWarnings}). + %Mostly unused in the code %\item[{\tt -debug}]\ % % diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex index 919e7b5cd..3a9db5ead 100644 --- a/doc/refman/RefMan-oth.tex +++ b/doc/refman/RefMan-oth.tex @@ -914,6 +914,19 @@ This command turns off the normal displaying. \subsection[\tt Unset Silent.]{\tt Unset Silent.\optindex{Silent}} This command turns the normal display on. +\subsection[\tt Set Warnings (\nterm{all}|\nterm{none}|\nterm{w}$_1$,\ldots,% + \nterm{w}$_n$).]{{\tt Set Warnings (\nterm{all}|\nterm{none}|\nterm{w}$_1$,\ldots,% + \nterm{w}$_n$)}.\optindex{Warnings}} +\label{SetWarnings} +This command configures the display of warnings. It is experimental, and expects +\texttt{all}, \texttt{none} or a comma-separated list of warning names or +categories. Adding~\texttt{-} in front of a warning disables it, +adding~\texttt{+} makes it an error. It is possible to use the special categories +\texttt{all} and \texttt{default}, the latter containing the warnings enabled by +default. The flags are interpreted from left to right, so in case of an overlap, +the flags on the right have higher priority, meaning that \texttt{A,-A} is +equivalent to \texttt{-A}. + \subsection[\tt Set Search Output Name Only.]{\tt Set Search Output Name Only.\optindex{Search Output Name Only} \label{Search-Output-Name-Only} \index{Search Output Name Only mode}} diff --git a/toplevel/usage.ml b/toplevel/usage.ml index de41f7b19..2bde1dc46 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -62,7 +62,7 @@ let print_usage_channel co command = \n -list-tags print highlight color tags known by Coq and exit\ \n\ \n -quiet unset display of extra information (implies -w none)\ -\n -w (all|none) configure display of warnings\ +\n -w (all|none|w1,..,wn) configure display of warnings\ \n -color (yes|no|auto) configure color output\ \n\ \n -q skip loading of rcfile\ -- cgit v1.2.3 From 1d637f15de540c82289d6b3a16181a625a0d9cdf Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 4 Nov 2016 13:28:08 +0100 Subject: Fix #4837: ./configure -local makes coqdep issue many warnings We simply remove the warnings about paths mixing Win32 and Unix separators, since that situation does not seem problematic (c.f. discussion on the bug tracker). --- lib/minisys.ml | 8 -------- lib/system.ml | 1 - lib/system.mli | 5 ----- tools/coqdep_common.ml | 1 - 4 files changed, 15 deletions(-) diff --git a/lib/minisys.ml b/lib/minisys.ml index 25e4d79c4..f15021c65 100644 --- a/lib/minisys.ml +++ b/lib/minisys.ml @@ -46,14 +46,6 @@ let ok_dirname f = let exists_dir dir = try Sys.is_directory dir with Sys_error _ -> false -let check_unix_dir warn dir = - if (Sys.os_type = "Win32" || Sys.os_type = "Cygwin") && - (String.length dir > 2 && dir.[1] = ':' || - String.contains dir '\\' || - String.contains dir ';') - then warn ("assuming " ^ dir ^ - " to be a Unix path even if looking like a Win32 path.") - let apply_subdir f path name = (* we avoid all files and subdirs starting by '.' (e.g. .svn) *) (* as well as skipped files like CVS, ... *) diff --git a/lib/system.ml b/lib/system.ml index af9aa5c07..4b99de707 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -33,7 +33,6 @@ let all_subdirs ~unix_path:root = | _ -> () in process_directory f path in - check_unix_dir (fun s -> Feedback.msg_warning (str s)) root; if exists_dir root then traverse root [] else warn_cannot_open_dir root; List.rev !l diff --git a/lib/system.mli b/lib/system.mli index 4dbb3695d..214369095 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -20,11 +20,6 @@ val (//) : unix_path -> string -> unix_path val exists_dir : unix_path -> bool -(** [check_unix_dir warn path] calls [warn] with an appropriate - message if [path] looks does not look like a Unix path on Windows *) - -val check_unix_dir : (string -> unit) -> unix_path -> unit - (** [exclude_search_in_dirname path] excludes [path] when processing directories *) diff --git a/tools/coqdep_common.ml b/tools/coqdep_common.ml index cc63c13d7..0064aebda 100644 --- a/tools/coqdep_common.ml +++ b/tools/coqdep_common.ml @@ -526,7 +526,6 @@ let rec add_directory recur add_file phys_dir log_dir = | FileRegular f -> add_file phys_dir log_dir f in - check_unix_dir (fun s -> eprintf "*** Warning: %s\n" s) phys_dir; if exists_dir phys_dir then process_directory f phys_dir else -- cgit v1.2.3 From 6bb352a6743c7332b9715ac15e95c806a58d101c Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 4 Nov 2016 14:55:40 +0100 Subject: Fix refine in compatibility mode --- tactics/tactics.ml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/tactics/tactics.ml b/tactics/tactics.ml index d2e5d8525..548d2a81f 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -4973,9 +4973,15 @@ module New = struct open Locus let reduce_after_refine = + let onhyps = + (** We reduced everywhere in the hyps before 8.6 *) + if Flags.version_less_or_equal Flags.V8_5 then None + else Some [] + in reduce - (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true;rZeta=false;rDelta=false;rConst=[]}) - {onhyps=None; concl_occs=AllOccurrences } + (Lazy {rBeta=true;rMatch=true;rFix=true;rCofix=true; + rZeta=false;rDelta=false;rConst=[]}) + {onhyps; concl_occs=AllOccurrences } let refine ?unsafe c = Refine.refine ?unsafe c <*> -- cgit v1.2.3 From 22dfbff296cf03b6fab2bcec4eb5f9cf6ee8368c Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 4 Nov 2016 15:55:52 +0100 Subject: Fix #3441 Use pf_get_type_of to avoid blowup ... in pose proof of large proof terms --- proofs/tacmach.ml | 3 +++ proofs/tacmach.mli | 1 + tactics/tactics.ml | 2 +- test-suite/bugs/closed/3441.v | 23 +++++++++++++++++++++++ 4 files changed, 28 insertions(+), 1 deletion(-) create mode 100644 test-suite/bugs/closed/3441.v diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml index 2b129ad89..330594af5 100644 --- a/proofs/tacmach.ml +++ b/proofs/tacmach.ml @@ -171,6 +171,9 @@ module New = struct let pf_unsafe_type_of gl t = pf_apply unsafe_type_of gl t + let pf_get_type_of gl t = + pf_apply (Retyping.get_type_of ~lax:true) gl t + let pf_type_of gl t = pf_apply type_of gl t diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli index 727efcf6d..f79fa1d4b 100644 --- a/proofs/tacmach.mli +++ b/proofs/tacmach.mli @@ -109,6 +109,7 @@ module New : sig val pf_concl : ([ `NF ], 'r) Proofview.Goal.t -> types val pf_unsafe_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types + val pf_get_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types val pf_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> evar_map * Term.types val pf_conv_x : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.constr -> bool diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 548d2a81f..92cb8a11e 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -2714,7 +2714,7 @@ let forward b usetac ipat c = match usetac with | None -> Proofview.Goal.enter { enter = begin fun gl -> - let t = Tacmach.New.pf_unsafe_type_of gl c in + let t = Tacmach.New.pf_get_type_of gl c in let hd = head_ident c in Tacticals.New.tclTHENFIRST (assert_as true hd ipat t) (exact_no_check c) end } diff --git a/test-suite/bugs/closed/3441.v b/test-suite/bugs/closed/3441.v new file mode 100644 index 000000000..50d297807 --- /dev/null +++ b/test-suite/bugs/closed/3441.v @@ -0,0 +1,23 @@ +Axiom f : nat -> nat -> nat. +Fixpoint do_n (n : nat) (k : nat) := + match n with + | 0 => k + | S n' => do_n n' (f k k) + end. + +Notation big := (_ = _). +Axiom k : nat. +Goal True. +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose proof y as H. (* Finished transaction in 1.102 secs (1.084u,0.016s) (successful) *) +Timeout 1 let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + pose y as H; clearbody H. (* Finished transaction in 0.412 secs (0.412u,0.s) (successful) *) + +Timeout 1 Time let H := fresh "H" in + let x := constr:(let n := 17 in do_n n = do_n n) in + let y := (eval lazy in x) in + assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *) \ No newline at end of file -- cgit v1.2.3 From 94bdd90bacc4d4a92b79bbe0db532e523fbcbce8 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Fri, 4 Nov 2016 17:03:04 +0100 Subject: Test for #4966 ("auto" wrongly seen as "auto with *" when in position of ident). --- test-suite/bugs/closed/4966.v | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 test-suite/bugs/closed/4966.v diff --git a/test-suite/bugs/closed/4966.v b/test-suite/bugs/closed/4966.v new file mode 100644 index 000000000..bd93cdc85 --- /dev/null +++ b/test-suite/bugs/closed/4966.v @@ -0,0 +1,10 @@ +(* Interpretation of auto as an argument of an ltac function (i.e. as an ident) was wrongly "auto with *" *) + +Axiom proof_admitted : False. +Hint Extern 0 => case proof_admitted : unused. +Ltac do_tac tac := tac. + +Goal False. + Set Ltac Profiling. + Fail solve [ do_tac auto ]. +Abort. -- cgit v1.2.3 From dc4200a1c0e37a600537fd1809377a3137ce0cc3 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Fri, 4 Nov 2016 19:34:40 +0100 Subject: Quick fix of tactic parsing while Load-ing in coqide. Note that this is still broken when loading files containing C-zar scripts. --- toplevel/vernacentries.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index c03f183ff..ef530d590 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1906,6 +1906,10 @@ let vernac_check_guard () = exception End_of_input let vernac_load interp fname = + let interp x = + let proof_mode = Proof_global.get_default_proof_mode_name () in + Proof_global.activate_proof_mode proof_mode; + interp x in let parse_sentence = Flags.with_option Flags.we_are_parsing (fun po -> match Pcoq.Gram.entry_parse Pcoq.main_entry po with -- cgit v1.2.3 From d8baa76d86eaa691a5386669596a6004bb44bb7a Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 4 Nov 2016 18:00:18 +0100 Subject: More precise refine compatibility --- tactics/tactics.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 92cb8a11e..af52c5237 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -4975,7 +4975,8 @@ module New = struct let reduce_after_refine = let onhyps = (** We reduced everywhere in the hyps before 8.6 *) - if Flags.version_less_or_equal Flags.V8_5 then None + if Flags.version_compare !Flags.compat_version Flags.V8_5 == 0 + then None else Some [] in reduce -- cgit v1.2.3 From f558a0552b49b533c1c79ee3eb6d49015eeb6084 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 4 Nov 2016 16:10:31 +0100 Subject: Do not print dependent evars by default (expensive) The option can be turned on by the user though. --- printing/printer.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/printing/printer.ml b/printing/printer.ml index 608bca62a..04337f6be 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -529,7 +529,7 @@ let print_evar_constraints gl sigma = str" with candidates:" ++ fnl () ++ hov 0 ppcandidates else mt () -let should_print_dependent_evars = ref true +let should_print_dependent_evars = ref false let _ = let open Goptions in -- cgit v1.2.3 From 29ff821da57e35d37b41be34febb275306c4809f Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 5 Nov 2016 11:33:42 +0100 Subject: Minor fix in documentation --- doc/refman/RefMan-tac.tex | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index 656ae57b9..54393e46f 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -1278,7 +1278,7 @@ in the list of subgoals remaining to prove. In particular, \texttt{pose proof {\term} as {\ident}} behaves as \texttt{assert ({\ident} := {\term})} and \texttt{pose proof {\term} - as {\intropattern}\tacindex{pose proof}} is the same as applying + as {\intropattern}} is the same as applying the {\intropattern} to {\term}. \item \texttt{enough ({\ident} :\ {\form})}\tacindex{enough} -- cgit v1.2.3 From d6edca2f025574fd84ef7e37a178c42674ff5840 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sat, 5 Nov 2016 11:34:10 +0100 Subject: Credits for 8.6 --- doc/refman/RefMan-pre.tex | 129 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index cb2ab5dc2..c7a3c7415 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1087,6 +1087,135 @@ Paris, January 2015, revised December 2015,\\ Hugo Herbelin, Matthieu Sozeau and the {\Coq} development team\\ \end{flushright} +\section*{Credits: version 8.6 (Stronger, Better, Faster Rooster)} + +{\Coq} version 8.6 contains the result of refinements, stabilization of +8.5's features and cleanups of the internals of the system. Over the +year of (now time-based) development, about 450 bugs were resolved and +over 100 contributions integrated. The main user visible changes are: +\begin{itemize} +\item A new, state-of-the-art universe constraint checker that + can outperform the previous version by an order of magnitude, by + Jacques-Henri Jourdan. +\item In CoqIDE and other asynchronous interfaces, more fine-grained + asynchronous processing and error reporting by Enrico Tassi. +\item More access to the proof engine features from Ltac: goal + management primitives, range selectors and a {\tt typeclasses + eauto} engine handling multiple goals and multiple successes, by + Cyprien Mangin, Matthieu Sozeau and Arnaud Spiwack. +\item Tactic behavior uniformization and specification, generalization + of intro-patterns by Hugo Herbelin and others. +\item Update of the beautifier by Hugo Herbelin, useful for switching + between versions. +\item A brand new warning system allowing to control warnings, turn them + into errors or ignore them selectively by Maxime Dénès, Guillaume + Melquiond and others. +\item Irrefutable patterns in abstractions, by Daniel de Rauglaudre. +\item Integration of {\tt ssreflect}'s subterm selection algorithm by + Enrico Tassi. +\item Integration of {\tt LtacProf}, a profiler for {\tt Ltac} by Tobias + Tebbi, Jason Gross and Paul Steckler. +\end{itemize} + +{\Coq} 8.6 also comes with a bunch of smaller-scale changes and +improvements regarding the different components of the system. We shall +only list a few of them. + +The {\tt iota} reduction flag is now a shorthand for {\tt match}, {\tt + fix} and {\tt cofix} flags controlling the corresponding reduction +rules (by Hugo Herbelin and Maxime Dénès). + +Maxime Dénès maintained the native compilation machinery. + +Pierre-Marie Pédrot separated the Ltac code from general purpose +tactics, and generalized and rationalized the handling of generic +arguments, allowing to create new versions of Ltac more easily in the +future. + +Many tactics have now more uniform behavior w.r.t. intro-patterns thanks +to Hugo Herbelin who also improved the basic tactics here and there. + +In patterns and terms, {\tt @}, abbreviations and notations are now +interpreted the same way, by Hugo Herbelin. + +Name handling for universes has been improved by Pierre-Marie Pédrot and +Matthieu Sozeau. The minimization algorithm has been improved by +Matthieu Sozeau. + +The unifier has been improved by Hugo Herbelin and Matthieu Sozeau, +fixing some incompatibilities introduced in Coq 8.5. Unification +constraints can now be left floating around and be seen by the user +thanks to a new option. The {\tt Keyed Unification} mode has been +improved by Matthieu Sozeau. + +The typeclass resolution engine and associated proof-search tactic have +been reimplemented on top of the proof-engine monad, providing better +integration in tactics, and new options have been introduced to control +it, by Matthieu Sozeau with help from Théo Zimmermann. + +The efficiency of the whole system has been significantly improved +thanks to contributions from Pierre-Marie Pédrot, Maxime Dénès and +Matthieu Sozeau and performance issue tracking by Jason Gross and Paul +Steckler. + +Standard library improvements by Jason Gross, Sébastien Hinderer, Pierre +Letouzey and others. + +Emilio Jesús Gallego Arias contributed many cleanups and refactorings of +the pretty-printing and user interface communication components. + +Frédéric Besson maintained the micromega tactic. + +The OPAM repository for {\Coq} packages has been maintained by Guillaume +Claret, Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi and others. A +list of packages is now available at \url{https://coq.inria.fr/opam/www/}. + +Packaging tools were provided by Michael Soegtrop and Enrico Tassi +(Windows), Maxime Dénès and Matthieu Sozeau (MacOS X). Packages are now +regularly built on the continuous integration server. + +Matej Košík maintained and greatly improved the continuous integration +setup and the testing of {\Coq} contributions. He also contributed many +API improvement and code cleanups throughout the system. + +Many power users helped to improve the design of the new features via +the bug tracker, the pull request system, the {\Coq} development mailing +list or the coq-club mailing list. Special thanks to the users who +contributed patches and intensive brain-storming and code reviews, +starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan +Leivent, Xavier Leroy, Gregory Malecha, Clément Pit-Claudel, Gabriel +Sherer and Beta Ziliani. It would however be impossible to mention with +precision all the names of people who to some extent influenced the +development. + +Version 8.6 is the first release of {\Coq} developed on a time-based +development cycle. Its development spanned 10 months from the release of +{\Coq} 8.5 and was based on a public roadmap. To date, it contains more +external contributions than any previous {\Coq} system. Code reviews +were systematically done before integration of new features, with an +important focus given to compatibility and performance issues, resulting +in a much more robust release than previous ones. + +General maintenance during part or whole of this period has been done by +Pierre Boutillier, Pierre Courtieu, Maxime Dénès, Hugo Herbelin, Pierre +Letouzey, Guillaume Melquiond, Pierre-Marie Pédrot, Matthieu Sozeau, +Arnaud Spiwack, Enrico Tassi as well as Bruno Barras, Yves Bertot, +Frédéric Besson, Assia Mahboubi, Yann Régis-Gianas. The development +process was coordinated by Matthieu Sozeau with the help of Maxime +Dénès, who was also in charge of the release process. + +Coq Enhancement Proposals (CEPs for short) were introduced by Enrico +Tassi to provide more visibility and a discussion period on new +features, they are publicly available \url{https://github.com/coq/ceps}. + +Started during this period, an effort is led by Yves Bertot and Maxime +Dénès to put together a {\Coq} consortium. + +\begin{flushright} +Paris, November 2016,\\ +Matthieu Sozeau and the {\Coq} development team\\ +\end{flushright} + %new Makefile -- cgit v1.2.3 From 0ad6edc1d088385ffe90f1a4dd1bddc04cb31b07 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Sat, 5 Nov 2016 10:55:55 +0100 Subject: Removing obsolete parsing of strings à la v7 in comments. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This was for the translator and is not relevant for the beautifier. --- parsing/cLexer.ml4 | 24 +----------------------- 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4 index a0cf631ea..d570f015e 100644 --- a/parsing/cLexer.ml4 +++ b/parsing/cLexer.ml4 @@ -408,24 +408,6 @@ let comment_stop ep = comment_begin := None; between_commands := false -(* Does not unescape!!! *) -let rec comm_string loc bp = parser - | [< ''"' >] -> push_string "\""; loc - | [< ''\\'; loc = - (parser [< ' ('"' | '\\' as c) >] -> - let () = match c with - | '"' -> real_push_char c - | _ -> () - in - real_push_char c; loc - | [< >] -> real_push_char '\\'; loc); s >] - -> comm_string loc bp s - | [< _ = Stream.empty >] ep -> - let loc = set_loc_pos loc bp ep in - err loc Unterminated_string - | [< ''\n' as c; s >] ep -> real_push_char c; comm_string (bump_loc_line loc ep) bp s - | [< 'c; s >] -> real_push_char c; comm_string loc bp s - let rec comment loc bp = parser bp2 | [< ''('; loc = (parser @@ -437,11 +419,7 @@ let rec comment loc bp = parser bp2 | [< '')' >] -> push_string "*)"; loc | [< s >] -> real_push_char '*'; comment loc bp s >] -> loc | [< ''"'; s >] -> - let loc = - (* In beautify mode, the lexing differs between strings in comments and - regular strings (e.g. escaping). It seems wrong. *) - if !Flags.beautify then (push_string"\""; comm_string loc bp2 s) - else fst (string loc ~comm_level:(Some 0) bp2 0 s) + let loc = fst (string loc ~comm_level:(Some 0) bp2 0 s) in comment loc bp s | [< _ = Stream.empty >] ep -> -- cgit v1.2.3 From ed2ec9362c0c0010b9caaaba4dcc771878ee2b7c Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Sat, 5 Nov 2016 12:09:14 +0100 Subject: Removing a special treatment for empty lines in comments. This made the whole pp code complicated only for the purpose of the beautifier, while it is not clear when this was useful. Removing the code for simplicity, not excluding to later address beautifier issues when they show up. --- lib/pp.ml | 51 ++++++++++++--------------------------------------- 1 file changed, 12 insertions(+), 39 deletions(-) diff --git a/lib/pp.ml b/lib/pp.ml index 552049802..f3bb47539 100644 --- a/lib/pp.ml +++ b/lib/pp.ml @@ -243,32 +243,15 @@ let qstring s = str "\"" ++ str (escape_string s) ++ str "\"" let qs = qstring let quote s = h 0 (str "\"" ++ s ++ str "\"") -(* This flag tells if the last printed comment ends with a newline, to - avoid empty lines *) -let com_eol = ref false - -let com_brk ft = com_eol := false -let com_if ft f = - if !com_eol then (com_eol := false; Format.pp_force_newline ft ()) - else Lazy.force f - let rec pr_com ft s = let (s1,os) = try let n = String.index s '\n' in String.sub s 0 n, Some (String.sub s (n+1) (String.length s - n - 1)) with Not_found -> s,None in - com_if ft (Lazy.from_val()); -(* let s1 = - if String.length s1 <> 0 && s1.[0] = ' ' then - (Format.pp_print_space ft (); String.sub s1 1 (String.length s1 - 1)) - else s1 in*) Format.pp_print_as ft (utf8_length s1) s1; match os with - Some s2 -> - if Int.equal (String.length s2) 0 then (com_eol := true) - else - (Format.pp_force_newline ft (); pr_com ft s2) + Some s2 -> Format.pp_force_newline ft (); pr_com ft s2 | None -> () type tag_handler = Tag.t -> Format.tag @@ -287,33 +270,24 @@ let pp_dirs ?pp_tag ft = begin match tok with | Str_def s -> let n = utf8_length s in - com_if ft (Lazy.from_val()); Format.pp_print_as ft n s + Format.pp_print_as ft n s | Str_len (s, n) -> - com_if ft (Lazy.from_val()); Format.pp_print_as ft n s + Format.pp_print_as ft n s end | Ppcmd_box(bty,ss) -> (* Prevent evaluation of the stream! *) - com_if ft (Lazy.from_val()); pp_open_box bty ; if not (Format.over_max_boxes ()) then Glue.iter pp_cmd ss; Format.pp_close_box ft () - | Ppcmd_open_box bty -> com_if ft (Lazy.from_val()); pp_open_box bty + | Ppcmd_open_box bty -> pp_open_box bty | Ppcmd_close_box -> Format.pp_close_box ft () | Ppcmd_close_tbox -> Format.pp_close_tbox ft () - | Ppcmd_white_space n -> - com_if ft (Lazy.from_fun (fun()->Format.pp_print_break ft n 0)) - | Ppcmd_print_break(m,n) -> - com_if ft (Lazy.from_fun(fun()->Format.pp_print_break ft m n)) + | Ppcmd_white_space n -> Format.pp_print_break ft n 0 + | Ppcmd_print_break(m,n) -> Format.pp_print_break ft m n | Ppcmd_set_tab -> Format.pp_set_tab ft () - | Ppcmd_print_tbreak(m,n) -> - com_if ft (Lazy.from_fun(fun()->Format.pp_print_tbreak ft m n)) - | Ppcmd_force_newline -> - com_brk ft; Format.pp_force_newline ft () - | Ppcmd_print_if_broken -> - com_if ft (Lazy.from_fun(fun()->Format.pp_print_if_newline ft ())) - | Ppcmd_comment coms -> -(* Format.pp_open_hvbox ft 0;*) - List.iter (pr_com ft) coms(*; - Format.pp_close_box ft ()*) + | Ppcmd_print_tbreak(m,n) -> Format.pp_print_tbreak ft m n + | Ppcmd_force_newline -> Format.pp_force_newline ft () + | Ppcmd_print_if_broken -> Format.pp_print_if_newline ft () + | Ppcmd_comment coms -> List.iter (pr_com ft) coms | Ppcmd_open_tag tag -> begin match pp_tag with | None -> () @@ -327,13 +301,12 @@ let pp_dirs ?pp_tag ft = in let pp_dir = function | Ppdir_ppcmds cmdstream -> Glue.iter pp_cmd cmdstream - | Ppdir_print_newline -> - com_brk ft; Format.pp_print_newline ft () + | Ppdir_print_newline -> Format.pp_print_newline ft () | Ppdir_print_flush -> Format.pp_print_flush ft () in fun (dirstream : _ ppdirs) -> try - Glue.iter pp_dir dirstream; com_brk ft + Glue.iter pp_dir dirstream with reraise -> let reraise = Backtrace.add_backtrace reraise in let () = Format.pp_print_flush ft () in -- cgit v1.2.3 From d6a18782919367006ab1cee0a5577ed9b3028682 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Sat, 5 Nov 2016 12:02:43 +0100 Subject: Not using style tags when translating/beautifying a file. --- toplevel/vernac.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index de45090bf..bfdae85d5 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -143,7 +143,7 @@ let pr_new_syntax_in_context loc chan_beautify ocom = | None -> mt() in let after = comment (CLexer.extract_comments (snd loc)) in if !beautify_file then - Pp.msg_with ~pp_tag:Ppstyle.pp_tag !Pp_control.std_ft (hov 0 (before ++ com ++ after)) + Pp.msg_with !Pp_control.std_ft (hov 0 (before ++ com ++ after)) else Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com))); States.unfreeze fs; -- cgit v1.2.3 From 25fc9919c6d86fa8119b1f0c8e5ddba156055c9d Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sun, 6 Nov 2016 08:54:37 +0100 Subject: Fixes from Enrico's review --- doc/refman/RefMan-pre.tex | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index c7a3c7415..669ba11e8 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1113,8 +1113,8 @@ over 100 contributions integrated. The main user visible changes are: \item Irrefutable patterns in abstractions, by Daniel de Rauglaudre. \item Integration of {\tt ssreflect}'s subterm selection algorithm by Enrico Tassi. -\item Integration of {\tt LtacProf}, a profiler for {\tt Ltac} by Tobias - Tebbi, Jason Gross and Paul Steckler. +\item Integration of {\tt LtacProf}, a profiler for {\tt Ltac} by Jason + Gross, Paul Steckler, Enrico Tassi and Tobias Tebbi. \end{itemize} {\Coq} 8.6 also comes with a bunch of smaller-scale changes and @@ -1170,14 +1170,23 @@ The OPAM repository for {\Coq} packages has been maintained by Guillaume Claret, Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi and others. A list of packages is now available at \url{https://coq.inria.fr/opam/www/}. -Packaging tools were provided by Michael Soegtrop and Enrico Tassi -(Windows), Maxime Dénès and Matthieu Sozeau (MacOS X). Packages are now -regularly built on the continuous integration server. +Packaging tools and software development kits were prepared by Maxime +Dénès, Michael Soegtrop and Enrico Tassi for Windows, and Maxime Dénès +and Matthieu Sozeau for MacOS X. Packages are now regularly built on the +continuous integration server. Matej Košík maintained and greatly improved the continuous integration setup and the testing of {\Coq} contributions. He also contributed many API improvement and code cleanups throughout the system. +General maintenance during part or whole of this period has been done by +Pierre Boutillier, Pierre Courtieu, Maxime Dénès, Hugo Herbelin, Pierre +Letouzey, Guillaume Melquiond, Pierre-Marie Pédrot, Matthieu Sozeau, +Arnaud Spiwack, Enrico Tassi, Bruno Barras, Yves Bertot, +Frédéric Besson, Assia Mahboubi and Yann Régis-Gianas. The development +process was coordinated by Matthieu Sozeau with the help of Maxime +Dénès, who was also in charge of the release process. + Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the {\Coq} development mailing list or the coq-club mailing list. Special thanks to the users who @@ -1194,15 +1203,7 @@ development cycle. Its development spanned 10 months from the release of external contributions than any previous {\Coq} system. Code reviews were systematically done before integration of new features, with an important focus given to compatibility and performance issues, resulting -in a much more robust release than previous ones. - -General maintenance during part or whole of this period has been done by -Pierre Boutillier, Pierre Courtieu, Maxime Dénès, Hugo Herbelin, Pierre -Letouzey, Guillaume Melquiond, Pierre-Marie Pédrot, Matthieu Sozeau, -Arnaud Spiwack, Enrico Tassi as well as Bruno Barras, Yves Bertot, -Frédéric Besson, Assia Mahboubi, Yann Régis-Gianas. The development -process was coordinated by Matthieu Sozeau with the help of Maxime -Dénès, who was also in charge of the release process. +in a hopefully much more robust release than previous ones. Coq Enhancement Proposals (CEPs for short) were introduced by Enrico Tassi to provide more visibility and a discussion period on new -- cgit v1.2.3 From ceaafcde70e0ba536cae03baa740563aff47f6e8 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sun, 6 Nov 2016 11:22:31 +0100 Subject: Maxime's comments --- doc/refman/RefMan-pre.tex | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 669ba11e8..944cd4848 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1087,7 +1087,7 @@ Paris, January 2015, revised December 2015,\\ Hugo Herbelin, Matthieu Sozeau and the {\Coq} development team\\ \end{flushright} -\section*{Credits: version 8.6 (Stronger, Better, Faster Rooster)} +\section*{Credits: version 8.6} {\Coq} version 8.6 contains the result of refinements, stabilization of 8.5's features and cleanups of the internals of the system. Over the @@ -1098,7 +1098,8 @@ over 100 contributions integrated. The main user visible changes are: can outperform the previous version by an order of magnitude, by Jacques-Henri Jourdan. \item In CoqIDE and other asynchronous interfaces, more fine-grained - asynchronous processing and error reporting by Enrico Tassi. + asynchronous processing and error reporting by Enrico Tassi (ability + to jump to any error in the document). \item More access to the proof engine features from Ltac: goal management primitives, range selectors and a {\tt typeclasses eauto} engine handling multiple goals and multiple successes, by @@ -1170,22 +1171,25 @@ The OPAM repository for {\Coq} packages has been maintained by Guillaume Claret, Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi and others. A list of packages is now available at \url{https://coq.inria.fr/opam/www/}. -Packaging tools and software development kits were prepared by Maxime -Dénès, Michael Soegtrop and Enrico Tassi for Windows, and Maxime Dénès -and Matthieu Sozeau for MacOS X. Packages are now regularly built on the -continuous integration server. +Packaging tools and software development kits were prepared by Michael +Soegtrop with the help of Maxime Dénès and Enrico Tassi for Windows, and +Maxime Dénès and Matthieu Sozeau for MacOS X. Packages are now regularly +built on the continuous integration server. Matej Košík maintained and greatly improved the continuous integration setup and the testing of {\Coq} contributions. He also contributed many API improvement and code cleanups throughout the system. -General maintenance during part or whole of this period has been done by -Pierre Boutillier, Pierre Courtieu, Maxime Dénès, Hugo Herbelin, Pierre -Letouzey, Guillaume Melquiond, Pierre-Marie Pédrot, Matthieu Sozeau, -Arnaud Spiwack, Enrico Tassi, Bruno Barras, Yves Bertot, -Frédéric Besson, Assia Mahboubi and Yann Régis-Gianas. The development -process was coordinated by Matthieu Sozeau with the help of Maxime -Dénès, who was also in charge of the release process. +The contributors for this version are C.J. Bell, Yves Bertot, Frédéric +Besson, Tej Chajed, Pierre Courtieu, Maxime Dénès, Ricky Elrod, Jason +Gross, Hugo Herbelin, Emilio Jesus Gallego Arias, Jacques-Henri Jourdan, +Matej Košík, Xavier Leroy, Pierre Letouzey, Gregory Malecha, Cyprien +Mangin, Erik Martin-Dorel, Guillaume Melquiond, Pierre-Marie Pédrot, +Lionel Rieg, Gabriel Scherer, Matthieu Sozeau, Arnaud Spiwack, Paul +Steckler, Laurent Théry, Enrico Tassi, Nickolai Zeldovich, Théo +Zimmermann and Daniel de Rauglaudre. The development process was +coordinated by Hugo Herbelin and Matthieu Sozeau with the help of +Maxime Dénès, who was also in charge of the release process. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the {\Coq} development mailing @@ -1193,8 +1197,8 @@ list or the coq-club mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan Leivent, Xavier Leroy, Gregory Malecha, Clément Pit-Claudel, Gabriel -Sherer and Beta Ziliani. It would however be impossible to mention with -precision all the names of people who to some extent influenced the +Sherer and Beta Ziliani. It would however be impossible to mention +exhaustively the names of everybody who to some extent influenced the development. Version 8.6 is the first release of {\Coq} developed on a time-based @@ -1203,7 +1207,7 @@ development cycle. Its development spanned 10 months from the release of external contributions than any previous {\Coq} system. Code reviews were systematically done before integration of new features, with an important focus given to compatibility and performance issues, resulting -in a hopefully much more robust release than previous ones. +in a hopefully more robust release than {\Coq} 8.5. Coq Enhancement Proposals (CEPs for short) were introduced by Enrico Tassi to provide more visibility and a discussion period on new -- cgit v1.2.3 From bf8827788d1d8c0dc96b963d3c35985d8b3725c6 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Sun, 6 Nov 2016 11:48:06 +0100 Subject: Hugo's comments --- doc/refman/RefMan-pre.tex | 2 -- 1 file changed, 2 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 944cd4848..6ba2f850e 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1106,8 +1106,6 @@ over 100 contributions integrated. The main user visible changes are: Cyprien Mangin, Matthieu Sozeau and Arnaud Spiwack. \item Tactic behavior uniformization and specification, generalization of intro-patterns by Hugo Herbelin and others. -\item Update of the beautifier by Hugo Herbelin, useful for switching - between versions. \item A brand new warning system allowing to control warnings, turn them into errors or ignore them selectively by Maxime Dénès, Guillaume Melquiond and others. -- cgit v1.2.3 From e6edb3319c850cc7e30e5c31b0bfbf16c5c1a32c Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Mon, 7 Nov 2016 08:41:21 +0100 Subject: More explicit name for status of unification constraints. --- ltac/extratactics.ml4 | 4 ++-- ltac/g_auto.ml4 | 2 +- ltac/tacinterp.ml | 8 ++++---- pretyping/pretyping.ml | 10 +++++----- pretyping/pretyping.mli | 2 +- proofs/evar_refiner.ml | 2 +- proofs/pfedit.ml | 4 ++-- tactics/tactics.ml | 2 +- test-suite/bugs/closed/2310.v | 2 +- test-suite/bugs/closed/3647.v | 2 +- test-suite/bugs/closed/4416.v | 2 +- test-suite/bugs/closed/5149.v | 2 +- test-suite/output/unifconstraints.v | 2 +- theories/Compat/Coq85.v | 2 +- 14 files changed, 23 insertions(+), 23 deletions(-) diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index e6498e02b..2cca760c3 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -38,7 +38,7 @@ DECLARE PLUGIN "extratactics" let with_delayed_uconstr ist c tac = let flags = { Pretyping.use_typeclasses = false; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = Some Pfedit.solve_by_implicit_tactic; fail_evar = false; expand_evars = true @@ -342,7 +342,7 @@ END let constr_flags = { Pretyping.use_typeclasses = true; - Pretyping.use_unif_heuristics = true; + Pretyping.solve_unification_constraints = true; Pretyping.use_hook = Some Pfedit.solve_by_implicit_tactic; Pretyping.fail_evar = false; Pretyping.expand_evars = true } diff --git a/ltac/g_auto.ml4 b/ltac/g_auto.ml4 index 8bc2ffd65..22a2d7fc2 100644 --- a/ltac/g_auto.ml4 +++ b/ltac/g_auto.ml4 @@ -43,7 +43,7 @@ END let eval_uconstrs ist cs = let flags = { Pretyping.use_typeclasses = false; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = Some Pfedit.solve_by_implicit_tactic; fail_evar = false; expand_evars = true diff --git a/ltac/tacinterp.ml b/ltac/tacinterp.ml index 08e67a0c2..b9dcc4e18 100644 --- a/ltac/tacinterp.ml +++ b/ltac/tacinterp.ml @@ -646,7 +646,7 @@ let interp_gen kind ist allow_patvar flags env sigma (c,ce) = let constr_flags = { use_typeclasses = true; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = Some solve_by_implicit_tactic; fail_evar = true; expand_evars = true } @@ -661,21 +661,21 @@ let interp_type = interp_constr_gen IsType let open_constr_use_classes_flags = { use_typeclasses = true; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = Some solve_by_implicit_tactic; fail_evar = false; expand_evars = true } let open_constr_no_classes_flags = { use_typeclasses = false; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = Some solve_by_implicit_tactic; fail_evar = false; expand_evars = true } let pure_open_constr_flags = { use_typeclasses = false; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = None; fail_evar = false; expand_evars = false } diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 95d854323..4b6d10c64 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -243,7 +243,7 @@ type inference_hook = env -> evar_map -> evar -> evar_map * constr type inference_flags = { use_typeclasses : bool; - use_unif_heuristics : bool; + solve_unification_constraints : bool; use_hook : inference_hook option; fail_evar : bool; expand_evars : bool @@ -339,7 +339,7 @@ let solve_remaining_evars flags env current_sigma pending = if flags.use_typeclasses then apply_typeclasses env evdref frozen false; if Option.has_some flags.use_hook then apply_inference_hook (Option.get flags.use_hook env) evdref pending; - if flags.use_unif_heuristics then apply_heuristics env evdref false; + if flags.solve_unification_constraints then apply_heuristics env evdref false; if flags.fail_evar then check_evars_are_solved env !evdref frozen pending; !evdref @@ -1109,14 +1109,14 @@ let ise_pretype_gen flags env sigma lvar kind c = let default_inference_flags fail = { use_typeclasses = true; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = None; fail_evar = fail; expand_evars = true } let no_classes_no_fail_inference_flags = { use_typeclasses = false; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = None; fail_evar = false; expand_evars = true } @@ -1180,7 +1180,7 @@ let understand_ltac flags env sigma lvar kind c = let constr_flags = { use_typeclasses = true; - use_unif_heuristics = true; + solve_unification_constraints = true; use_hook = None; fail_evar = true; expand_evars = true } diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index eead48a54..0f3f7c3c9 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -51,7 +51,7 @@ type inference_hook = env -> evar_map -> evar -> evar_map * constr type inference_flags = { use_typeclasses : bool; - use_unif_heuristics : bool; + solve_unification_constraints : bool; use_hook : inference_hook option; fail_evar : bool; expand_evars : bool diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml index 5f0cc73d2..29cad0635 100644 --- a/proofs/evar_refiner.ml +++ b/proofs/evar_refiner.ml @@ -46,7 +46,7 @@ let w_refine (evk,evi) (ltac_var,rawc) sigma = let sigma',typed_c = let flags = { Pretyping.use_typeclasses = true; - Pretyping.use_unif_heuristics = true; + Pretyping.solve_unification_constraints = true; Pretyping.use_hook = None; Pretyping.fail_evar = false; Pretyping.expand_evars = true } in diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml index 9c71e107c..eddbf72a8 100644 --- a/proofs/pfedit.ml +++ b/proofs/pfedit.ml @@ -16,8 +16,8 @@ open Evd let use_unification_heuristics_ref = ref true let _ = Goptions.declare_bool_option { Goptions.optsync = true; Goptions.optdepr = false; - Goptions.optname = "Unification heuristics are applied at every ."; - Goptions.optkey = ["Use";"Unification";"Heuristics"]; + Goptions.optname = "Solve unification constraints at every \".\""; + Goptions.optkey = ["Solve";"Unification";"Constraints"]; Goptions.optread = (fun () -> !use_unification_heuristics_ref); Goptions.optwrite = (fun a -> use_unification_heuristics_ref:=a); } diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 893f33f1a..e8cf09415 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1141,7 +1141,7 @@ let run_delayed env sigma c = let tactic_infer_flags with_evar = { Pretyping.use_typeclasses = true; - Pretyping.use_unif_heuristics = true; + Pretyping.solve_unification_constraints = true; Pretyping.use_hook = Some solve_by_implicit_tactic; Pretyping.fail_evar = not with_evar; Pretyping.expand_evars = true } diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/2310.v index 9fddede7e..7fae32871 100644 --- a/test-suite/bugs/closed/2310.v +++ b/test-suite/bugs/closed/2310.v @@ -15,7 +15,7 @@ Definition replace a (y:Nest (prod a a)) : a = a -> Nest a. leave P as subgoal or choose itself one solution *) intros. Fail refine (Cons (cast H _ y)). - Unset Use Unification Heuristics. (* Keep the unification constraint around *) + Unset Solve Unification Constraints. (* Keep the unification constraint around *) refine (Cons (cast H _ y)). intros. refine (Nest (prod X X)). Qed. \ No newline at end of file diff --git a/test-suite/bugs/closed/3647.v b/test-suite/bugs/closed/3647.v index f2cd41203..f5a22bd50 100644 --- a/test-suite/bugs/closed/3647.v +++ b/test-suite/bugs/closed/3647.v @@ -651,4 +651,4 @@ Goal forall (ptest : program) (cond : Condition) (value : bool) Grab Existential Variables. subst_body; simpl. Fail refine (all_behead (projT2 _)). - Unset Use Unification Heuristics. refine (all_behead (projT2 _)). + Unset Solve Unification Constraints. refine (all_behead (projT2 _)). diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v index afe8c62ed..3189685ec 100644 --- a/test-suite/bugs/closed/4416.v +++ b/test-suite/bugs/closed/4416.v @@ -1,4 +1,4 @@ Goal exists x, x. -Unset Use Unification Heuristics. +Unset Solve Unification Constraints. unshelve refine (ex_intro _ _ _); match goal with _ => refine (_ _) end. (* Error: Incorrect number of goals (expected 2 tactics). *) \ No newline at end of file diff --git a/test-suite/bugs/closed/5149.v b/test-suite/bugs/closed/5149.v index 01b9d158f..684dba196 100644 --- a/test-suite/bugs/closed/5149.v +++ b/test-suite/bugs/closed/5149.v @@ -40,7 +40,7 @@ Proof. Fail solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption) ]. solve [eapply interpf_SmartVarVar; subst; eassumption]. Undo. - Unset Use Unification Heuristics. + Unset Solve Unification Constraints. (* User control of when constraints are solved *) solve [ unshelve (eapply interpf_SmartVarVar; subst; eassumption); solve_constraints ]. Qed. diff --git a/test-suite/output/unifconstraints.v b/test-suite/output/unifconstraints.v index c7fb82ada..b9413a4ac 100644 --- a/test-suite/output/unifconstraints.v +++ b/test-suite/output/unifconstraints.v @@ -1,5 +1,5 @@ (* Set Printing Existential Instances. *) -Unset Use Unification Heuristics. +Unset Solve Unification Constraints. Axiom veeryyyyyyyyyyyyloooooooooooooonggidentifier : nat. Goal True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v index ba58e2d88..c64413383 100644 --- a/theories/Compat/Coq85.v +++ b/theories/Compat/Coq85.v @@ -29,4 +29,4 @@ Global Set Typeclasses Limit Intros. Global Unset Typeclasses Filtered Unification. (** Allow silently letting unification constraints float after a "." *) -Global Unset Use Unification Heuristics. \ No newline at end of file +Global Unset Solve Unification Constraints. -- cgit v1.2.3 From 3308336f1a412cb2a218e3a70a171cb7ff88bfbe Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Sun, 6 Nov 2016 13:29:18 +0100 Subject: Fix #5182: "Arguments names must be distinct." is bogus and underinformative --- test-suite/output/Arguments_renaming.out | 10 ++++------ test-suite/output/Arguments_renaming.v | 2 +- toplevel/vernacentries.ml | 12 ++++++++---- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/test-suite/output/Arguments_renaming.out b/test-suite/output/Arguments_renaming.out index 9d90de47c..b084ad498 100644 --- a/test-suite/output/Arguments_renaming.out +++ b/test-suite/output/Arguments_renaming.out @@ -1,6 +1,5 @@ The command has indeed failed with message: -Error: To rename arguments the "rename" flag must be -specified. +Error: To rename arguments the "rename" flag must be specified. Argument A renamed to B. File "stdin", line 2, characters 0-25: Warning: This command is just asserting the names of arguments of identity. @@ -104,16 +103,15 @@ Expands to: Constant Top.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat The command has indeed failed with message: -Error: Arguments lists should agree on names they provide. +Error: Argument lists should agree on the names they provide. The command has indeed failed with message: Error: Sequences of implicit arguments must be of different lengths. The command has indeed failed with message: -Error: Arguments names must be distinct. +Error: Some argument names are duplicated: F The command has indeed failed with message: Error: Argument z cannot be declared implicit. The command has indeed failed with message: Error: Extra arguments: y. The command has indeed failed with message: -Error: To rename arguments the "rename" flag must be -specified. +Error: To rename arguments the "rename" flag must be specified. Argument A renamed to R. diff --git a/test-suite/output/Arguments_renaming.v b/test-suite/output/Arguments_renaming.v index 2d14c94ac..0cb331347 100644 --- a/test-suite/output/Arguments_renaming.v +++ b/test-suite/output/Arguments_renaming.v @@ -47,7 +47,7 @@ Check @myplus. Fail Arguments eq_refl {F g}, [H] k. Fail Arguments eq_refl {F}, [F] : rename. -Fail Arguments eq_refl {F F}, [F] F. +Fail Arguments eq_refl {F F}, [F] F : rename. Fail Arguments eq {F} x [z] : rename. Fail Arguments eq {F} x z y. Fail Arguments eq {R} s t. diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index ef530d590..851d7557a 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1082,7 +1082,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags | name1 :: names1, name2 :: names2 -> if Name.equal name1 name2 then name1 :: names_union names1 names2 - else error "Arguments lists should agree on names they provide." + else error "Argument lists should agree on the names they provide." in let initial = List.make num_args Anonymous in @@ -1107,9 +1107,6 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags let names = rename prev_names names in let renaming_specified = Option.has_some !example_renaming in - if not (List.distinct_f Name.compare (List.filter ((!=) Anonymous) names)) then - error "Arguments names must be distinct."; - if !rename_flag_required && not rename_flag then errorlabstrm "vernac_declare_arguments" (strbrk "To rename arguments the \"rename\" flag must be specified." @@ -1120,6 +1117,13 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags str "\nArgument " ++ pr_name o ++ str " renamed to " ++ pr_name n ++ str "."); + let duplicate_names = + List.duplicates Name.equal (List.filter ((!=) Anonymous) names) + in + if not (List.is_empty duplicate_names) then begin + let duplicates = prlist_with_sep pr_comma pr_name duplicate_names in + errorlabstrm "_" (strbrk "Some argument names are duplicated: " ++ duplicates) + end; (* Parts of this code are overly complicated because the implicit arguments API is completely crazy: positions (ExplByPos) are elaborated to -- cgit v1.2.3 From 75b49b14987ec9467ec5916609da8ce3136d3e11 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Sun, 6 Nov 2016 13:46:25 +0100 Subject: Fix #5181: [Arguments] no longer correctly checks the length of arguments lists --- test-suite/bugs/closed/5181.v | 3 +++ toplevel/vernacentries.ml | 3 +-- 2 files changed, 4 insertions(+), 2 deletions(-) create mode 100644 test-suite/bugs/closed/5181.v diff --git a/test-suite/bugs/closed/5181.v b/test-suite/bugs/closed/5181.v new file mode 100644 index 000000000..0e6d47197 --- /dev/null +++ b/test-suite/bugs/closed/5181.v @@ -0,0 +1,3 @@ +Definition foo (x y : nat) := x. +Fail Arguments foo {_} : assert. + diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 851d7557a..86b86e572 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1085,8 +1085,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags else error "Argument lists should agree on the names they provide." in - let initial = List.make num_args Anonymous in - let names = List.fold_left names_union initial names in + let names = List.fold_left names_union [] names in let rec rename prev_names names = match prev_names, names with -- cgit v1.2.3 From 207fcfd9355b01441f2a01614a7de017f4148cde Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Sun, 6 Nov 2016 14:26:01 +0100 Subject: Improve formatting of a message in [Arguments]. --- toplevel/vernacentries.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 86b86e572..8a28d979c 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1109,11 +1109,11 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags if !rename_flag_required && not rename_flag then errorlabstrm "vernac_declare_arguments" (strbrk "To rename arguments the \"rename\" flag must be specified." - ++ + ++ spc () ++ match !example_renaming with | None -> mt () | Some (o,n) -> - str "\nArgument " ++ pr_name o ++ + str "Argument " ++ pr_name o ++ str " renamed to " ++ pr_name n ++ str "."); let duplicate_names = -- cgit v1.2.3 From a96fed4624d8baaa4bec9bb63676eb1bcb389091 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 09:36:30 +0100 Subject: Hugo and Maxime's 2nd pass of comments --- doc/refman/RefMan-pre.tex | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 6ba2f850e..29ae51fea 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1108,7 +1108,7 @@ over 100 contributions integrated. The main user visible changes are: of intro-patterns by Hugo Herbelin and others. \item A brand new warning system allowing to control warnings, turn them into errors or ignore them selectively by Maxime Dénès, Guillaume - Melquiond and others. + Melquiond, Pierre-Marie Pédrot and others. \item Irrefutable patterns in abstractions, by Daniel de Rauglaudre. \item Integration of {\tt ssreflect}'s subterm selection algorithm by Enrico Tassi. @@ -1131,9 +1131,6 @@ tactics, and generalized and rationalized the handling of generic arguments, allowing to create new versions of Ltac more easily in the future. -Many tactics have now more uniform behavior w.r.t. intro-patterns thanks -to Hugo Herbelin who also improved the basic tactics here and there. - In patterns and terms, {\tt @}, abbreviations and notations are now interpreted the same way, by Hugo Herbelin. @@ -1179,15 +1176,16 @@ setup and the testing of {\Coq} contributions. He also contributed many API improvement and code cleanups throughout the system. The contributors for this version are C.J. Bell, Yves Bertot, Frédéric -Besson, Tej Chajed, Pierre Courtieu, Maxime Dénès, Ricky Elrod, Jason -Gross, Hugo Herbelin, Emilio Jesus Gallego Arias, Jacques-Henri Jourdan, -Matej Košík, Xavier Leroy, Pierre Letouzey, Gregory Malecha, Cyprien -Mangin, Erik Martin-Dorel, Guillaume Melquiond, Pierre-Marie Pédrot, -Lionel Rieg, Gabriel Scherer, Matthieu Sozeau, Arnaud Spiwack, Paul -Steckler, Laurent Théry, Enrico Tassi, Nickolai Zeldovich, Théo -Zimmermann and Daniel de Rauglaudre. The development process was -coordinated by Hugo Herbelin and Matthieu Sozeau with the help of -Maxime Dénès, who was also in charge of the release process. +Besson, Pierre Boutillier, Tej Chajed, Pierre Courtieu, Maxime Dénès, +Ricky Elrod, Jason Gross, Hugo Herbelin, Sébastien Hinderer, Emilio +Jesus Gallego Arias, Jacques-Henri Jourdan, Matej Košík, Xavier Leroy, +Pierre Letouzey, Gregory Malecha, Cyprien Mangin, Erik Martin-Dorel, +Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Daniel de +Rauglaudre, Lionel Rieg, Gabriel Scherer, Matthieu Sozeau, Arnaud +Spiwack, Paul Steckler, Laurent Théry, Enrico Tassi, Nickolai Zeldovich +and Théo Zimmermann. The development process was coordinated by Hugo +Herbelin and Matthieu Sozeau with the help of Maxime Dénès, who was also +in charge of the release process. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the {\Coq} development mailing @@ -1195,7 +1193,7 @@ list or the coq-club mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan Leivent, Xavier Leroy, Gregory Malecha, Clément Pit-Claudel, Gabriel -Sherer and Beta Ziliani. It would however be impossible to mention +Scherer and Beta Ziliani. It would however be impossible to mention exhaustively the names of everybody who to some extent influenced the development. -- cgit v1.2.3 From 1692b9e8245fbf485c40c9b6dd311f124978e987 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 13:49:57 +0100 Subject: More accurate contributor list. Command used: git log v8.5..HEAD --pretty=format:"%an," | sort -k 2 | uniq with some manual postprocessing for login names, particles and multiple first names. --- doc/refman/RefMan-pre.tex | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 29ae51fea..4578bee12 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1175,24 +1175,25 @@ Matej Košík maintained and greatly improved the continuous integration setup and the testing of {\Coq} contributions. He also contributed many API improvement and code cleanups throughout the system. -The contributors for this version are C.J. Bell, Yves Bertot, Frédéric -Besson, Pierre Boutillier, Tej Chajed, Pierre Courtieu, Maxime Dénès, -Ricky Elrod, Jason Gross, Hugo Herbelin, Sébastien Hinderer, Emilio -Jesus Gallego Arias, Jacques-Henri Jourdan, Matej Košík, Xavier Leroy, +The contributors for this version are Bruno Barras, C.J. Bell, Yves +Bertot, Frédéric Besson, Pierre Boutillier, Tej Chajed, Guillaume +Claret, Xavier Clerc, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, +Ricky Elrod, Emilio Jesus Gallego Arias, Jason Gross, Hugo Herbelin, +Sébastien Hinderer, Jacques-Henri Jourdan, Matej Kosik, Xavier Leroy, Pierre Letouzey, Gregory Malecha, Cyprien Mangin, Erik Martin-Dorel, -Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Daniel de -Rauglaudre, Lionel Rieg, Gabriel Scherer, Matthieu Sozeau, Arnaud -Spiwack, Paul Steckler, Laurent Théry, Enrico Tassi, Nickolai Zeldovich -and Théo Zimmermann. The development process was coordinated by Hugo -Herbelin and Matthieu Sozeau with the help of Maxime Dénès, who was also -in charge of the release process. +Guillaume Melquiond, Clément Pit--Claudel, Pierre-Marie Pédrot, Daniel +de Rauglaudre, Lionel Rieg, Gabriel Scherer, Thomas Sibut-Pinote, +Matthieu Sozeau, Arnaud Spiwack, Paul Steckler, Enrico Tassi, Laurent +Théry, Nickolai Zeldovich and Théo Zimmermann. The development process +was coordinated by Hugo Herbelin and Matthieu Sozeau with the help of +Maxime Dénès, who was also in charge of the release process. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the {\Coq} development mailing list or the coq-club mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan -Leivent, Xavier Leroy, Gregory Malecha, Clément Pit-Claudel, Gabriel +Leivent, Xavier Leroy, Gregory Malecha, Clément Pit--Claudel, Gabriel Scherer and Beta Ziliani. It would however be impossible to mention exhaustively the names of everybody who to some extent influenced the development. -- cgit v1.2.3 From 1f36cdefd841526f804bd2dd51c1d88309333376 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 14:47:15 +0100 Subject: Fixes to compile with ocaml 4.01 --- engine/termops.ml | 2 +- ltac/extratactics.ml4 | 2 +- tactics/hints.ml | 4 +++- toplevel/classes.ml | 6 ++++-- 4 files changed, 9 insertions(+), 5 deletions(-) diff --git a/engine/termops.ml b/engine/termops.ml index 35cacc65b..697b9a5f1 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -980,7 +980,7 @@ let smash_rel_context sign = let fold_named_context_both_sides f l ~init = List.fold_right_and_left f l init let mem_named_context_val id ctxt = - try Environ.lookup_named_val id ctxt; true with Not_found -> false + try ignore(Environ.lookup_named_val id ctxt); true with Not_found -> false let compact_named_context_reverse sign = let compact l decl = diff --git a/ltac/extratactics.ml4 b/ltac/extratactics.ml4 index d9780dcc8..8ae95c315 100644 --- a/ltac/extratactics.ml4 +++ b/ltac/extratactics.ml4 @@ -316,7 +316,7 @@ let project_hint pri l2r r = in let ctx = Evd.universe_context_set sigma in let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in - let info = Vernacexpr.({hint_priority = pri; hint_pattern = None}) in + let info = {Vernacexpr.hint_priority = pri; hint_pattern = None} in (info,false,true,Hints.PathAny, Hints.IsGlobRef (Globnames.ConstRef c)) let add_hints_iff l2r lc n bl = diff --git a/tactics/hints.ml b/tactics/hints.ml index 9cbfe20d9..53573bc7e 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -84,7 +84,9 @@ let secvars_of_hyps hyps = if all then Id.Pred.full (* If the whole section context is available *) else pred -let empty_hint_info = Vernacexpr.{ hint_priority = None; hint_pattern = None } +let empty_hint_info = + let open Vernacexpr in + { hint_priority = None; hint_pattern = None } (************************************************************************) (* The Type of Constructions Autotactic Hints *) diff --git a/toplevel/classes.ml b/toplevel/classes.ml index 1f13ab637..1528cbb2f 100644 --- a/toplevel/classes.ml +++ b/toplevel/classes.ml @@ -51,9 +51,11 @@ let _ = | IsGlobal gr -> Hints.IsGlobRef gr in let info = - Vernacexpr.{ info with hint_pattern = + let open Vernacexpr in + { info with hint_pattern = Option.map - (Constrintern.intern_constr_pattern (Global.env())) info.hint_pattern } in + (Constrintern.intern_constr_pattern (Global.env())) + info.hint_pattern } in Flags.silently (fun () -> Hints.add_hints local [typeclasses_db] (Hints.HintsResolveEntry -- cgit v1.2.3 From 25a60b1fcfa2f6017bedd986b1f90fe923d0f3ad Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 14:50:56 +0100 Subject: Document two new variants of refine They allow to call refine without doing typeclass resolution, allowing to use refine in typeclass hints. --- doc/refman/RefMan-tac.tex | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index 0aa179d62..695b0b883 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -263,6 +263,16 @@ Defined. This tactic behaves like {\tt refine}, but it does not shelve any subgoal. It does not perform any beta-reduction either. +\item {\tt notypeclasses refine \term}\tacindex{notypeclasses refine} + + This tactic behaves like {\tt refine} except it performs typechecking + without resolution of typeclasses. + +\item {\tt simple notypeclasses refine \term}\tacindex{simple + notypeclasses refine} + + This tactic behaves like {\tt simple refine} except it performs typechecking + without resolution of typeclasses. \end{Variants} \subsection{\tt apply \term} -- cgit v1.2.3 From d03e27800ec51538701b606fb7be196e4693780a Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 15:14:44 +0100 Subject: CHANGES for this branch. --- CHANGES | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/CHANGES b/CHANGES index 1b74e783d..7f171ebc4 100644 --- a/CHANGES +++ b/CHANGES @@ -82,6 +82,16 @@ Hints - Hint Mode now accepts "!" which means that the mode matches only if the argument's head is not an evar (it goes under applications, casts, and scrutinees of matches and projections). +- Hints can now take an optional user-given pattern, used only by + [typeclasses eauto] with the [Filtered Unification] option on. + +Typeclasses + +- Many new options and new engine based on the proof monad. The + [typeclasses eauto] tactic is now a multi-goal, multi-success tactic. + See reference manual for more information. It is planned to + replace auto and eauto in the following version. The 8.5 resolution + engine is still available to help solve compatibility issues. Program -- cgit v1.2.3 From d7cb0e2115ec37eddeeecbb1f2dbdeb7e49aeb7a Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 15:16:46 +0100 Subject: Mention notypeclasses refine in CHANGES --- CHANGES | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGES b/CHANGES index 7f171ebc4..4a70584da 100644 --- a/CHANGES +++ b/CHANGES @@ -75,7 +75,10 @@ Tactics - Option "Injection On Proofs" was renamed "Keep Proof Equalities". When enabled, injection and inversion do not drop equalities between objects in Prop. Still disabled by default. - +- New tactics "notypeclasses refine" and "simple notypeclasses refine" that + disallow typeclass resolution when typechecking their argument, for use + in typeclass hints. + Hints - Revised the syntax of [Hint Cut] to follow standard notation for regexps. -- cgit v1.2.3 From 3bc8d841148da0cf1db5b9b896f28c3285d4f5db Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Mon, 7 Nov 2016 17:31:48 +0100 Subject: After Emilio's comment. --- doc/refman/RefMan-pre.tex | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 4578bee12..8f75353bb 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1169,7 +1169,9 @@ list of packages is now available at \url{https://coq.inria.fr/opam/www/}. Packaging tools and software development kits were prepared by Michael Soegtrop with the help of Maxime Dénès and Enrico Tassi for Windows, and Maxime Dénès and Matthieu Sozeau for MacOS X. Packages are now regularly -built on the continuous integration server. +built on the continuous integration server. {\Coq} now comes with a {\tt + META} file usable with {\tt ocamlfind}, contributed by Emilio Jesús +Gallego Arias, Gregory Malecha, and Matthieu Sozeau. Matej Košík maintained and greatly improved the continuous integration setup and the testing of {\Coq} contributions. He also contributed many @@ -1178,7 +1180,7 @@ API improvement and code cleanups throughout the system. The contributors for this version are Bruno Barras, C.J. Bell, Yves Bertot, Frédéric Besson, Pierre Boutillier, Tej Chajed, Guillaume Claret, Xavier Clerc, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, -Ricky Elrod, Emilio Jesus Gallego Arias, Jason Gross, Hugo Herbelin, +Ricky Elrod, Emilio Jesús Gallego Arias, Jason Gross, Hugo Herbelin, Sébastien Hinderer, Jacques-Henri Jourdan, Matej Kosik, Xavier Leroy, Pierre Letouzey, Gregory Malecha, Cyprien Mangin, Erik Martin-Dorel, Guillaume Melquiond, Clément Pit--Claudel, Pierre-Marie Pédrot, Daniel -- cgit v1.2.3 From cadb9e6614a1e72bf18f80acf0aabaeed4e9f057 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Tue, 8 Nov 2016 09:00:13 +0100 Subject: Rewording from Enrico --- doc/refman/RefMan-pre.tex | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 8f75353bb..4f4f40442 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1098,8 +1098,9 @@ over 100 contributions integrated. The main user visible changes are: can outperform the previous version by an order of magnitude, by Jacques-Henri Jourdan. \item In CoqIDE and other asynchronous interfaces, more fine-grained - asynchronous processing and error reporting by Enrico Tassi (ability - to jump to any error in the document). + asynchronous processing and error reporting by Enrico Tassi. In + asynchronous mode {\Coq} is now capable of recovering from errors + and continue processing the document. \item More access to the proof engine features from Ltac: goal management primitives, range selectors and a {\tt typeclasses eauto} engine handling multiple goals and multiple successes, by -- cgit v1.2.3 From c60d155c2213461b8e4392b729445486086302d9 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 8 Nov 2016 09:36:42 +0100 Subject: Update documentation of Arguments after recent changes. --- doc/refman/RefMan-ext.tex | 12 ++++++------ doc/refman/RefMan-syn.tex | 14 +++++++------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex index 51e881bff..b475a5233 100644 --- a/doc/refman/RefMan-ext.tex +++ b/doc/refman/RefMan-ext.tex @@ -1315,10 +1315,10 @@ command: \begin{quote} \tt Arguments {\qualid} \nelist{\possiblybracketedident}{} \end{quote} -where the list of {\possiblybracketedident} is the list of all arguments of -{\qualid} where the ones to be declared implicit are surrounded by -square brackets and the ones to be declared as maximally inserted implicits -are surrounded by curly braces. +where the list of {\possiblybracketedident} is a prefix of the list of arguments +of {\qualid} where the ones to be declared implicit are surrounded by square +brackets and the ones to be declared as maximally inserted implicits are +surrounded by curly braces. After the above declaration is issued, implicit arguments can just (and have to) be skipped in any expression involving an application of @@ -1591,7 +1591,7 @@ Implicit arguments names can be redefined using the following syntax: {\tt Arguments {\qualid} \nelist{\name}{} : rename} \end{quote} -Without the {\tt rename} flag, {\tt Arguments} can be used to assert +With the {\tt assert} flag, {\tt Arguments} can be used to assert that a given object has the expected number of arguments and that these arguments are named as expected. @@ -1600,7 +1600,7 @@ these arguments are named as expected. Arguments p [s t] _ [u] _: rename. Check (p r1 (u:=c)). Check (p (s:=a) (t:=b) r1 (u:=c) r2). -Fail Arguments p [s t] _ [w] _. +Fail Arguments p [s t] _ [w] _ : assert. \end{coq_example} diff --git a/doc/refman/RefMan-syn.tex b/doc/refman/RefMan-syn.tex index 92107b750..1fcc1c0df 100644 --- a/doc/refman/RefMan-syn.tex +++ b/doc/refman/RefMan-syn.tex @@ -811,13 +811,13 @@ constant have to be interpreted in a given scope. The command is \begin{quote} {\tt Arguments} {\qualid} \nelist{\name {\tt \%}\scope}{} \end{quote} -where the list is the list of the arguments of {\qualid} eventually -annotated with their {\scope}. Grouping round parentheses can -be used to decorate multiple arguments with the same scope. -{\scope} can be either a scope name or its delimiting key. For example -the following command puts the first two arguments of {\tt plus\_fct} -in the scope delimited by the key {\tt F} ({\tt Rfun\_scope}) and the -last argument in the scope delimited by the key {\tt R} ({\tt R\_scope}). +where the list is a prefix of the list of the arguments of {\qualid} eventually +annotated with their {\scope}. Grouping round parentheses can be used to +decorate multiple arguments with the same scope. {\scope} can be either a scope +name or its delimiting key. For example the following command puts the first two +arguments of {\tt plus\_fct} in the scope delimited by the key {\tt F} ({\tt + Rfun\_scope}) and the last argument in the scope delimited by the key {\tt R} +({\tt R\_scope}). \begin{coq_example*} Arguments plus_fct (f1 f2)%F x%R. -- cgit v1.2.3 From b385fbbbb7868f0994d5ec00cb918cea1e8f18cf Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Fri, 4 Nov 2016 15:55:52 +0100 Subject: Use pf_get_type_of to avoid blowup in pose proof of large proof terms --- proofs/tacmach.mli | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli index f79fa1d4b..59f296f64 100644 --- a/proofs/tacmach.mli +++ b/proofs/tacmach.mli @@ -108,8 +108,16 @@ module New : sig val pf_env : ('a, 'r) Proofview.Goal.t -> Environ.env val pf_concl : ([ `NF ], 'r) Proofview.Goal.t -> types + (** WRONG: To be avoided at all costs, it typechecks the term entirely but + forgets the universe constraints necessary to retypecheck it *) val pf_unsafe_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types + + (** This function does no type inference and expects an already well-typed term. + It recomputes its type in the fastest way possible (no conversion is ever involved) *) val pf_get_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.types + + (** This function entirely type-checks the term and computes its type + and the implied universe constraints. *) val pf_type_of : ('a, 'r) Proofview.Goal.t -> Term.constr -> evar_map * Term.types val pf_conv_x : ('a, 'r) Proofview.Goal.t -> Term.constr -> Term.constr -> bool -- cgit v1.2.3 From a279547e2d4e6cad75c266e4a9e436b524f5df99 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Thu, 10 Nov 2016 11:45:59 +0100 Subject: Updating a comment in test-suite. --- test-suite/output/PatternsInBinders.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test-suite/output/PatternsInBinders.v b/test-suite/output/PatternsInBinders.v index fff86d6fa..6fa357a90 100644 --- a/test-suite/output/PatternsInBinders.v +++ b/test-suite/output/PatternsInBinders.v @@ -58,7 +58,7 @@ Definition F '(n,p) : Type := (Fin n * Fin p)%type. Definition both_z '(n,p) : F (n,p) := (Z _,Z _). Print both_z. -(** These tests show examples which do not factorize binders *) +(** Test factorization of binders *) Check fun '((x,y) : A*B) '(z,t) => swap (x,y) = (z,t). Check forall '(x,y) '((z,t) : B*A), swap (x,y) = (z,t). -- cgit v1.2.3 From 034db0eae27c427a09092c337874c713474f50cb Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 9 Nov 2016 14:15:12 +0100 Subject: Update CHANGES and credits for 8.6beta1. --- CHANGES | 155 ++++++++++++++++++++++++++++++++++++++++------ doc/refman/RefMan-pre.tex | 13 ++-- 2 files changed, 143 insertions(+), 25 deletions(-) diff --git a/CHANGES b/CHANGES index 4a70584da..5f4b36151 100644 --- a/CHANGES +++ b/CHANGES @@ -1,22 +1,9 @@ Changes from V8.5 to V8.6beta1 ============================== -Bugfixes +Kernel -- #4527: when typechecking the statement of a lemma using universe polymorphic - definitions with explicit universe binders, check that the type can indeed be - typechecked using only those universes (after minimization of the other, - flexible universes), or raise an error (fixed scripts can be made forward - compatible). -- #4726: treat user-provided sorts of universe polymorphic records as rigid - (i.e. non-minimizable). -- #4592, #4932: notations sharing recursive patterns or sharing - binders made more robust. -- #4780: Induction with universe polymorphism on was creating ill-typed terms. -- #3070: fixing "subst" in the presence of a chain of dependencies. -- When used as an argument of an ltac function, "auto" without "with" - nor "using" clause now correctly uses only the core hint database by - default. +- A new, faster state-of-the-art universe constraint checker. Specification language @@ -60,9 +47,9 @@ Tactics given a free identifier, it is not bound in subsequent tactics anymore. In order to introduce a binding, use e.g. the "fresh" primitive instead (potential source of incompatibilities). -- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac (DOC TODO). -- New goal selectors. Sets of goals can be selected by select by listing - integers ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. +- New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac. +- New goal selectors. Sets of goals can be selected by listing integers + ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. - For uniformity with "destruct"/"induction" and for a more natural behavior, "injection" can now work in place by activating option "Structural Injection". In this case, hypotheses are also put in the @@ -78,6 +65,11 @@ Tactics - New tactics "notypeclasses refine" and "simple notypeclasses refine" that disallow typeclass resolution when typechecking their argument, for use in typeclass hints. +- Integration of LtacProf, a profiler for Ltac. +- Reduction tactics now accept more fine-grained flags: iota is now a shorthand + for the new flags match, fix and cofix. +- The ssreflect subterm selection algorithm is now accessible to tactic writers + through the ssrmatching plugin. Hints @@ -108,6 +100,13 @@ Notations - "Bind Scope" can once again bind "Funclass" and "Sortclass". +General infrastructure +- New configurable warning system which can be controlled with the vernacular + command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In + particular, the default is now that warnings are printed by coqc. +- In asynchronous mode, Coq is now capable of recovering from errors and + continue processing the document. + Tools - coqc accepts a -o option to specify the output file name @@ -120,6 +119,126 @@ Tools Verbose Compat vernacular, since these warnings can now be silenced or turned into errors using "-w". +Bugfixes + +- #2498: Coqide navigation preferences delayed effect +- #3035: Avoiding trailing arguments in the Arguments command +- #3070: fixing "subst" in the presence of a chain of dependencies. +- #3317: spurious type error with primitive projections. +- #3441: Use pf_get_type_of to avoid blowup +- #3450: [End foo.] is slower in trunk in some cases. +- #3683: add references to the web site for the bug tracker +- #3753: anomaly with implicit arguments and renamings +- #3849: hyp_list passing isn't transitive +- #3920: eapply masks an hypothesis name. +- #3957: ML Tactic Extension failure +- #4058: STM: if_verbose on "Checking task ..." +- #4095: constr forces typeclass resolution that it did not previously force +- #4368: CoqIDE: Errors are sticky +- #4421: Messages dialog in Coqide resets. +- #4437: CoqIDE doesn't preserve unix encoding under windows +- #4464: "Anomaly: variable H' unbound. Please report.". +- #4471: [generalize dependent] permits ill-typed terms in trunk. +- #4479: "Error: Rewriting base foo does not exist." should be catchable. +- #4527: when typechecking the statement of a lemma using universe polymorphic + definitions with explicit universe binders, check that the type can indeed be + typechecked using only those universes (after minimization of the other, + flexible universes), or raise an error (fixed scripts can be made forward + compatible). +- #4553: CoqIDE gives warnings about deprecated GTK features. +- #4592, #4932: notations sharing recursive patterns or sharing +- #4592, #4932: notations sharing recursive patterns or sharing + binders made more robust. +- #4595: making notations containing "ltac:" unused for printing. +- #4609: document an option governing the generation of equalities +- #4610: Fails to build with camlp4 since the TACTIC EXTEND move. +- #4622: [injection] on an equality between records with primitive projections + generates a match with invalid information +- #4661: Cannot mask the absolute name. +- #4679: weakened setoid_rewrite unification +- #4723: "Obligations: Cannot infer this placeholder of type" +- #4724: get_host_port error message +- #4726: treat user-provided sorts of universe polymorphic records as rigid + (i.e. non-minimizable). +- #4750: Change format of inconsistent assumptions message. +- #4756: STM: nested Abort is like nested Qed +- #4763, #4955: regressions in unification +- #4764: Syntactic notation externalization breaks. +- #4768: CoqIDE much slower than coqc -quick +- #4780: Induction with universe polymorphism on was creating ill-typed terms. +- #4784: [Set Printing Width] to >= 114 causes (some?) syntax errors to print in + the wrong location, confusing emacs mode +- #4785: use [ ] for vector nil +- #4787: Unset Bracketing Last Introduction Pattern not working. +- #4793: Coq 8.6 should accept -compat 8.6 +- #4798: compat notations should not modify the parser. +- #4816: Global universes and constraints should not depend on local ones +- #4825: [clear] should not dependency-check hypotheses that come above it. +- #4828: "make" broken on Widows +- #4836: Anomaly: Uncaught exception Invalid_argument. +- #4842: Time prints in multiple lines +- #4854: Notations with binders +- #4864: Argument : assert does fail if no arg is given +- #4865: deciding on which arguments to recompute scopes was not robust. +- #4869, allow Prop, Set, and level names in constraints. +- #4873: transparency option not used. +- #4893: not_evar: unexpected failure. +- #4904: [Import] does not load intermediately unqualified names of aliases. +- #4906: regression in printing an error message. +- #4914: LtacProf printout has too many newlines. +- #4919: Warning: Unused local entry "move_location" +- #4923: Warning: appcontext is deprecated. +- #4924: CoqIDE should have an option to use Unix-style newlines on Windows +- #4932: anomaly when using binders as terms in recursive notations. +- #4939: LtacProf prints tactic notations weirdly. +- #4940: Tactic notation printing could be more informative. +- #4941: ~/.coqrc file confusing locations +- #4958: [debug auto] should specify hint databases. +- #4964: Severe inefficiency with evars +- #4968: STM: sideff: report safe_id correctly +- #4978: priorities of Equivalence instances +- #5003: more careful generalisation of dependent terms. +- #5005: micromega tactics is now robust to failure of 'abstract'. +- #5011: Anomaly on [Existing Class]. +- #5023: JSON extraction doesn't generate "for xxx". +- #5029: anomaly on user-inputted projection name. +- #5036: autorewrite, sections and universes +- #5045: [generalize] creates ill-typed terms in 8.6. +- #5048: Casts in pattern raise an anomaly in Constrintern. +- #5051: Large outputs are garbled. +- #5061: Warnings flag has no discernible value +- #5066: Anomaly: cannot find Coq.Logic.JMeq.JMeq. +- #5069: Scheme Equality gives anomalies in sections. +- #5073: regression of micromega plugin +- #5078: wrong detection of evaluable local hypotheses. +- #5079: LtacProf: fix reset_profile +- #5080: LtacProf: "Show Ltac Profile CutOff $N" +- #5087: Improve the error message on record with duplicated fields. +- #5090: Effect of -Q depends on coqtop's current directory. +- #5093: typeclasses eauto depth arg does not accept a var. +- #5096: [vm_compute] is exponentially slower than [native_compute]. +- #5098: Symmetry broken in HoTT. +- #5102: "Illegal begin of vernac" on bullets +- #5116: [Print Ltac] should be able to print strategies. +- #5125: Bad error message when attempting to use where with Class. +- #5133: error reporting delayed. +- #5136: Stopping warning on unrecognized unicode character in notation. +- #5139: Anomalies should not be caught by || / try. +- #5141: Bogus message "Error: Cannot infer type of pattern-matching". +- #5145: Anomaly: index to an anonymous variable. +- #5149: [subst] breaks evars +- #5161: case of a notation with unability to detect a recursive binder. +- #5164: regression in locating error in argument of "refine". +- #5181: [Arguments] no longer correctly checks the length of arguments lists +- #5182: "Arguments names must be distinct." is bogus and underinformative +- Qcanon : fix names of lemmas Qcle_alt & Qcge_alt (were Qle_alt & Qge_alt) +- When used as an argument of an ltac function, "auto" without "with" + nor "using" clause now correctly uses only the core hint database by + default. + +Some other fixes, minor changes and documentation improvements are not +mentionned here. + Changes from V8.5pl2 to V8.5pl3 =============================== diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex index 4f4f40442..f36969e82 100644 --- a/doc/refman/RefMan-pre.tex +++ b/doc/refman/RefMan-pre.tex @@ -1094,13 +1094,11 @@ Hugo Herbelin, Matthieu Sozeau and the {\Coq} development team\\ year of (now time-based) development, about 450 bugs were resolved and over 100 contributions integrated. The main user visible changes are: \begin{itemize} -\item A new, state-of-the-art universe constraint checker that - can outperform the previous version by an order of magnitude, by +\item A new, faster state-of-the-art universe constraint checker, by Jacques-Henri Jourdan. \item In CoqIDE and other asynchronous interfaces, more fine-grained - asynchronous processing and error reporting by Enrico Tassi. In - asynchronous mode {\Coq} is now capable of recovering from errors - and continue processing the document. + asynchronous processing and error reporting by Enrico Tassi, making {\Coq} + capable of recovering from errors and continue processing the document. \item More access to the proof engine features from Ltac: goal management primitives, range selectors and a {\tt typeclasses eauto} engine handling multiple goals and multiple successes, by @@ -1111,8 +1109,9 @@ over 100 contributions integrated. The main user visible changes are: into errors or ignore them selectively by Maxime Dénès, Guillaume Melquiond, Pierre-Marie Pédrot and others. \item Irrefutable patterns in abstractions, by Daniel de Rauglaudre. -\item Integration of {\tt ssreflect}'s subterm selection algorithm by - Enrico Tassi. +\item The {\tt ssreflect} subterm selection algorithm by Georges Gonthier and + Enrico Tassi is now accessible to tactic writers through the {\tt ssrmatching} + plugin. \item Integration of {\tt LtacProf}, a profiler for {\tt Ltac} by Jason Gross, Paul Steckler, Enrico Tassi and Tobias Tebbi. \end{itemize} -- cgit v1.2.3 From 76ed02a6b2e282bf394e083a97047678fe807ad3 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Wed, 9 Nov 2016 16:47:52 +0100 Subject: Remove old windows build scripts. --- dev/make-installer-win32.sh | 22 --- dev/make-installer-win64.sh | 28 ---- dev/make-sdk-win32.sh | 370 -------------------------------------------- 3 files changed, 420 deletions(-) delete mode 100755 dev/make-installer-win32.sh delete mode 100755 dev/make-installer-win64.sh delete mode 100755 dev/make-sdk-win32.sh diff --git a/dev/make-installer-win32.sh b/dev/make-installer-win32.sh deleted file mode 100755 index 51d428dd1..000000000 --- a/dev/make-installer-win32.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/bin/sh - -set -e - -NSIS="$BASE/NSIS/makensis" -ZIP=_make.zip -URL1=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-bin.zip/download -URL2=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-dep.zip/download - -[ -e config/Makefile ] || ./configure -debug -prefix ./ -with-doc no -make -j2 -if [ ! -e bin/make.exe ]; then - wget -O $ZIP $URL1 && 7z x $ZIP "bin/*" - wget -O $ZIP $URL2 && 7z x $ZIP "bin/*" - rm -rf $ZIP -fi -VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2` -cd dev/nsis -"$NSIS" -DVERSION=$VERSION -DGTK_RUNTIME="`cygpath -w $BASE`" -DARCH="win32" coq.nsi -echo Installer: -ls -h $PWD/*exe -cd ../.. diff --git a/dev/make-installer-win64.sh b/dev/make-installer-win64.sh deleted file mode 100755 index 438f4ae5b..000000000 --- a/dev/make-installer-win64.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/sh - -set -e - -NSIS="$BASE/NSIS/makensis" -ZIP=_make.zip -URL1=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-bin.zip/download -URL2=http://sourceforge.net/projects/gnuwin32/files/make/3.81/make-3.81-dep.zip/download - -[ -e config/Makefile ] || ./configure -debug -prefix ./ -with-doc no -make -j2 coqide -mkdir -p bin32 -cp bin/* bin32/ -make clean -make archclean -( . ${BASE}_64/environ && ./configure -debug -prefix ./ -with-doc no && make -j2 && make ide/coqidetop.cmxs ) -cp bin32/coqide* bin/ -if [ ! -e bin/make.exe ]; then - wget -O $ZIP $URL1 && 7z x $ZIP "bin/*" - wget -O $ZIP $URL2 && 7z x $ZIP "bin/*" - rm -rf $ZIP -fi -VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2` -cd dev/nsis -"$NSIS" -DVERSION=$VERSION -DGTK_RUNTIME="`cygpath -w $BASE`" -DARCH="win64" coq.nsi -echo Installer: -ls -h $PWD/*exe -cd ../.. diff --git a/dev/make-sdk-win32.sh b/dev/make-sdk-win32.sh deleted file mode 100755 index 0112324d4..000000000 --- a/dev/make-sdk-win32.sh +++ /dev/null @@ -1,370 +0,0 @@ -#!/bin/bash - -# To run this script install cygwin by running setup-x86.exe from cygwin.com -# Install the standard packages plus wget. Then run this script. - -# Sworn by Enrico Tassi -# Modified to support other directories and almost support spaces in paths -# by Jason Gross -# License: Expat/MIT http://opensource.org/licenses/MIT - -# This script reads the following environment variables: -# VERBOSE - set to non-empty to have wget/this script be more verbose, for debugging purposes -# BASE - set to non-empty to give a different location for the zip file, e.g., if /cygdrive/c is full or doesn't exist - -set -e -if [ ! -z "$VERBOSE" ] -then - set -x -fi - -# Resources -ocaml=ocaml-4.01.0-i686-mingw64-installer3.exe -glib=base-windows-0.18.1.1.13.356@BUILD_ec06e9.txz -gtk=base-gtk-2.24.18.1.58@BUILD_594ca8.txz -lablgtk=lablgtk-2.18.0.tar.gz -camlp5=camlp5-6.11.tgz -nsis=nsis-2.46-setup.exe - -ocaml_URL='http://yquem.inria.fr/~protzenk/caml-installer/'$ocaml -lablgtk_URL='https://forge.ocamlcore.org/frs/download.php/1261/'$lablgtk -glib_URL='http://dl.arirux.de/5/binaries32/'$glib -gtk_URL='http://dl.arirux.de/5/binaries32/'$gtk -camlp5_URL='http://pauillac.inria.fr/~ddr/camlp5/distrib/src/'$camlp5 -nsis_URL='http://netcologne.dl.sourceforge.net/project/nsis/NSIS%202/2.46/'$nsis - -cygwin=setup-${HOSTTYPE/i6/x}.exe -cygwin_URL='http://cygwin.com/'$cygwin -cygwin_PKGS=p7zip,zip,sed,make,mingw64-i686-gcc-g++,mingw64-i686-gcc-core,mingw64-i686-gcc,patch,rlwrap,libreadline6,diffutils - -has_spaces() { - test -z "$2" -} -# utilities -# http://www.dependencywalker.com/depends22_x86.zip - -# The SDK itself -REVISION=85-1 -# support for working on computers that don't have a C: drive -if [ -z "$BASE" ] -then - TRUE_BASE=/cygdrive/c -else - # get absolute path - TRUE_BASE="$(readlink -f "$BASE")" -fi -BASE="$TRUE_BASE/CoqSDK-$REVISION" - -if [ -z "$VERBOSE" ] -then - WGET_ARGS="-N -q" -else - WGET_ARGS="-N" -fi - -# Windows has a version of FIND in C:/Windows/system32/find, and we don't want to use that -if [ -x /usr/bin/find ] -then - FIND=/usr/bin/find -else - echo "WARNING: /usr/bin/find does not exist. Falling back on:" - which find - FIND=find -fi - -WGET_ARGS="-N -q" - -if [ "$(has_spaces $BASE; echo $?)" -ne 0 ]; then - echo "ERROR: The current base directory ($BASE) has spaces." - echo "ERROR: building lablgtk would fail." - exit 1 -fi - -cyg_install() { - if [ ! -e "$cygwin" ]; then wget $WGET_ARGS "$cygwin_URL"; fi - chmod a+x "$cygwin" - cygstart -w "$cygwin" -q -P $@ -} - -sanity_check() { - echo "Check: wget." - (which wget) || \ - (echo "Please install wget using the cygwin installer and retry.";\ - exit 1) - echo "Check: 7z, gcc. If it fails wait for cygwin to complete and retry" - (which 7z && which i686-w64-mingw32-gcc) || \ - (echo "Some cygwin package is not installed.";\ - echo "Please wait for cygwin to finish and retry.";\ - cyg_install $cygwin_PKGS;\ - exit 1) -} - -install_base() { - echo "Setting up $BASE" - rm -rf "$BASE" - mkdir -p "$BASE" -} - -make_environ() { - echo "Setting up $BASE/environ" - pushd "$BASE" >/dev/null - cat > environ <<- EOF - cyg_install() { - if [ ! -e "$cygwin" ]; then wget $WGET_ARGS "$cygwin_URL"; fi - chmod a+x "$cygwin" - cygstart -w "$cygwin" -q -P \$@ - } - # Sanity checks: is the mingw64-i686-gcc package installed? - (which i686-w64-mingw32-gcc && which make && which sed) || \\ - (echo "Some cygwin package is not installed.";\\ - echo "Please wait for cygwin to finish and retry.";\\ - cyg_install $cygwin_PKGS;\\ - exit 1) || exit 1 - - export BASE="\$( cd "\$( dirname "\${BASH_SOURCE[0]}" )" && pwd )" - export PATH="\$BASE/bin:\$PATH" - export OCAMLLIB="\$(cygpath -m "\$BASE")/lib" - export OCAMLFIND_CONF="\$(cygpath -m "\$BASE")/etc/findlib.conf" - sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/lib/ld.conf.in" \\ - > "\$BASE/lib/ld.conf" - sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/lib/topfind.in" \\ - > "\$BASE/lib/topfind" - sed s"|@BASE@|\$(cygpath -m "\$BASE")|g" "\$BASE/etc/findlib.conf.in" \\ - > "\$BASE/etc/findlib.conf" - echo "Good. You can now build Coq and Coqide from cygwin." - EOF - popd >/dev/null -} - -download() { - echo "Downloading some software:" - if [ ! -e "$ocaml" ]; then - echo "- downloading OCaml..." - wget $WGET_ARGS "$ocaml_URL" - fi - chmod a+x "$ocaml" - if [ ! -e "$lablgtk" ]; then - echo "- downloading lablgtk..." - wget $WGET_ARGS --no-check-certificate "$lablgtk_URL" - fi - if [ ! -e "$gtk" ]; then - echo "- downloading gtk..." - wget $WGET_ARGS "$gtk_URL" - fi - if [ ! -e "$glib" ]; then - echo "- downloading glib..." - wget $WGET_ARGS "$glib_URL" - fi - if [ ! -e "$camlp5" ]; then - echo "- downloading camlp5..." - wget $WGET_ARGS "$camlp5_URL" - fi - if [ ! -e "$nsis" ]; then - echo "- downloading nsis..." - wget $WGET_ARGS "$nsis_URL" - fi -} - -cleanup() { - rm -rf tmp build -} - -install_gtk() { - echo "Installing $glib" - tar -xJf "$glib" -C "$BASE" - echo "Installing $gtk" - tar -xJf "$gtk" -C "$BASE" -} - -install_ocaml() { - echo "Installing $ocaml" - mkdir -p tmp - 7z -otmp x "$ocaml" >/dev/null - cp -r tmp/\$_OUTDIR/bin "$BASE/" - cp -r tmp/bin "$BASE/" - cp -r tmp/\$_OUTDIR/lib "$BASE/" - cp -r tmp/lib "$BASE/" - cp -r tmp/\$_OUTDIR/etc "$BASE/" - "$FIND" "$BASE" -name '*.dll' -o -name '*.exe' | tr '\n' '\0' \ - | xargs -0 chmod a+x - mv "$BASE/lib/topfind" "$BASE/lib/topfind.in" - sed -i 's|@SITELIB@|@BASE@/lib/site-lib|g' "$BASE/lib/topfind.in" - cat > "$BASE/lib/ld.conf.in" <<- EOF - @BASE@/lib - @BASE@/lib/stublibs - EOF - cat > "$BASE/etc/findlib.conf.in" <<- EOF - destdir="@BASE@/lib/site-lib" - path="@BASE@/lib/site-lib" - stdlib="@BASE@/lib" - ldconf="@BASE@/lib/ld.conf" - ocamlc="ocamlc.opt" - ocamlopt="ocamlopt.opt" - ocamldep="ocamldep.opt" - ocamldoc="ocamldoc.opt" - EOF - cp "$BASE/lib/topdirs.cmi" "$BASE/lib/compiler-libs/" -} - -build_install_lablgtk() { - echo "Building $lablgtk" - mkdir -p build - tar -xzf "$lablgtk" -C build - cd build/lablgtk-* - patch -p1 < channel -+ val channel_of_descr_socket : Unix.file_descr -> channel - val add_watch : - cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id - val remove : id -> unit ---- lablgtk-2.18.0/src/glib.ml 2013-10-01 01:31:50.000000000 -0700 -+++ lablgtk-2.18.0.new/src/glib.ml 2013-12-06 11:57:53.070804800 -0800 -@@ -72,6 +72,8 @@ - type id - external channel_of_descr : Unix.file_descr -> channel - = "ml_g_io_channel_unix_new" -+ external channel_of_descr_socket : Unix.file_descr -> channel -+ = "ml_g_io_channel_unix_new_socket" - external remove : id -> unit = "ml_g_source_remove" - external add_watch : - cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id ---- lablgtk-2.18.0/src/ml_glib.c 2013-10-01 01:31:50.000000000 -0700 -+++ lablgtk-2.18.0.new/src/ml_glib.c 2013-12-10 02:03:33.940371800 -0800 -@@ -25,6 +25,8 @@ - #include - #include - #ifdef _WIN32 -+/* to kill a #warning: include winsock2.h before windows.h */ -+#include - #include "win32.h" - #include - #include -@@ -38,6 +40,11 @@ - #include - #include - -+#ifdef _WIN32 -+/* for Socket_val */ -+#include -+#endif -+ - #include "wrappers.h" - #include "ml_glib.h" - #include "glib_tags.h" -@@ -325,14 +332,23 @@ - - #ifndef _WIN32 - ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref) -+CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) { -+ return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1))); -+} - - #else - CAMLprim value ml_g_io_channel_unix_new(value wh) - { - return Val_GIOChannel_noref -- (g_io_channel_unix_new -+ (g_io_channel_win32_new_fd - (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY))); - } -+ -+CAMLprim value ml_g_io_channel_unix_new_socket(value wh) -+{ -+ return Val_GIOChannel_noref -+ (g_io_channel_win32_new_socket(Socket_val(wh))); -+} - #endif - - static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c, -EOT - #sed -i s'/$PKG_CONFIG/"$PKG_CONFIG"/g' configure - #sed -i s'/""$PKG_CONFIG""/"$PKG_CONFIG"/g' configure - ./configure --disable-gtktest --prefix="$(cygpath -m "$BASE")" \ - >log-configure 2>&1 - sed -i 's?\\?/?g' config.make - make >log-make 2>&1 - make opt >>log-make 2>&1 - #echo "Testing $lablgtk" - #cd src - #./lablgtk2 ../examples/calc.ml - #./lablgtk2 -all ../examples/calc.ml - #cd .. - echo "Installing $lablgtk" - make install >>log-make 2>&1 - cd ../.. -} - -build_install_camlp5() { - echo "Building $camlp5" - mkdir -p build - tar -xzf "$camlp5" -C build - cd build/camlp5-* - ./configure >log-configure 2>&1 - sed -i 's/EXT_OBJ=.obj/EXT_OBJ=.o/' config/Makefile - sed -i 's/EXT_LIB=.lib/EXT_LIB=.a/' config/Makefile - make world.opt >log-make 2>&1 - echo "Installing $camlp5" - make install >>log-make 2>&1 - cd ../.. -} - -install_nsis() { - echo "Installing $nsis" - rm -rf tmp - mkdir -p tmp - 7z -otmp x $nsis >/dev/null - mkdir "$BASE/NSIS" - cp -r tmp/\$_OUTDIR/* "$BASE/NSIS" - rm -rf tmp/\$_OUTDIR - rm -rf tmp/\$PLUGINSDIR - cp -r tmp/* "$BASE/NSIS" -} - -zip_sdk() { - echo "Generating CoqSDK-${REVISION}.zip" - here="`pwd`" - cd "$BASE/.." - rm -f "$here/CoqSDK-${REVISION}.zip" - zip -q -r "$here/CoqSDK-${REVISION}.zip" "$(basename "$BASE")" - cd "$here" -} - -diet_sdk() { - rm -rf "$BASE"/+* - rm -rf "$BASE"/bin/camlp4* - rm -rf "$BASE"/lib/camlp4/ - rm -rf "$BASE"/lib/site-lib/camlp4/ -} - -victory(){ - echo "Output file: CoqSDK-${REVISION}.zip "\ - "(`du -sh CoqSDK-${REVISION}.zip | cut -f 1`)" - echo "Usage: unpack and source the environ file at its root" -} - -if [ -z "$1" ]; then - sanity_check - download - cleanup - install_base - install_nsis - install_ocaml - install_gtk - make_environ - . "$BASE/environ" - build_install_lablgtk - build_install_camlp5 - diet_sdk - make_environ - zip_sdk - cleanup - victory -else - # just one step - $1 -fi -- cgit v1.2.3 From 3e19c53bffa95c6c6f4fd5006d54668f36694dd2 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 10 Nov 2016 12:25:24 +0100 Subject: Add Michael Soegtrop's new script to build windows installer. --- dev/build/windows/CAVEATS.txt | 22 + dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat | 10 + dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat | 10 + dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat | 10 + dev/build/windows/MakeCoq_85pl3_installer.bat | 8 + dev/build/windows/MakeCoq_85pl3_installer_32.bat | 8 + dev/build/windows/MakeCoq_86git_abs_ocaml.bat | 10 + .../windows/MakeCoq_86git_abs_ocaml_gtksrc.bat | 11 + dev/build/windows/MakeCoq_86git_installer.bat | 8 + dev/build/windows/MakeCoq_86git_installer2.bat | 8 + dev/build/windows/MakeCoq_86git_installer_32.bat | 8 + dev/build/windows/MakeCoq_MinGW.bat | 445 +++++++ dev/build/windows/MakeCoq_SetRootPath.bat | 16 + dev/build/windows/MakeCoq_regtest_noproxy.bat | 18 + dev/build/windows/MakeCoq_regtests.bat | 16 + dev/build/windows/ReadMe.txt | 460 +++++++ dev/build/windows/configure_profile.sh | 32 + dev/build/windows/difftar-folder.sh | 86 ++ dev/build/windows/makecoq_mingw.sh | 1271 ++++++++++++++++++++ dev/build/windows/patches_coq/ReplaceInFile.nsh | 67 ++ dev/build/windows/patches_coq/StrRep.nsh | 60 + dev/build/windows/patches_coq/camlp4-4.02+6.patch | 11 + dev/build/windows/patches_coq/coq-8.4pl2.patch | 11 + dev/build/windows/patches_coq/coq-8.4pl6.patch | 13 + dev/build/windows/patches_coq/coq_new.nsi | 223 ++++ dev/build/windows/patches_coq/flexdll-0.34.patch | 14 + dev/build/windows/patches_coq/glib-2.46.0.patch | 30 + .../windows/patches_coq/gtksourceview-2.11.2.patch | 213 ++++ dev/build/windows/patches_coq/isl-0.14.patch | 11 + dev/build/windows/patches_coq/lablgtk-2.18.3.patch | 87 ++ dev/build/windows/patches_coq/ln.c | 137 +++ 31 files changed, 3334 insertions(+) create mode 100644 dev/build/windows/CAVEATS.txt create mode 100644 dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat create mode 100644 dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat create mode 100644 dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat create mode 100644 dev/build/windows/MakeCoq_85pl3_installer.bat create mode 100644 dev/build/windows/MakeCoq_85pl3_installer_32.bat create mode 100644 dev/build/windows/MakeCoq_86git_abs_ocaml.bat create mode 100644 dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat create mode 100644 dev/build/windows/MakeCoq_86git_installer.bat create mode 100644 dev/build/windows/MakeCoq_86git_installer2.bat create mode 100644 dev/build/windows/MakeCoq_86git_installer_32.bat create mode 100644 dev/build/windows/MakeCoq_MinGW.bat create mode 100644 dev/build/windows/MakeCoq_SetRootPath.bat create mode 100644 dev/build/windows/MakeCoq_regtest_noproxy.bat create mode 100644 dev/build/windows/MakeCoq_regtests.bat create mode 100644 dev/build/windows/ReadMe.txt create mode 100644 dev/build/windows/configure_profile.sh create mode 100644 dev/build/windows/difftar-folder.sh create mode 100644 dev/build/windows/makecoq_mingw.sh create mode 100644 dev/build/windows/patches_coq/ReplaceInFile.nsh create mode 100644 dev/build/windows/patches_coq/StrRep.nsh create mode 100644 dev/build/windows/patches_coq/camlp4-4.02+6.patch create mode 100644 dev/build/windows/patches_coq/coq-8.4pl2.patch create mode 100644 dev/build/windows/patches_coq/coq-8.4pl6.patch create mode 100644 dev/build/windows/patches_coq/coq_new.nsi create mode 100644 dev/build/windows/patches_coq/flexdll-0.34.patch create mode 100644 dev/build/windows/patches_coq/glib-2.46.0.patch create mode 100644 dev/build/windows/patches_coq/gtksourceview-2.11.2.patch create mode 100644 dev/build/windows/patches_coq/isl-0.14.patch create mode 100644 dev/build/windows/patches_coq/lablgtk-2.18.3.patch create mode 100644 dev/build/windows/patches_coq/ln.c diff --git a/dev/build/windows/CAVEATS.txt b/dev/build/windows/CAVEATS.txt new file mode 100644 index 000000000..cb1ae3aaa --- /dev/null +++ b/dev/build/windows/CAVEATS.txt @@ -0,0 +1,22 @@ +===== Environemt SIZE ===== + +find and xargs can fail if the environment is to large. I think the limit is 8k. + +xargs --show-limits + +shows the actual environment size + +The configure_profile.sh script sets ORIGINAL_PATH (set by cygwin) to "" to +avoid issues + +===== OCAMLLIB ===== + +If the environment variable OCAMLLIB is defined, it takes precedence over the +internal paths of ocaml tools. This usually messes up things considerably. A +typical failure is + +Error: Error on dynamically loaded library: .\dlllablgtk2.dll: %1 is not a valid Win32 application. + +The configure_profile.sh script clears OCAMLLIB, but if you use the ocaml +compiler from outside the provided cygwin shell, OCAMLLIB might be defined. + diff --git a/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat new file mode 100644 index 000000000..bdcb01db9 --- /dev/null +++ b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat @@ -0,0 +1,10 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -coqver=8.4pl6 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_84pl6_abs ^ + -destcoq=%ROOTPATH%\coq64_84pl6_abs diff --git a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat new file mode 100644 index 000000000..2e4a692e9 --- /dev/null +++ b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat @@ -0,0 +1,10 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -coqver=8.5pl2 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_85pl2_abs ^ + -destcoq=%ROOTPATH%\coq64_85pl2_abs diff --git a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat new file mode 100644 index 000000000..6e4e440a2 --- /dev/null +++ b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat @@ -0,0 +1,10 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -coqver=8.5pl3 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_abs ^ + -destcoq=%ROOTPATH%\coq64_85pl3_abs diff --git a/dev/build/windows/MakeCoq_85pl3_installer.bat b/dev/build/windows/MakeCoq_85pl3_installer.bat new file mode 100644 index 000000000..c305e2f52 --- /dev/null +++ b/dev/build/windows/MakeCoq_85pl3_installer.bat @@ -0,0 +1,8 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -installer=Y ^ + -coqver=8.5pl3 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_inst ^ + -destcoq=%ROOTPATH%\coq64_85pl3_inst diff --git a/dev/build/windows/MakeCoq_85pl3_installer_32.bat b/dev/build/windows/MakeCoq_85pl3_installer_32.bat new file mode 100644 index 000000000..d87ff5919 --- /dev/null +++ b/dev/build/windows/MakeCoq_85pl3_installer_32.bat @@ -0,0 +1,8 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=32 ^ + -installer=Y ^ + -coqver=8.5pl3 ^ + -destcyg=%ROOTPATH%\cygwin_coq32_85pl3_inst ^ + -destcoq=%ROOTPATH%\coq32_85pl3_inst diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat new file mode 100644 index 000000000..f1d855a02 --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat @@ -0,0 +1,10 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -coqver=git-v8.6 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs ^ + -destcoq=%ROOTPATH%\coq64_86git_abs diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat new file mode 100644 index 000000000..70ab42bc3 --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat @@ -0,0 +1,11 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -gtksrc=Y ^ + -coqver=git-v8.6 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc ^ + -destcoq=%ROOTPATH%\coq64_86git_abs_gtksrc diff --git a/dev/build/windows/MakeCoq_86git_installer.bat b/dev/build/windows/MakeCoq_86git_installer.bat new file mode 100644 index 000000000..40506318e --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_installer.bat @@ -0,0 +1,8 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -installer=Y ^ + -coqver=git-v8.6 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_86git_inst ^ + -destcoq=%ROOTPATH%\coq64_86git_inst diff --git a/dev/build/windows/MakeCoq_86git_installer2.bat b/dev/build/windows/MakeCoq_86git_installer2.bat new file mode 100644 index 000000000..d184f0e30 --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_installer2.bat @@ -0,0 +1,8 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -installer=Y ^ + -coqver=git-v8.6 ^ + -destcyg=%ROOTPATH%\cygwin_coq64_86git_inst2 ^ + -destcoq=%ROOTPATH%\coq64_86git_inst2 diff --git a/dev/build/windows/MakeCoq_86git_installer_32.bat b/dev/build/windows/MakeCoq_86git_installer_32.bat new file mode 100644 index 000000000..b9127c945 --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_installer_32.bat @@ -0,0 +1,8 @@ +call MakeCoq_SetRootPath + +call MakeCoq_MinGW.bat ^ + -arch=32 ^ + -installer=Y ^ + -coqver=git-v8.6 ^ + -destcyg=%ROOTPATH%\cygwin_coq32_86git_inst ^ + -destcoq=%ROOTPATH%\coq32_86git_inst diff --git a/dev/build/windows/MakeCoq_MinGW.bat b/dev/build/windows/MakeCoq_MinGW.bat new file mode 100644 index 000000000..1e08cc5a3 --- /dev/null +++ b/dev/build/windows/MakeCoq_MinGW.bat @@ -0,0 +1,445 @@ +@ECHO OFF + +REM ========== COPYRIGHT/COPYLEFT ========== + +REM (C) 2016 Intel Deutschland GmbH +REM Author: Michael Soegtrop + +REM Released to the public by Intel under the +REM GNU Lesser General Public License Version 2.1 or later +REM See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html + +REM ========== NOTES ========== + +REM For Cygwin setup command line options +REM see https://cygwin.com/faq/faq.html#faq.setup.cli + +REM ========== DEFAULT VALUES FOR PARAMETERS ========== + +REM For a description of all parameters, see ReadMe.txt + +SET BATCHFILE=%0 +SET BATCHDIR=%~dp0 + +REM see -arch in ReadMe.txt, but values are x86_64 or i686 (not 64 or 32) +SET ARCH=x86_64 + +REM see -mode in ReadMe.txt +SET INSTALLMODE=absolute + +REM see -installer in ReadMe.txt +SET MAKEINSTALLER=N + +REM see -ocaml in ReadMe.txt +SET INSTALLOCAML=N + +REM see -make in ReadMe.txt +SET INSTALLMAKE=Y + +REM see -destcyg in ReadMe.txt +SET DESTCYG=C:\bin\cygwin_coq + +REM see -destcoq in ReadMe.txt +SET DESTCOQ=C:\bin\coq + +REM see -setup in ReadMe.txt +SET SETUP=setup-x86_64.exe + +REM see -proxy in ReadMe.txt +IF DEFINED HTTP_PROXY ( + SET PROXY="%HTTP_PROXY:http://=%" +) else ( + SET PROXY="" +) + +REM see -cygrepo in ReadMe.txt +SET CYGWIN_REPOSITORY=http://ftp.inf.tu-dresden.de/software/windows/cygwin32 + +REM see -cygcache in ReadMe.txt +SET CYGWIN_LOCAL_CACHE_WFMT=%BATCHDIR%cygwin_cache + +REM see -cyglocal in ReadMe.txt +SET CYGWIN_FROM_CACHE=N + +REM see -cygquiet in ReadMe.txt +SET CYGWIN_QUIET=Y + +REM see -srccache in ReadMe.txt +SET SOURCE_LOCAL_CACHE_WFMT=%BATCHDIR%source_cache + +REM see -coqver in ReadMe.txt +SET COQ_VERSION=8.5pl3 + +REM see -gtksrc in ReadMe.txt +SET GTK_FROM_SOURCES=N + +REM see -threads in ReadMe.txt +SET MAKE_THREADS=8 + +REM ========== PARSE COMMAND LINE PARAMETERS ========== + +SHIFT + +:Parse + +IF "%0" == "-arch" ( + IF "%1" == "32" ( + SET ARCH=i686 + SET SETUP=setup-x86.exe + ) ELSE ( + IF "%1" == "64" ( + SET ARCH=x86_64 + SET SETUP=setup-x86_64.exe + ) ELSE ( + ECHO "Invalid -arch, valid are 32 and 64" + GOTO :EOF + ) + ) + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-mode" ( + IF "%1" == "mingwincygwin" ( + SET INSTALLMODE=%1 + ) ELSE ( + IF "%1" == "absolute" ( + SET INSTALLMODE=%1 + ) ELSE ( + IF "%1" == "relocatable" ( + SET INSTALLMODE=%1 + ) ELSE ( + ECHO "Invalid -mode, valid are mingwincygwin, absolute and relocatable" + GOTO :EOF + ) + ) + ) + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-installer" ( + SET MAKEINSTALLER=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-ocaml" ( + SET INSTALLOCAML=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-make" ( + SET INSTALLMAKE=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-destcyg" ( + SET DESTCYG=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-destcoq" ( + SET DESTCOQ=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-setup" ( + SET SETUP=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-proxy" ( + SET PROXY="%1" + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-cygrepo" ( + SET CYGWIN_REPOSITORY="%1" + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-cygcache" ( + SET CYGWIN_LOCAL_CACHE_WFMT="%1" + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-cyglocal" ( + SET CYGWIN_FROM_CACHE=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-cygquiet" ( + SET CYGWIN_QUIET=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-srccache" ( + SET SOURCE_LOCAL_CACHE_WFMT="%1" + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-coqver" ( + SET COQ_VERSION=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-gtksrc" ( + SET GTK_FROM_SOURCES=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF "%0" == "-threads" ( + SET MAKE_THREADS=%1 + SHIFT + SHIFT + GOTO Parse +) + +IF NOT "%0" == "" ( + ECHO Install cygwin and download, compile and install OCaml and Coq for MinGW + ECHO !!! Illegal parameter %0 + ECHO Usage: + ECHO MakeCoq_MinGW + CALL :PrintPars + goto :EOF +) + +IF NOT EXIST %SETUP% ( + ECHO The cygwin setup program %SETUP% doesn't exist. You must download it from https://cygwin.com/install.html. + GOTO :EOF +) + +REM ========== ADJUST PARAMETERS ========== + +IF "%INSTALLMODE%" == "mingwincygwin" ( + SET DESTCOQ=%DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw +) + +IF "%MAKEINSTALLER%" == "Y" ( + SET INSTALLMODE=relocatable + SET INSTALLOCAML=Y + SET INSTALLMAKE=Y +) + +REM ========== CONFIRM PARAMETERS ========== + +CALL :PrintPars +REM Note: DOS batch replaces variables on parsing, so one can't use a variable just set in an () block +IF "%COQREGTESTING%"=="Y" (GOTO :DontAsk) + SET /p ANSWER=Is this correct? y/n + IF NOT "%ANSWER%"=="y" (GOTO :EOF) +:DontAsk + +REM ========== DERIVED VARIABLES ========== + +SET CYGWIN_INSTALLDIR_WFMT=%DESTCYG% +SET RESULT_INSTALLDIR_WFMT=%DESTCOQ% +SET TARGET_ARCH=%ARCH%-w64-mingw32 +SET BASH=%CYGWIN_INSTALLDIR_WFMT%\bin\bash + +REM Convert pathes to various formats +REM WFMT = windows format (C:\..) Used in this batch file. +REM CFMT = cygwin format (\cygdrive\c\..) Used for Cygwin PATH varible, which is : separated, so C: doesn't work. +REM MFMT = MinGW format (C:/...) Used for the build, because \\ requires escaping. Mingw can handle \ and /. + +SET CYGWIN_INSTALLDIR_MFMT=%CYGWIN_INSTALLDIR_WFMT:\=/% +SET RESULT_INSTALLDIR_MFMT=%RESULT_INSTALLDIR_WFMT:\=/% +SET SOURCE_LOCAL_CACHE_MFMT=%SOURCE_LOCAL_CACHE_WFMT:\=/% + +SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_MFMT:C:/=/cygdrive/c/% +SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_MFMT:C:/=/cygdrive/c/% +SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_MFMT:C:/=/cygdrive/c/% + +SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_CFMT:D:/=/cygdrive/d/% +SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_CFMT:D:/=/cygdrive/d/% +SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_CFMT:D:/=/cygdrive/d/% + +SET CYGWIN_INSTALLDIR_CFMT=%CYGWIN_INSTALLDIR_CFMT:E:/=/cygdrive/e/% +SET RESULT_INSTALLDIR_CFMT=%RESULT_INSTALLDIR_CFMT:E:/=/cygdrive/e/% +SET SOURCE_LOCAL_CACHE_CFMT=%SOURCE_LOCAL_CACHE_CFMT:E:/=/cygdrive/e/% + +ECHO CYGWIN INSTALL DIR (WIN) = %CYGWIN_INSTALLDIR_WFMT% +ECHO CYGWIN INSTALL DIR (MINGW) = %CYGWIN_INSTALLDIR_MFMT% +ECHO CYGWIN INSTALL DIR (CYGWIN) = %CYGWIN_INSTALLDIR_CFMT% +ECHO RESULT INSTALL DIR (WIN) = %RESULT_INSTALLDIR_WFMT% +ECHO RESULT INSTALL DIR (MINGW) = %RESULT_INSTALLDIR_MFMT% +ECHO RESULT INSTALL DIR (CYGWIN) = %RESULT_INSTALLDIR_CFMT% + +REM WARNING: Add a space after the = in case you want set this to empty, otherwise the variable will be unset +SET MAKE_OPT=-j %MAKE_THREADS% + +REM ========== DERIVED CYGWIN SETUP OPTIONS ========== + +REM WARNING: Add a space after the = otherwise the variable will be unset +SET CYGWIN_OPT= + +IF "%CYGWIN_FROM_CACHE%" == "Y" ( + SET CYGWIN_OPT= %CYGWIN_OPT% -L +) + +IF "%CYGWIN_QUIET%" == "Y" ( + SET CYGWIN_OPT= %CYGWIN_OPT% -q --no-admin +) + +IF "%GTK_FROM_SOURCES%"=="N" ( + SET CYGWIN_OPT= %CYGWIN_OPT% -P mingw64-%ARCH%-gtk2.0,mingw64-%ARCH%-gtksourceview2.0 +) + +ECHO ========== INSTALL CYGWIN ========== + +REM Cygwin setup sets proper ACLs (permissions) for folders it CREATES. +REM Otherwise chmod won't work and e.g. the ocaml build will fail. +REM Cygwin setup does not touch the ACLs of existing folders. +REM => Create the setup log in a temporary location and move it later. + +REM Get Unique temporary file name +:logfileloop +SET LOGFILE=%TEMP%\CygwinSetUp%RANDOM%-%RANDOM%-%RANDOM%-%RANDOM%.log +if exist "%LOGFILE%" goto :logfileloop + +REM Run Cygwin Setup + +SET RUNSETUP=Y +IF EXIST "%CYGWIN_INSTALLDIR_WFMT%\etc\setup\installed.db" ( + SET RUNSETUP=N +) +IF NOT "%CYGWIN_QUIET%" == "Y" ( + SET RUNSETUP=Y +) + +IF "%RUNSETUP%"=="Y" ( + %SETUP% ^ + --proxy %PROXY% ^ + --site %CYGWIN_REPOSITORY% ^ + --root %CYGWIN_INSTALLDIR_WFMT% ^ + --local-package-dir %CYGWIN_LOCAL_CACHE_WFMT% ^ + --no-shortcuts ^ + %CYGWIN_OPT% ^ + -P wget,curl,git,make,unzip ^ + -P gcc-core,gcc-g++ ^ + -P gdb,liblzma5 ^ + -P patch,automake1.14,automake1.15 ^ + -P mingw64-%ARCH%-binutils,mingw64-%ARCH%-gcc-core,mingw64-%ARCH%-gcc-g++,mingw64-%ARCH%-pkg-config,mingw64-%ARCH%-windows_default_manifest ^ + -P mingw64-%ARCH%-headers,mingw64-%ARCH%-runtime,mingw64-%ARCH%-pthreads,mingw64-%ARCH%-zlib ^ + -P libiconv-devel,libunistring-devel,libncurses-devel ^ + -P gettext-devel,libgettextpo-devel ^ + -P libglib2.0-devel,libgdk_pixbuf2.0-devel ^ + -P libfontconfig1 ^ + -P gtk-update-icon-cache ^ + -P libtool,automake ^ + -P intltool ^ + > "%LOGFILE%" ^ + || GOTO :Error + + MKDIR %CYGWIN_INSTALLDIR_WFMT%\build + MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs + MOVE "%LOGFILE%" %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log || GOTO :Error +) + + +IF NOT "%CYGWIN_QUIET%" == "Y" ( + REM Like most setup programs, cygwin setup starts the real setup as a separate process, so wait for it. + REM This is not required with the -cygquiet=Y and the resulting --no-admin option. + :waitsetup + tasklist /fi "imagename eq %SETUP%" | find ":" > NUL + IF ERRORLEVEL 1 GOTO waitsetup +) + +ECHO ========== CONFIGURE CYGWIN USER ACCOUNT ========== + +copy %BATCHDIR%\configure_profile.sh %CYGWIN_INSTALLDIR_WFMT%\var\tmp || GOTO :Error +%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\var\tmp\configure_profile.sh %PROXY% || GOTO :Error + +ECHO ========== BUILD COQ ========== + +MKDIR %CYGWIN_INSTALLDIR_WFMT%\build +MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\patches + +COPY %BATCHDIR%\makecoq_mingw.sh %CYGWIN_INSTALLDIR_WFMT%\build || GOTO :Error +COPY %BATCHDIR%\patches_coq\*.* %CYGWIN_INSTALLDIR_WFMT%\build\patches || GOTO :Error + +%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh || GOTO :Error + +ECHO ========== FINISHED ========== + +GOTO :EOF + +ECHO ========== BATCH FUNCTIONS ========== + +:PrintPars + REM 01234567890123456789012345678901234567890123456789012345678901234567890123456789 + ECHO -arch ^ Set cygwin, ocaml and coq to 32 or 64 bit + ECHO -mode ^ + ECHO ^ + ECHO ^ + ECHO -installer^ create a windows installer (will be in /build/coq/dev/nsis) + ECHO -ocaml ^ install OCaml in Coq folder (Y) or just in cygwin folder (N) + ECHO -make ^ install GNU Make in Coq folder (Y) or not (N) + ECHO -destcyg ^ + ECHO -destcoq ^ + ECHO -setup ^ (auto adjusted to -arch) + ECHO -proxy ^ + ECHO -cygrepo ^ + ECHO -cygcache ^ + ECHO -cyglocal ^ install cygwin from cache + ECHO -cygquiet ^ install cygwin without user interaction + ECHO -srccache ^ + ECHO -coqver ^ + ECHO -gtksrc ^ build GTK ^(90 min^) or use cygwin version + ECHO -threads ^<1..N^> Number of make threads + ECHO( + ECHO See ReadMe.txt for a detailed description of all parameters + ECHO( + ECHO Parameter values (default or currently set): + ECHO -arch = %ARCH% + ECHO -mode = %INSTALLMODE% + ECHO -ocaml = %INSTALLOCAML% + ECHO -installer= %MAKEINSTALLER% + ECHO -make = %INSTALLMAKE% + ECHO -destcyg = %DESTCYG% + ECHO -destcoq = %DESTCOQ% + ECHO -setup = %SETUP% + ECHO -proxy = %PROXY% + ECHO -cygrepo = %CYGWIN_REPOSITORY% + ECHO -cygcache = %CYGWIN_LOCAL_CACHE_WFMT% + ECHO -cyglocal = %CYGWIN_FROM_CACHE% + ECHO -cygquiet = %CYGWIN_QUIET% + ECHO -srccache = %SOURCE_LOCAL_CACHE_WFMT% + ECHO -coqver = %COQ_VERSION% + ECHO -gtksrc = %GTK_FROM_SOURCES% + ECHO -threads = %MAKE_THREADS% + GOTO :EOF + +:Error +ECHO Building Coq failed with error code %errorlevel% +EXIT /b %errorlevel% diff --git a/dev/build/windows/MakeCoq_SetRootPath.bat b/dev/build/windows/MakeCoq_SetRootPath.bat new file mode 100644 index 000000000..3a3711724 --- /dev/null +++ b/dev/build/windows/MakeCoq_SetRootPath.bat @@ -0,0 +1,16 @@ +@ ECHO OFF + +REM Figure out a root path for coq and cygwin + +REM For the \nul trick for testing folders see +REM https://support.microsoft.com/en-us/kb/65994 + +IF EXIST D:\bin\nul ( + SET ROOTPATH=D:\bin +) else if EXIST C:\bin ( + SET ROOTPATH=C:\bin +) else ( + SET ROOTPATH=C: +) + +ECHO ROOTPATH set to %ROOTPATH% diff --git a/dev/build/windows/MakeCoq_regtest_noproxy.bat b/dev/build/windows/MakeCoq_regtest_noproxy.bat new file mode 100644 index 000000000..2b0b83fed --- /dev/null +++ b/dev/build/windows/MakeCoq_regtest_noproxy.bat @@ -0,0 +1,18 @@ +call MakeCoq_SetRootPath + +SET HTTP_PROXY= +EXPORT HTTP_PROXY= +MKDIR C:\Temp\srccache + +call MakeCoq_MinGW.bat ^ + -arch=64 ^ + -mode=absolute ^ + -ocaml=Y ^ + -make=Y ^ + -coqver 8.5pl2 ^ + -srccache C:\Temp\srccache ^ + -cygquiet=Y ^ + -destcyg %ROOTPATH%\cygwin_coq64_85pl2_abs ^ + -destcoq %ROOTPATH%\coq64_85pl2_abs + +pause \ No newline at end of file diff --git a/dev/build/windows/MakeCoq_regtests.bat b/dev/build/windows/MakeCoq_regtests.bat new file mode 100644 index 000000000..6e36d0140 --- /dev/null +++ b/dev/build/windows/MakeCoq_regtests.bat @@ -0,0 +1,16 @@ +SET COQREGTESTING=Y + +REM Bleeding edge +call MakeCoq_86git_abs_ocaml.bat +call MakeCoq_86git_installer.bat +call MakeCoq_86git_installer_32.bat +call MakeCoq_86git_abs_ocaml_gtksrc.bat + +REM Current stable +call MakeCoq_85pl3_abs_ocaml.bat +call MakeCoq_85pl3_installer.bat +call MakeCoq_85pl3_installer_32.bat + +REM Old but might still be used +call MakeCoq_85pl2_abs_ocaml.bat +call MakeCoq_84pl6_abs_ocaml.bat diff --git a/dev/build/windows/ReadMe.txt b/dev/build/windows/ReadMe.txt new file mode 100644 index 000000000..0faf5bc53 --- /dev/null +++ b/dev/build/windows/ReadMe.txt @@ -0,0 +1,460 @@ +==================== Purpose / Goal ==================== + +The main purpose of these scripts is to build Coq for Windows in a reproducible +and at least by this script documented way without using binary libraries and +executables from various sources. These scripts use only MinGW libraries +provided by Cygwin or compile things from sources. For some libraries there are +options to build them from sources or to use the Cygwin version. + +Another goal (which is not yet achieved) is to have a Coq installer for +Windows, which includes all tools required for native compute and Coq plugin +development without Cygwin. + +Coq requires OCaml for this and OCaml requires binutils, gcc and a posix shell. +Since the standard Windows OCaml installation requires Cygwin to deliver some of +these components, you might be able to imagine that this is not so easy. + +These scripts can produce the following: + +- Coq running on MinGW + +- OCaml producing MinGW code and running on MinGW + +- GCC producing MinGW code and running on MinGW + +- binutils producing MinGW code and running on MinGW + +With "running on MinGW" I mean that the tools accept paths like +"C:\myfolder\myfile.txt" and that they don't link to a Cygwin or msys DLL. The +MinGW gcc and binutils provided by Cygwin produce MinGW code, but they run only +on Cygwin. + +With "producing MinGW code" I mean that the programs created by the tools accept +paths like "C:\myfolder\myfile.txt" and that they don't link to a Cygwin or msys +DLL. + +The missing piece is a posix shell running on plain Windows (without msys or +Cygwin DLL) and not beeing a binary from obscure sources. I am working on it ... + +Since compiling gcc and binutils takes a while and it is not of much use without +a shell, the building of these components is currently disabled. OCaml is built +anyway, because this MinGW/MinGW OCaml (rather than a Cygwin/MinGW OCaml) is +used to compile Coq. + +Until the shell is there, the Cygwin created by these scripts is required to run +OCaml tools. When everything is finished, this will no longer be required. + +==================== Usage ==================== + +The Script MakeCoq_MinGW does: +- download Cygwin (except the Setup.exe or Setup64.exe) +- install Cygwin +- either installs MinGW GTK via Cygwin or compiles it fom sources +- download, compile and install OCaml, CamlP5, Menhir, lablgtk +- download, compile and install Coq +- create a Windows installer (NSIS based) + +The parameters are described below. Mostly paths and the HTTP proxy need to be +set. + +There are two main usages: + +- Compile and install OCaml and Coq in a given folder + + This works reliably, because absolute library paths can be compiled into Coq + and OCaml. + + WARNING: See the "Purpose / Goal" section above for status. + + See MakeCoq_85pl2_abs_ocaml.bat for parameters. + +- Create a Windows installer. + + This works well for Coq but not so well for OCaml. + + WARNING: See the "Purpose / Goal" section above for status. + + See MakeCoq_85pl2_installer.bat for parameters. + +There is also an option to compile OCaml and Coq inside Cygwin, but this is +currently not recommended. The resulting Coq and OCaml work, but Coq is slow +because it scans the largish Cygwin share folder. This will be fixed in a future +version. + +Procedure: + +- Unzip contents of CoqSetup.zip in a folder + +- Adjust parameters in MakeCoq_85pl2_abs_ocaml.bat or in MakeCoq_85pl2_installer.bat. + +- Download Cygwin setup from https://Cygwin.com/install.html + For 32 bit Coq : setup-x86.exe (https://Cygwin.com/setup-x86.exe) + For 64 bit Coq : setup-x86_64.exe (https://Cygwin.com/setup-x86_64.exe) + +- Run MakeCoq_85pl3_abs_ocaml.bat or MakeCoq_85pl3_installer.bat + +- Check MakeCoq_regtests.bat to see what combinations of options are tested + +==================== MakeCoq_MinGW Parameters ==================== + +===== -arch ===== + +Set the target architecture. + +Possible values: + +32: Install/build Cygwin, ocaml and coq for 32 bit windows + +64: Install/build Cygwin, ocaml and coq for 64 bit windows + +Default value: 64 + + +===== -mode ===== + +Set the installation mode / target folder structure. + +Possible values: + +mingwinCygwin: Install coq in the default Cygwin mingw sysroot folder. + This is %DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw. + Todo: The coq share folder should be configured to e.g. /share/coq. + As is, coqc scans the complete share folder, which slows it down 5x for short files. + +absoloute: Install coq in the absolute path given with -destcoq. + The resulting Coq will not be relocatable. + That is the root folder must not be renamed/moved. + +relocatable: Install coq in the absolute path given with -destcoq. + The resulting Coq will be relocatable. + That is the root folder may be renamed/moved. + If OCaml is installed, please note that OCaml cannot be build really relocatable. + If the root folder is moved, the environment variable OCAMLLIB must be set to the libocaml sub folder. + Also the file \libocaml\ld.conf must be adjusted. + +Default value: absolute + + +===== -installer ===== + +Create a Windows installer (it will be in build/coq-8.xplx/dev/nsis) + +Possible values: + +Y: Create a windows installer - this forces -mode=relocatable. + +N: Don't create a windows installer - use the created Coq installation as is. + +Default value: N + + +===== -ocaml ===== + +Install OCaml for later use with Coq or just for building. + +Possible values: + +Y: Install OCaml in the same root as Coq (as given with -coqdest) + This also copies all .o, .cmo, .a, .cmxa files in the lib folder required for compiling plugins. + +N: Install OCaml in the default Cygwin mingw sysroot folder. + This is %DESTCYG%\usr\%ARCH%-w64-mingw32\sys-root\mingw. + +Default value: N + + +===== -make ===== + +Build and install MinGW GNU make + +Possible values: + +Y: Install MinGW GNU make in the same root as Coq (as given with -coqdest). + +N: Don't build or install MinGW GNU make. + For building everything always Cygwin GNU make is used. + +Default value: Y + + +===== -destcyg ===== + +Destination folder in which Cygwin is installed. + +This must be an absolute path in Windows format (with drive letter and \\). + +>>>>> This folder may be deleted after the Coq build is finished! <<<<< + +Default value: C:\bin\Cygwin_coq + + +===== -destcoq ===== + +Destination folder in which Coq is installed. + +This must be an absolute path in Windows format (with drive letter and \\). + +This option is not required if -mode mingwinCygwin is used. + +Default value: C:\bin\coq + + +===== -setup ===== + +Name/path of the Cygwin setup program. + +The Cygwin setup program is called setup-x86.exe or setup-x86_64.exe. +It can be downloaded from: https://Cygwin.com/install.html. + +Default value: setup-x86.exe or setup-x86_64.exe, depending on -arch. + + +===== -proxy ===== + +Internet proxy setting for downloading Cygwin, ocaml and coq. + +The format is :, e.g. proxy.mycompany.com:911 + +The same proxy is used for HTTP, HTTPS and FTP. +If you need separate proxies for separate protocols, you please put your proxies directly into configure_profile.sh (line 11..13). + +Default value: Value of HTTP_PROXY environment variable or none if this variable does not exist. + +ATTENTION: With the --proxy setting of the Cygwin setup, it is possible to +supply a proxy server, but if this parameter is "", Cygwin setup might use proxy +settings from previous setups. If you once did a Cygwin setup behind a firewall +and now want to do a Cygwin setup without a firewall, use the -cygquiet=N +setting to perform a GUI install, where you can adjust the proxy setting. + +===== -cygrepo ===== + +The online repository, from which Cygwin packages are downloaded. + +Note: although most repositories end with Cygwin32, they are good for 32 and 64 bit Cygwin. + +Default value: http://ftp.inf.tu-dresden.de/software/windows/Cygwin32 + +>>>>> If you are not in Europe, you might want to change this! <<<<< + + +===== -cygcache ===== + +The local cache folder for Cygwin repositories. + +You can also copy files here from a backup/reference and set -cyglocal. +The setup will then not download/update from the internet but only use the local cache. + +Default value: \Cygwin_cache + + +===== -cyglocal ===== + +Control if the Cygwin setup uses the latest version from the internet or the version as is in the local folder. + +Possible values: + +Y: Install exactly the Cygwin version from the local repository cache. + Don't update from the internet. + +N: Download the latest Cygwin version from the internet. + Update the local repository cache with the latest version. + +Default value: N + + +===== -cygquiet ===== + +Control if the Cygwin setup runs quitely or interactive. + +Possible values: + +Y: Install Cygwin quitely without user interaction. + +N: Install Cygwin interactively (allows to select additional packages). + +Default value: Y + + +===== -srccache ===== + +The local cache folder for ocaml/coq/... sources. + +Default value: \source_cache + + +===== -coqver ===== + +The version of Coq to download and compile. + +Possible values: 8.4pl6, 8.5pl2, 8.5pl3, git-v8.6 + Others might work, but are untested. + 8.4 is only tested in mode=absoloute + +Default value: 8.5pl3 + +If git- is prepended, the Coq sources are loaded from git. + +ATTENTION: with default options, the scripts cache source tar balls in two +places, the /build/tarballs folder and the /source_cache +folder. If you modified something in git, you need to delete the cached tar ball +in both places! + +===== -gtksrc ===== + +Control if GTK and its prerequisites are build from sources or if binary MinGW packages from Cygwin are used + +Possible values: + +Y: Build GTK from sources, takes about 90 minutes extra. + This is useful, if you want to debug/fix GTK or library issues. + +N: Use prebuilt MinGW libraries from Cygwin + + +===== -threads ===== + +Control the maximum number of make threads for modules which support parallel make. + +Possible values: 1..N. + Should not be more than 1.5x the number of cores. + Should not be more than available RAM/2GB (e.g. 4 for 8GB) + + +==================== TODO ==================== + +- Installer doesn't remove OCAMLLIB environment variables (it is in the script, but doesn't seem to work) +- CoqIDE doesn't find theme files +- Finish / test mingw_in_Cygwin mode (coqide doesn't start, coqc slow cause of scanning complete share folder) +- Possibly create/login as specific user to bash (not sure if it makes sense - nead to create additional bash login link then) +- maybe move share/doc/menhir somehwere else (reduces coqc startup time) +- Use original installed file list for removing files in uninstaller + +==================== Issues with relocation ==================== + +Coq and OCaml are built in a specific folder and are not really intended for relocation e.g. by an installer. +Some absolute paths in config files are patched in coq_new.nsi. + +Coq is made fairly relocatable by first configuring it with PREFIX=./ and then PREFIX=. +OCaml is made relocatable mostly by defining the OCAMLLIB environment variable and by patching some files. +If you have issues with one of the remaining (unpatched) files below, please let me know. + +Text files patched by the installer: + +./ocamllib/ld.conf +./etc/findlib.conf:destdir="D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib" +./etc/findlib.conf:path="D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib" + +Text files containing the install folder path after install: + +./bin/mkcamlp5:LIB=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5 +./bin/mkcamlp5.opt:LIB=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5 +./libocaml/Makefile.config:PREFIX=D:/bin/coq64_buildtest_reloc_ocaml20 +./libocaml/Makefile.config:LIBDIR=D:/bin/coq64_buildtest_reloc_ocaml20/libocaml +./libocaml/site-lib/findlib/Makefile.config:OCAML_CORE_BIN=/cygdrive/d/bin/coq64_buildtest_reloc_ocaml20/bin +./libocaml/site-lib/findlib/Makefile.config:OCAML_SITELIB=D:/bin/coq64_buildtest_reloc_ocaml20\libocaml\site-lib +./libocaml/site-lib/findlib/Makefile.config:OCAMLFIND_BIN=D:/bin/coq64_buildtest_reloc_ocaml20\bin +./libocaml/site-lib/findlib/Makefile.config:OCAMLFIND_CONF=D:/bin/coq64_buildtest_reloc_ocaml20\etc\findlib.conf +./libocaml/topfind:#directory "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib";; +./libocaml/topfind: Topdirs.dir_load Format.err_formatter "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib.cma"; +./libocaml/topfind: Topdirs.dir_load Format.err_formatter "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib_top.cma"; +./libocaml/topfind:(* #load "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib.cma";; *) +./libocaml/topfind:(* #load "D:\\bin\\coq64_buildtest_reloc_ocaml20\\libocaml\\site-lib/findlib/findlib_top.cma";; *) +./man/man1/camlp5.1:These files are installed in the directory D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5. +./man/man1/camlp5.1:D:/bin/coq64_buildtest_reloc_ocaml20/libocaml/camlp5 + +Binary files containing the build folder path after install: + +$ find . -type f -exec grep "Cygwin_coq64_buildtest_reloc_ocaml20" {} /dev/null \; +Binary file ./bin/coqtop.byte.exe matches +Binary file ./bin/coqtop.exe matches +Binary file ./bin/ocamldoc.exe matches +Binary file ./bin/ocamldoc.opt.exe matches +Binary file ./libocaml/ocamldoc/odoc_info.a matches +Binary file ./libocaml/ocamldoc/odoc_info.cma matches + +Binary files containing the install folder path after install: + +$ find . -type f -exec grep "coq64_buildtest_reloc_ocaml20" {} /dev/null \; +Binary file ./bin/camlp4.exe matches +Binary file ./bin/camlp4boot.exe matches +Binary file ./bin/camlp4o.exe matches +Binary file ./bin/camlp4o.opt.exe matches +Binary file ./bin/camlp4of.exe matches +Binary file ./bin/camlp4of.opt.exe matches +Binary file ./bin/camlp4oof.exe matches +Binary file ./bin/camlp4oof.opt.exe matches +Binary file ./bin/camlp4orf.exe matches +Binary file ./bin/camlp4orf.opt.exe matches +Binary file ./bin/camlp4r.exe matches +Binary file ./bin/camlp4r.opt.exe matches +Binary file ./bin/camlp4rf.exe matches +Binary file ./bin/camlp4rf.opt.exe matches +Binary file ./bin/camlp5.exe matches +Binary file ./bin/camlp5o.exe matches +Binary file ./bin/camlp5o.opt matches +Binary file ./bin/camlp5r.exe matches +Binary file ./bin/camlp5r.opt matches +Binary file ./bin/camlp5sch.exe matches +Binary file ./bin/coqc.exe matches +Binary file ./bin/coqchk.exe matches +Binary file ./bin/coqdep.exe matches +Binary file ./bin/coqdoc.exe matches +Binary file ./bin/coqide.exe matches +Binary file ./bin/coqmktop.exe matches +Binary file ./bin/coqtop.byte.exe matches +Binary file ./bin/coqtop.exe matches +Binary file ./bin/coqworkmgr.exe matches +Binary file ./bin/coq_makefile.exe matches +Binary file ./bin/menhir matches +Binary file ./bin/mkcamlp4.exe matches +Binary file ./bin/ocaml.exe matches +Binary file ./bin/ocamlbuild.byte.exe matches +Binary file ./bin/ocamlbuild.exe matches +Binary file ./bin/ocamlbuild.native.exe matches +Binary file ./bin/ocamlc.exe matches +Binary file ./bin/ocamlc.opt.exe matches +Binary file ./bin/ocamldebug.exe matches +Binary file ./bin/ocamldep.exe matches +Binary file ./bin/ocamldep.opt.exe matches +Binary file ./bin/ocamldoc.exe matches +Binary file ./bin/ocamldoc.opt.exe matches +Binary file ./bin/ocamlfind.exe matches +Binary file ./bin/ocamlmklib.exe matches +Binary file ./bin/ocamlmktop.exe matches +Binary file ./bin/ocamlobjinfo.exe matches +Binary file ./bin/ocamlopt.exe matches +Binary file ./bin/ocamlopt.opt.exe matches +Binary file ./bin/ocamlprof.exe matches +Binary file ./bin/ocamlrun.exe matches +Binary file ./bin/ocpp5.exe matches +Binary file ./lib/config/coq_config.cmo matches +Binary file ./lib/config/coq_config.o matches +Binary file ./lib/grammar/grammar.cma matches +Binary file ./lib/ide/ide_win32_stubs.o matches +Binary file ./lib/lib/clib.a matches +Binary file ./lib/lib/clib.cma matches +Binary file ./lib/libcoqrun.a matches +Binary file ./libocaml/camlp4/camlp4fulllib.a matches +Binary file ./libocaml/camlp4/camlp4fulllib.cma matches +Binary file ./libocaml/camlp4/camlp4lib.a matches +Binary file ./libocaml/camlp4/camlp4lib.cma matches +Binary file ./libocaml/camlp4/camlp4o.cma matches +Binary file ./libocaml/camlp4/camlp4of.cma matches +Binary file ./libocaml/camlp4/camlp4oof.cma matches +Binary file ./libocaml/camlp4/camlp4orf.cma matches +Binary file ./libocaml/camlp4/camlp4r.cma matches +Binary file ./libocaml/camlp4/camlp4rf.cma matches +Binary file ./libocaml/camlp5/odyl.cma matches +Binary file ./libocaml/compiler-libs/ocamlcommon.a matches +Binary file ./libocaml/compiler-libs/ocamlcommon.cma matches +Binary file ./libocaml/dynlink.cma matches +Binary file ./libocaml/expunge.exe matches +Binary file ./libocaml/extract_crc.exe matches +Binary file ./libocaml/libcamlrun.a matches +Binary file ./libocaml/ocamlbuild/ocamlbuildlib.a matches +Binary file ./libocaml/ocamlbuild/ocamlbuildlib.cma matches +Binary file ./libocaml/ocamldoc/odoc_info.a matches +Binary file ./libocaml/ocamldoc/odoc_info.cma matches +Binary file ./libocaml/site-lib/findlib/findlib.a matches +Binary file ./libocaml/site-lib/findlib/findlib.cma matches +Binary file ./libocaml/site-lib/findlib/findlib.cmxs matches diff --git a/dev/build/windows/configure_profile.sh b/dev/build/windows/configure_profile.sh new file mode 100644 index 000000000..09a9cf35a --- /dev/null +++ b/dev/build/windows/configure_profile.sh @@ -0,0 +1,32 @@ +#!/bin/bash + +rcfile=~/.bash_profile +donefile=~/.bash_profile.upated + +if [ ! -f $donefile ] ; then + + echo >> $rcfile + + if [ -n "$1" ]; then + echo export http_proxy="http://$1" >> $rcfile + echo export https_proxy="http://$1" >> $rcfile + echo export ftp_proxy="http://$1" >> $rcfile + fi + + mkdir -p $RESULT_INSTALLDIR_CFMT/bin + + # A tightly controlled path helps to avoid issues + # Note: the order is important: first have the cygwin binaries, then the mingw binaries in the path! + # Note: /bin is mounted at /usr/bin and /lib at /usr/lib and it is common to use /usr/bin in PATH + # See cat /proc/mounts + echo "export PATH=/usr/local/bin:/usr/bin:$RESULT_INSTALLDIR_CFMT/bin:/usr/$TARGET_ARCH/sys-root/mingw/bin:/cygdrive/c/Windows/system32:/cygdrive/c/Windows" >> $rcfile + + # find and xargs complain if the environment is larger than (I think) 8k. + # ORIGINAL_PATH (set by cygwin) can be a few k and exceed the limit + echo unset ORIGINAL_PATH >> $rcfile + + # Other installations of OCaml will mess up things + echo unset OCAMLLIB >> $rcfile + + touch $donefile +fi \ No newline at end of file diff --git a/dev/build/windows/difftar-folder.sh b/dev/build/windows/difftar-folder.sh new file mode 100644 index 000000000..65278d5c9 --- /dev/null +++ b/dev/build/windows/difftar-folder.sh @@ -0,0 +1,86 @@ +#!/bin/bash + +###################### COPYRIGHT/COPYLEFT ###################### + +# (C) 2016 Intel Deutschland GmbH +# Author: Michael Soegtrop +# +# Released to the public by Intel under the +# GNU Lesser General Public License Version 2.1 or later +# See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html +# +# With very valuable help on building GTK from +# https://wiki.gnome.org/Projects/GTK+/Win32/MSVCCompilationOfGTKStack +# http://www.gaia-gis.it/spatialite-3.0.0-BETA/mingw64_how_to.html + +###################### Script safety and debugging settings ###################### + +set -o nounset + +# Print usage + +if [ "$#" -lt 1 ] ; then + echo 'Diff a tar (or compressed tar) file with a folder' + echo 'difftar-folder.sh [] [strip]' + echo default for folder is . + echo default for strip is 0. + echo 'strip must be 0 or 1.' + exit 1 +fi + +# Parse parameters + +tarfile=$1 + +if [ "$#" -ge 2 ] ; then + folder=$2 +else + folder=. +fi + +if [ "$#" -ge 3 ] ; then + strip=$3 +else + strip=0 +fi + +# Get path prefix if --strip is used + +if [ "$strip" -gt 0 ] ; then + prefix=`tar -t -f $tarfile | head -1` +else + prefix= +fi + +# Original folder + +if [ "$strip" -gt 0 ] ; then + orig=${prefix%/}.orig +elif [ "$folder" = "." ] ; then + orig=${tarfile##*/} + orig=./${orig%%.tar*}.orig +elif [ "$folder" = "" ] ; then + orig=${tarfile##*/} + orig=${orig%%.tar*}.orig +else + orig=$folder.orig +fi +echo $orig +mkdir -p "$orig" + + +# Make sure tar uses english output (for Mod time differs) +export LC_ALL=C + +# Search all files with a deviating modification time using tar --diff +tar --diff -a -f "$tarfile" --strip $strip --directory "$folder" | grep "Mod time differs" | while read -r file ; do + # Substitute ': Mod time differs' with nothing + file=${file/: Mod time differs/} + # Check if file exists + if [ -f "$folder/$file" ] ; then + # Extract original file + tar -x -a -f "$tarfile" --strip $strip --directory "$orig" "$prefix$file" + # Compute diff + diff -u "$orig/$file" "$folder/$file" + fi +done \ No newline at end of file diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh new file mode 100644 index 000000000..bfc7ce4dd --- /dev/null +++ b/dev/build/windows/makecoq_mingw.sh @@ -0,0 +1,1271 @@ +#!/bin/bash + +###################### COPYRIGHT/COPYLEFT ###################### + +# (C) 2016 Intel Deutschland GmbH +# Author: Michael Soegtrop +# +# Released to the public by Intel under the +# GNU Lesser General Public License Version 2.1 or later +# See https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html +# +# With very valuable help on building GTK from +# https://wiki.gnome.org/Projects/GTK+/Win32/MSVCCompilationOfGTKStack +# http://www.gaia-gis.it/spatialite-3.0.0-BETA/mingw64_how_to.html + +###################### Script safety and debugging settings ###################### + +set -o nounset +set -o errexit +set -x + +# Set this to 1 if all module directories shall be removed before build (no incremental make) +RMDIR_BEFORE_BUILD=1 + +###################### NOTES ##################### + +# - This file goes together with MakeCoq_ForMignGW.bat, which sets up cygwin +# with all required packages and then calls this script. +# +# - This script uses set -o errexit, so if anything fails, the script will stop +# +# - cygwin provided mingw64 packages like mingw64-x86_64-zlib are installed to +# /usr/$TARGET_ARCH/sys-root/mingw, so we use this as install prefix +# +# - if mingw64-x86_64-pkg-config is installed BEFORE building libpng or pixman, +# the .pc files are properly created in /usr/$TARGET_ARCH/sys-root/mingw/lib/pkgconfig +# +# - pango and some others uses pkg-config executable names without path, which doesn't work in cross compile mode +# There are several possible solutions +# 1.) patch build files to get the prefix from pkg-config and use $prefix/bin/ as path +# - doesn't work for pango because automake goes wild +# - mingw tools are not able to handle cygwin path (they need absolute windows paths) +# 2.) export PATH=$PATH:/usr/$TARGET_ARCH/sys-root/mingw/bin +# - a bit dangerous because this exposes much more than required +# - mingw tools are not able to handle cygwin path (they need absolute windows paths) +# 3.) Install required tools via cygwin modules libglib2.0-devel and libgdk_pixbuf2.0-devel +# - Possibly version compatibility issues +# - Possibly mingw/cygwin compatibility issues, e.g. when building font or terminfo databases +# 4.) Build required tools for mingw and cygwin +# - Possibly mingw/cygwin compatibility issues, e.g. when building font or terminfo databases +# +# We use method 3 below +# Method 2 can be tried by putting the cross tools in the path before the cygwin tools (in configure_profile.sh) +# +# - It is tricky to build 64 bit binaries with 32 bit cross tools and vice versa. +# This is because the linker needs to load DLLs from C:\windows\system32, which contains +# both 32 bit and 64 bit DLLs, and which one you get depends by some black magic on if the using +# app is a 32 bit or 64 bit app. So better build 32 bit mingw with 32 bit cygwin and 64 with 64. +# Alternatively the required 32 bit or 64 bit DLLs need to be copied with a 32 bit/64bit cp to some +# folder without such black magic. +# +# - The file selection for the Coq Windows Installer is done with make install (unlike the original script) +# Relocatble builds are first configured with prefix=./ then build and then +# reconfigured with prefix= before make install. + + +###################### ARCHITECTURES ##################### + +# The OS on which the build of the tool/lib runs +BUILD=`gcc -dumpmachine` + +# The OS on which the tool runs +# "`find /bin -name "*mingw32-gcc.exe"`" -dumpmachine +HOST=$TARGET_ARCH + +# The OS for which the tool creates code/for which the libs are +TARGET=$TARGET_ARCH + +# Cygwin uses different arch name for 32 bit than mingw/gcc +case $ARCH in + x86_64) CYGWINARCH=x86_64 ;; + i686) CYGWINARCH=x86 ;; + *) false ;; +esac + +###################### PATHS ##################### + +# Name and create some 'global' folders +PATCHES=/build/patches +BUILDLOGS=/build/buildlogs +FLAGFILES=/build/flagfiles +TARBALLS=/build/tarballs +FILELISTS=/build/filelists + +mkdir -p $BUILDLOGS +mkdir -p $FLAGFILES +mkdir -p $TARBALLS +mkdir -p $FILELISTS +cd /build + + +# sysroot prefix for the above /build/host/target combination +PREFIX=$CYGWIN_INSTALLDIR_MFMT/usr/$TARGET_ARCH/sys-root/mingw + +# Install / Prefix folder for COQ +PREFIXCOQ=$RESULT_INSTALLDIR_MFMT + +# Install / Prefix folder for OCaml +if [ "$INSTALLOCAML" == "Y" ]; then + PREFIXOCAML=$PREFIXCOQ +else + PREFIXOCAML=$PREFIX +fi + +mkdir -p $PREFIX/bin +mkdir -p $PREFIXCOQ/bin +mkdir -p $PREFIXOCAML/bin + +###################### Copy Cygwin Setup Info ##################### + +# Copy Cygwin repo ini file and installed files db to tarballs folder. +# Both files together document the exact selection and version of cygwin packages. +# Do this as early as possible to avoid changes by other setups (the repo folder is shared). + +# Escape URL to folder name +CYGWIN_REPO_FOLDER=${CYGWIN_REPOSITORY}/ +CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//:/%3a} +CYGWIN_REPO_FOLDER=${CYGWIN_REPO_FOLDER//\//%2f} + +# Copy files +cp $CYGWIN_LOCAL_CACHE_WFMT/$CYGWIN_REPO_FOLDER/$CYGWINARCH/setup.ini $TARBALLS +cp /etc/setup/installed.db $TARBALLS + +###################### LOGGING ##################### + +# The folder which receives log files +mkdir -p buildlogs +LOGS=`pwd`/buildlogs + +# The current log target (first part of the log file name) +LOGTARGET=other + +log1() { + "$@" > $LOGS/$LOGTARGET-$1.log 2> $LOGS/$LOGTARGET-$1.err +} + +log2() { + "$@" > $LOGS/$LOGTARGET-$1-$2.log 2> $LOGS/$LOGTARGET-$1-$2.err +} + +log_1_3() { + "$@" > $LOGS/$LOGTARGET-$1-$3.log 2> $LOGS/$LOGTARGET-$1-$3.err +} + +logn() { + LOGTARGETEX=$1 + shift + "$@" > $LOGS/$LOGTARGET-$LOGTARGETEX.log 2> $LOGS/$LOGTARGET-$LOGTARGETEX.err +} + +###################### UTILITY FUNCTIONS ##################### + +# ------------------------------------------------------------------------------ +# Get a source tar ball, expand and patch it +# - get source archive from $SOURCE_LOCAL_CACHE_CFMT or online using wget +# - create build folder +# - extract source archive +# - patch source file if patch exists +# +# Parameters +# $1 file server name including protocol prefix +# $2 file name (without extension) +# $3 file extension +# $4 number of path levels to strip from tar (usually 1) +# $5 module name (if different from archive) +# $6 expand folder name (if different from module name) +# ------------------------------------------------------------------------------ + +function get_expand_source_tar { + # Handle optional parameters + if [ "$#" -ge 4 ] ; then + strip=$4 + else + strip=1 + fi + + if [ "$#" -ge 5 ] ; then + name=$5 + else + name=$2 + fi + + if [ "$#" -ge 6 ] ; then + folder=$6 + else + folder=$name + fi + + # Set logging target + logtargetold=$LOGTARGET + LOGTARGET=$name + + # Get the source archive either from the source cache or online + if [ ! -f $TARBALLS/$name.$3 ] ; then + if [ -f $SOURCE_LOCAL_CACHE_CFMT/$name.$3 ] ; then + cp $SOURCE_LOCAL_CACHE_CFMT/$name.$3 $TARBALLS + else + wget $1/$2.$3 + if [ ! "$2.$3" == "$name.$3" ] ; then + mv $2.$3 $name.$3 + fi + mv $name.$3 $TARBALLS + # Save the source archive in the source cache + if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then + cp $TARBALLS/$name.$3 $SOURCE_LOCAL_CACHE_CFMT + fi + fi + fi + + # Remove build directory (clean build) + if [ $RMDIR_BEFORE_BUILD -eq 1 ] ; then + rm -f -r $folder + fi + + # Create build directory and cd + mkdir -p $folder + cd $folder + + # Extract source archive + if [ "$3" == "zip" ] ; then + log1 unzip $TARBALLS/$name.$3 + if [ "$strip" == "1" ] ; then + # Ok, this is dirty, but it works and it fails if there are name clashes + mv */* . + else + echo "Unzip strip count not supported" + return 1 + fi + else + logn untar tar xvaf $TARBALLS/$name.$3 --strip $strip + fi + + # Patch if patch file exists + if [ -f $PATCHES/$name.patch ] ; then + log1 patch -p1 -i $PATCHES/$name.patch + fi + + # Go back to base folder + cd .. + + LOGTARGET=$logtargetold +} + +# ------------------------------------------------------------------------------ +# Prepare a module build +# - check if build is already done (name.finished file exists) - if so return 1 +# - create name.started +# - get source archive from $SOURCE_LOCAL_CACHE_CFMT or online using wget +# - create build folder +# - cd to build folder and extract source archive +# - create bin_special subfolder and add it to $PATH +# - remember things for build_post +# +# Parameters +# $1 file server name including protocol prefix +# $2 file name (without extension) +# $3 file extension +# $4 [optional] number of path levels to strip from tar (usually 1) +# $5 [optional] module name (if different from archive) +# ------------------------------------------------------------------------------ + +function build_prep { + # Handle optional parameters + if [ "$#" -ge 4 ] ; then + strip=$4 + else + strip=1 + fi + + if [ "$#" -ge 5 ] ; then + name=$5 + else + name=$2 + fi + + # Check if build is already done + if [ ! -f flagfiles/$name.finished ] ; then + BUILD_PACKAGE_NAME=$name + BUILD_OLDPATH=$PATH + BUILD_OLDPWD=`pwd` + LOGTARGET=$name + + touch flagfiles/$name.started + + get_expand_source_tar $1 $2 $3 $strip $name + + cd $name + + # Create a folder and add it to path, where we can put special binaries + # The path is restored in build_post + mkdir bin_special + PATH=`pwd`/bin_special:$PATH + + return 0 + else + return 1 + fi +} + +# ------------------------------------------------------------------------------ +# Finalize a module build +# - create name.finished +# - go back to base folder +# ------------------------------------------------------------------------------ + +function build_post { + if [ ! -f flagfiles/$BUILD_PACKAGE_NAME.finished ]; then + cd $BUILD_OLDPWD + touch flagfiles/$BUILD_PACKAGE_NAME.finished + PATH=$BUILD_OLDPATH + LOGTARGET=other + fi +} + +# ------------------------------------------------------------------------------ +# Build and install a module using the standard configure/make/make install process +# - prepare build (as above) +# - configure +# - make +# - make install +# - finalize build (as above) +# +# parameters +# $1 file server name including protocol prefix +# $2 file name (without extension) +# $3 file extension +# $4 patch function to call between untar and configure (or true if none) +# $5.. extra configure arguments +# ------------------------------------------------------------------------------ + +function build_conf_make_inst { + if build_prep $1 $2 $3 ; then + $4 + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX "${@:5}" + log1 make $MAKE_OPT + log2 make install + log2 make clean + build_post + fi +} + +# ------------------------------------------------------------------------------ +# Install all files given by a glob pattern to a given folder +# +# parameters +# $1 glob pattern (in '') +# $2 target folder +# ------------------------------------------------------------------------------ + +function install_glob { + # Check if any files matching the pattern exist + if [ "$(echo $1)" != "$1" ] ; then + install -D -t $2 $1 + fi +} + + +# ------------------------------------------------------------------------------ +# Recursively Install all files given by a glob pattern to a given folder +# +# parameters +# $1 source path +# $2 pattern (in '') +# $3 target folder +# ------------------------------------------------------------------------------ + +function install_rec { + ( cd $1 && find -type f -name "$2" -exec install -D -T $1/{} $3/{} \; ) +} + +# ------------------------------------------------------------------------------ +# Write a file list of the target folder +# The file lists are used to create file lists for the windows installer +# +# parameters +# $1 name of file list +# ------------------------------------------------------------------------------ + +function list_files { + if [ ! -e "/build/filelists/$1" ] ; then + ( cd $PREFIXCOQ && find -type f | sort > /build/filelists/$1 ) + fi +} + +# ------------------------------------------------------------------------------ +# Compute the set difference of two file lists +# +# parameters +# $1 name of list A-B (set difference of set A minus set B) +# $2 name of list A +# $3 name of list B +# ------------------------------------------------------------------------------ + +function diff_files { + # See http://www.catonmat.net/blog/set-operations-in-unix-shell/ for file list set operations + comm -23 <(sort "/build/filelists/$2") <(sort "/build/filelists/$3") > "/build/filelists/$1" +} + +# ------------------------------------------------------------------------------ +# Filter a list of files with a regular expression +# +# parameters +# $1 name of output file list +# $2 name of input file list +# $3 name of filter regexp +# ------------------------------------------------------------------------------ + +function filter_files { + egrep "$3" "/build/filelists/$2" > "/build/filelists/$1" +} + +# ------------------------------------------------------------------------------ +# Convert a file list to NSIS installer format +# +# parameters +# $1 name of file list file (output file is the same with extension .nsi) +# ------------------------------------------------------------------------------ + +function files_to_nsis { + # Split the path in the file list into path and filename and create SetOutPath and File instructions + # Note: File /oname cannot be used, because it does not create the paths as SetOutPath does + # Note: I didn't check if the redundant SetOutPath instructions have a bad impact on installer size or install time + cat "/build/filelists/$1" | tr '/' '\\' | sed -r 's/^\.(.*)\\([^\\]+)$/SetOutPath $INSTDIR\\\1\nFile ${COQ_SRC_PATH}\\\1\\\2/' > "/build/filelists/$1.nsh" +} + + +###################### MODULE BUILD FUNCTIONS ##################### + +##### LIBPNG ##### + +function make_libpng { + build_conf_make_inst http://prdownloads.sourceforge.net/libpng libpng-1.6.18 tar.gz true +} + +##### PIXMAN ##### + +function make_pixman { + build_conf_make_inst http://cairographics.org/releases pixman-0.32.8 tar.gz true +} + +##### FREETYPE ##### + +function make_freetype { + build_conf_make_inst http://sourceforge.net/projects/freetype/files/freetype2/2.6.1 freetype-2.6.1 tar.bz2 true +} + +##### EXPAT ##### + +function make_expat { + build_conf_make_inst http://sourceforge.net/projects/expat/files/expat/2.1.0 expat-2.1.0 tar.gz true +} + +##### FONTCONFIG ##### + +function make_fontconfig { + make_freetype + make_expat + # CONFIGURE PARAMETERS + # build/install fails without --disable-docs + build_conf_make_inst http://www.freedesktop.org/software/fontconfig/release fontconfig-2.11.94 tar.gz true --disable-docs +} + +##### ICONV ##### + +function make_libiconv { + build_conf_make_inst http://ftp.gnu.org/pub/gnu/libiconv libiconv-1.14 tar.gz true +} + +##### UNISTRING ##### + +function make_libunistring { + build_conf_make_inst http://ftp.gnu.org/gnu/libunistring libunistring-0.9.5 tar.xz true +} + +##### NCURSES ##### + +function make_ncurses { + # NOTE: ncurses is not required below. This is just kept for documentary purposes in case I need it later. + # + # NOTE: make install fails building the terminfo database because + # : ${TIC_PATH:=unknown} in run_tic.sh + # As a result pkg-config .pc files are not generated + # Also configure of gettext gives two "considers" + # checking where terminfo library functions come from... not found, consider installing GNU ncurses + # checking where termcap library functions come from... not found, consider installing GNU ncurses + # gettext make/make install work anyway + # + # CONFIGURE PARAMETERS + # --enable-term-driver --enable-sp-funcs is rewuired for mingw (see README.MinGW) + # additional changes + # ADD --with-pkg-config + # ADD --enable-pc-files + # ADD --without-manpages + # REM --with-pthread + build_conf_make_inst http://ftp.gnu.org/gnu/ncurses ncurses-5.9 tar.gz true --disable-home-terminfo --enable-reentrant --enable-sp-funcs --enable-term-driver --enable-interop --with-pkg-config --enable-pc-files --without-manpages +} + +##### GETTEXT ##### + +function make_gettext { + # Cygwin packet dependencies: (not 100% sure) libiconv-devel,libunistring-devel,libncurses-devel + # Cygwin packet dependencies for gettext users: (not 100% sure) gettext-devel,libgettextpo-devel + # gettext configure complains that ncurses is also required, but it builds without it + # Ncurses is tricky to install/configure for mingw64, so I dropped ncurses + make_libiconv + make_libunistring + build_conf_make_inst http://ftp.gnu.org/pub/gnu/gettext gettext-0.19 tar.gz true +} + +##### LIBFFI ##### + +function make_libffi { + # NOTE: The official download server is down ftp://sourceware.org/pub/libffi/libffi-3.2.1.tar.gz + build_conf_make_inst http://www.mirrorservice.org/sites/sourceware.org/pub/libffi libffi-3.2.1 tar.gz true +} + +##### LIBEPOXY ##### + +function make_libepoxy { + build_conf_make_inst https://github.com/anholt/libepoxy/releases/download/v1.3.1 libepoxy-1.3.1 tar.bz2 true +} + +##### LIBPCRE ##### + +function make_libpcre { + build_conf_make_inst ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre pcre-8.39 tar.bz2 true +} + +function make_libpcre2 { + build_conf_make_inst ftp://ftp.csx.cam.ac.uk/pub/software/programming/pcre pcre2-10.22 tar.bz2 true +} + +##### GLIB ##### + +function make_glib { + # Cygwin packet dependencies: mingw64-x86_64-zlib + make_gettext + make_libffi + make_libpcre + # build_conf_make_inst http://ftp.gnome.org/pub/gnome/sources/glib/2.46 glib-2.46.0 tar.xz true + build_conf_make_inst http://ftp.gnome.org/pub/gnome/sources/glib/2.47 glib-2.47.5 tar.xz true +} + +##### ATK ##### + +function make_atk { + make_gettext + make_glib + build_conf_make_inst http://ftp.gnome.org/pub/gnome/sources/atk/2.18 atk-2.18.0 tar.xz true +} + +##### PIXBUF ##### + +function make_gdk-pixbuf { + # Cygwin packet dependencies: mingw64-x86_64-zlib + make_libpng + make_gettext + make_glib + # CONFIGURE PARAMETERS + # --with-included-loaders=yes statically links the image file format handlers + # This avoids "Cannot open pixbuf loader module file '/usr/x86_64-w64-mingw32/sys-root/mingw/lib/gdk-pixbuf-2.0/2.10.0/loaders.cache': No such file or directory" + build_conf_make_inst http://ftp.gnome.org/pub/GNOME/sources/gdk-pixbuf/2.32 gdk-pixbuf-2.32.1 tar.xz true --with-included-loaders=yes +} + +##### CAIRO ##### + +function make_cairo { + # Cygwin packet dependencies: mingw64-x86_64-zlib + make_libpng + make_glib + make_pixman + make_fontconfig + build_conf_make_inst http://cairographics.org/releases cairo-1.14.2 tar.xz true +} + +##### PANGO ##### + +function make_pango { + make_cairo + make_glib + make_fontconfig + build_conf_make_inst http://ftp.gnome.org/pub/GNOME/sources/pango/1.38 pango-1.38.0 tar.xz true +} + +##### GTK2 ##### + +function patch_gtk2 { + rm gtk/gtk.def +} + +function make_gtk2 { + # Cygwin packet dependencies: gtk-update-icon-cache + if [ "$GTK_FROM_SOURCES" == "Y" ]; then + make_glib + make_atk + make_pango + make_gdk-pixbuf + make_cairo + build_conf_make_inst http://ftp.gnome.org/pub/gnome/sources/gtk+/2.24 gtk+-2.24.28 tar.xz patch_gtk2 + fi +} + +##### GTK3 ##### + +function make_gtk3 { + make_glib + make_atk + make_pango + make_gdk-pixbuf + make_cairo + make_libepoxy + build_conf_make_inst http://ftp.gnome.org/pub/gnome/sources/gtk+/3.16 gtk+-3.16.7 tar.xz true + + # make all incl. tests and examples runs through fine + # make install fails with issue with + # + # make[5]: Entering directory '/home/soegtrop/GTK/gtk+-3.16.7/demos/gtk-demo' + # test -n "" || ../../gtk/gtk-update-icon-cache --ignore-theme-index --force "/usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor" + # gtk-update-icon-cache.exe: Failed to open file /usr/x86_64-w64-mingw32/sys-root/mingw/share/icons/hicolor/.icon-theme.cache : No such file or directory + # Makefile:1373: recipe for target 'install-update-icon-cache' failed + # make[5]: *** [install-update-icon-cache] Error 1 + # make[5]: Leaving directory '/home/soegtrop/GTK/gtk+-3.16.7/demos/gtk-demo' +} + +##### LIBXML2 ##### + +function make_libxml2 { + # Cygwin packet dependencies: libtool automake + # Note: latest release version 2.9.2 fails during configuring lzma, so using 2.9.1 + # Note: python binding requires which doesn't exist on cygwin + if build_prep https://git.gnome.org/browse/libxml2/snapshot libxml2-2.9.1 tar.xz ; then + # ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --disable-shared --without-python + # shared library required by gtksourceview + ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIX --without-python + log1 make $MAKE_OPT all + log2 make install + log2 make clean + build_post + fi +} + +##### GTK-SOURCEVIEW2 ##### + +function make_gtk_sourceview2 { + # Cygwin packet dependencies: intltool + # gtksourceview-2.11.2 requires GTK2 + # gtksourceview-2.91.9 requires GTK3 + # => We use gtksourceview-2.11.2 which seems to be the newest GTK2 based one + if [ "$GTK_FROM_SOURCES" == "Y" ]; then + make_gtk2 + make_libxml2 + build_conf_make_inst https://download.gnome.org/sources/gtksourceview/2.11 gtksourceview-2.11.2 tar.bz2 true + fi +} + +##### FLEXDLL FLEXLINK ##### + +# Note: there is a circular dependency between flexlink and ocaml (resolved in Ocaml 4.03.) +# For MinGW it is not even possible to first build an Ocaml without flexlink support, +# Because Makefile.nt doesn't support this. So we have to use a binary flexlink. +# One could of cause do a bootstrap run ... + +# Install flexdll objects + +function install_flexdll { + cp flexdll.h /usr/$TARGET_ARCH/sys-root/mingw/include + if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then + cp flexdll*_mingw.o /usr/$TARGET_ARCH/bin + cp flexdll*_mingw.o $PREFIXOCAML/bin + elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then + cp flexdll*_mingw64.o /usr/$TARGET_ARCH/bin + cp flexdll*_mingw64.o $PREFIXOCAML/bin + else + echo "Unknown target architecture" + return 1 + fi +} + +# Install flexlink + +function install_flexlink { + cp flexlink.exe /usr/$TARGET_ARCH/bin + + cp flexlink.exe $PREFIXOCAML/bin +} + +# Get binary flexdll flexlink for building OCaml +# An alternative is to first build an OCaml without shared library support and build flexlink with it + +function get_flex_dll_link_bin { + if build_prep http://alain.frisch.fr/flexdll flexdll-bin-0.34 zip 1 ; then + install_flexdll + install_flexlink + build_post + fi +} + +# Build flexdll and flexlink from sources after building OCaml + +function make_flex_dll_link { + if build_prep http://alain.frisch.fr/flexdll flexdll-0.34 tar.gz ; then + if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then + log1 make $MAKE_OPT build_mingw flexlink.exe + elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then + log1 make $MAKE_OPT build_mingw64 flexlink.exe + else + echo "Unknown target architecture" + return 1 + fi + install_flexdll + install_flexlink + log2 make clean + build_post + fi +} + +##### LN replacement ##### + +# Note: this does support symlinks, but symlinks require special user rights on Windows. +# ocamlbuild uses symlinks to link the executables in the build folder to the base folder. +# For this purpose hard links are better. + +function make_ln { + if [ ! -f flagfiles/myln.finished ] ; then + touch flagfiles/myln.started + mkdir -p myln + cd myln + cp $PATCHES/ln.c . + $TARGET_ARCH-gcc -DUNICODE -D_UNICODE -DIGNORE_SYMBOLIC -mconsole -o ln.exe ln.c + install -D ln.exe $PREFIXCOQ/bin/ln.exe + cd .. + touch flagfiles/myln.finished + fi +} + +##### OCAML ##### + +function make_ocaml { + get_flex_dll_link_bin + if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.02 ocaml-4.02.3 tar.gz 1 ; then + # if build_prep http://caml.inria.fr/pub/distrib/ocaml-4.01 ocaml-4.01.0 tar.gz 1 ; then + # See README.win32 + cp config/m-nt.h config/m.h + cp config/s-nt.h config/s.h + if [ "$TARGET_ARCH" == "i686-w64-mingw32" ]; then + cp config/Makefile.mingw config/Makefile + elif [ "$TARGET_ARCH" == "x86_64-w64-mingw32" ]; then + cp config/Makefile.mingw64 config/Makefile + else + echo "Unknown target architecture" + return 1 + fi + + # Prefix is fixed in make file - replace it with the real one + sed -i "s|^PREFIX=.*|PREFIX=$PREFIXOCAML|" config/Makefile + + # We don't want to mess up Coq's dirctory structure so put the OCaml library in a separate folder + # If we refer to the make variable ${PREFIX} below, camlp4 ends up having a wrong path: + # D:\bin\coq64_buildtest_abs_ocaml4\bin>ocamlc -where => D:/bin/coq64_buildtest_abs_ocaml4/libocaml + # D:\bin\coq64_buildtest_abs_ocaml4\bin>camlp4 -where => ${PREFIX}/libocaml\camlp4 + # So we put an explicit path in there + sed -i "s|^LIBDIR=.*|LIBDIR=$PREFIXOCAML/libocaml|" config/Makefile + + # Note: ocaml doesn't support -j 8, so don't pass MAKE_OPT + # I verified that 4.02.3 still doesn't support parallel build + log2 make world -f Makefile.nt + log2 make bootstrap -f Makefile.nt + log2 make opt -f Makefile.nt + log2 make opt.opt -f Makefile.nt + log2 make install -f Makefile.nt + # TODO log2 make clean -f Makefile.nt Temporarily disabled for ocamlbuild development + + # Move license files and other into into special folder + if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then + mkdir -p $PREFIXOCAML/license_readme/ocaml + # 4.01 installs these files, 4.02 doesn't. So delete them and copy them from the sources. + rm -f *.txt + cp LICENSE $PREFIXOCAML/license_readme/ocaml/License.txt + cp INSTALL $PREFIXOCAML/license_readme/ocaml/Install.txt + cp README $PREFIXOCAML/license_readme/ocaml/ReadMe.txt + cp README.win32 $PREFIXOCAML/license_readme/ocaml/ReadMeWin32.txt + cp VERSION $PREFIXOCAML/license_readme/ocaml/Version.txt + cp Changes $PREFIXOCAML/license_readme/ocaml/Changes.txt + fi + + build_post + fi + make_flex_dll_link +} + +##### FINDLIB Ocaml library manager ##### + +function make_findlib { + make_ocaml + if build_prep http://download.camlcity.org/download findlib-1.5.6 tar.gz 1 ; then + ./configure -bindir $PREFIXOCAML\\bin -sitelib $PREFIXOCAML\\libocaml\\site-lib -config $PREFIXOCAML\\etc\\findlib.conf + # Note: findlib doesn't support -j 8, so don't pass MAKE_OPT + log2 make all + log2 make opt + log2 make install + log2 make clean + build_post + fi +} + +##### MENHIR Ocaml Parser Generator ##### + +function make_menhir { + make_ocaml + make_findlib + # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151112 tar.gz 1 ; then + # For Ocaml 4.02 + # if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20151012 tar.gz 1 ; then + # For Ocaml 4.01 + if build_prep http://gallium.inria.fr/~fpottier/menhir menhir-20140422 tar.gz 1 ; then + # Note: menhir doesn't support -j 8, so don't pass MAKE_OPT + log2 make all PREFIX=$PREFIXOCAML + log2 make install PREFIX=$PREFIXOCAML + mv $PREFIXOCAML/bin/menhir $PREFIXOCAML/bin/menhir.exe + build_post + fi +} + +##### CAMLP4 Ocaml Preprocessor ##### + +function make_camlp4 { + # OCaml up to 4.01 includes camlp4, from 4.02 it isn't included + # Check if command camlp4 exists, if not build camlp4 + if ! command camlp4 ; then + make_ocaml + make_findlib + if build_prep https://github.com/ocaml/camlp4/archive 4.02+6 tar.gz 1 camlp4-4.02+6 ; then + # See https://github.com/ocaml/camlp4/issues/41#issuecomment-112018910 + logn configure ./configure + # Note: camlp4 doesn't support -j 8, so don't pass MAKE_OPT + log2 make all + log2 make install + log2 make clean + build_post + fi + fi +} + +##### CAMLP5 Ocaml Preprocessor ##### + +function make_camlp5 { + make_ocaml + make_findlib + if build_prep http://camlp5.gforge.inria.fr/distrib/src camlp5-6.14 tgz 1 ; then + logn configure ./configure + # Somehow my virus scanner has the boot.new/SAVED directory locked after the move for a second => repeat until success + sed -i 's/mv boot.new boot/until mv boot.new boot; do sleep 1; done/' Makefile + log1 make world.opt $MAKE_OPT + log2 make install + # For some reason gramlib.a is not copied, but it is required by Coq + cp lib/gramlib.a $PREFIXOCAML/libocaml/camlp5/ + log2 make clean + build_post + fi +} + +##### LABLGTK Ocaml GTK binding ##### + +# Note: when rebuilding lablgtk by deleting the .finished file, +# also delete \usr\x86_64-w64-mingw32\sys-root\mingw\lib\site-lib +# Otherwise make install fails + +function make_lablgtk { + make_ocaml + make_findlib + make_camlp4 + if build_prep https://forge.ocamlcore.org/frs/download.php/1479 lablgtk-2.18.3 tar.gz 1 ; then + # configure should be fixed to search for $TARGET_ARCH-pkg-config.exe + cp /bin/$TARGET_ARCH-pkg-config.exe bin_special/pkg-config.exe + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXOCAML + + # lablgtk shows occasional errors with -j, so don't pass $MAKE_OPT + + # See https://sympa.inria.fr/sympa/arc/caml-list/2015-10/msg00204.html for the make || true + strip + logn make-world-pre make world || true + $TARGET_ARCH-strip.exe --strip-unneeded src/dlllablgtk2.dll + + log2 make world + log2 make install + log2 make clean + build_post + fi +} + +##### Ocaml Stdint ##### + +function make_stdint { + make_ocaml + make_findlib + if build_prep https://github.com/andrenth/ocaml-stdint/archive 0.3.0 tar.gz 1 Stdint-0.3.0; then + # Note: the setup gets the proper install path from ocamlfind, but for whatever reason it wants + # to create an empty folder in some folder which defaults to C:\Program Files. + # The --preifx overrides this. Id didn't see any files created in /tmp/extra. + log_1_3 ocaml setup.ml -configure --prefix /tmp/extra + log_1_3 ocaml setup.ml -build + log_1_3 ocaml setup.ml -install + log_1_3 ocaml setup.ml -clean + build_post + fi +} + +##### COQ ##### + +# Copy one DLLfrom cygwin MINGW packages to Coq install folder + +function copy_coq_dll { + if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then + cp /usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1 $PREFIXCOQ/bin/$1 + fi +} + +# Copy required DLLs from cygwin MINGW packages to Coq install folder + +function copy_coq_dlls { + # HOW TO CREATE THE DLL LIST + # With the list empty, after the build/install is finished, open coqide in dependency walker. + # See http://www.dependencywalker.com/ + # Make sure to use the 32 bit / 64 bit version of depends matching the target architecture. + # Select all missing DLLs from the module list, right click "copy filenames" + # Delay loaded DLLs from Windows can be ignored (hour-glass icon at begin of line) + # Do this recursively until there are no further missing DLLs (File close + reopen) + # For running this quickly, just do "cd coq- ; call copy_coq_dlls ; cd .." at the end of this script. + # Do the same for coqc and ocamlc (usually doesn't result in additional files) + + copy_coq_dll LIBATK-1.0-0.DLL + copy_coq_dll LIBCAIRO-2.DLL + copy_coq_dll LIBEXPAT-1.DLL + copy_coq_dll LIBFFI-6.DLL + copy_coq_dll LIBFONTCONFIG-1.DLL + copy_coq_dll LIBFREETYPE-6.DLL + copy_coq_dll LIBGDK-WIN32-2.0-0.DLL + copy_coq_dll LIBGDK_PIXBUF-2.0-0.DLL + copy_coq_dll LIBGIO-2.0-0.DLL + copy_coq_dll LIBGLIB-2.0-0.DLL + copy_coq_dll LIBGMODULE-2.0-0.DLL + copy_coq_dll LIBGOBJECT-2.0-0.DLL + copy_coq_dll LIBGTK-WIN32-2.0-0.DLL + copy_coq_dll LIBINTL-8.DLL + copy_coq_dll LIBPANGO-1.0-0.DLL + copy_coq_dll LIBPANGOCAIRO-1.0-0.DLL + copy_coq_dll LIBPANGOWIN32-1.0-0.DLL + copy_coq_dll LIBPIXMAN-1-0.DLL + copy_coq_dll LIBPNG16-16.DLL + copy_coq_dll LIBXML2-2.DLL + copy_coq_dll ZLIB1.DLL + + # Depends on if GTK is built from sources + if [ "$GTK_FROM_SOURCES" == "Y" ]; then + copy_coq_dll libiconv-2.dll + copy_coq_dll libpcre-1.dll + else + copy_coq_dll ICONV.DLL + copy_coq_dll LIBBZ2-1.DLL + copy_coq_dll LIBGTKSOURCEVIEW-2.0-0.DLL + copy_coq_dll LIBHARFBUZZ-0.DLL + copy_coq_dll LIBLZMA-5.DLL + copy_coq_dll LIBPANGOFT2-1.0-0.DLL + fi; + + # Architecture dependent files + case $ARCH in + x86_64) copy_coq_dll LIBGCC_S_SEH-1.DLL ;; + i686) copy_coq_dll LIBGCC_S_SJLJ-1.DLL ;; + *) false ;; + esac + + # Win pthread version change + copy_coq_dll LIBWINPTHREAD-1.DLL +} + +function copy_coq_objects { + # copy objects only from folders which exist in the target lib directory + find . -type d | while read FOLDER ; do + if [ -e $PREFIXCOQ/lib/$FOLDER ] ; then + install_glob $FOLDER/'*.cmxa' $PREFIXCOQ/lib/$FOLDER + install_glob $FOLDER/'*.cmi' $PREFIXCOQ/lib/$FOLDER + install_glob $FOLDER/'*.cma' $PREFIXCOQ/lib/$FOLDER + install_glob $FOLDER/'*.cmo' $PREFIXCOQ/lib/$FOLDER + install_glob $FOLDER/'*.a' $PREFIXCOQ/lib/$FOLDER + install_glob $FOLDER/'*.o' $PREFIXCOQ/lib/$FOLDER + fi + done +} + +# Copy required GTK config and suport files + +function copq_coq_gtk { + echo 'gtk-theme-name = "MS-Windows"' > $PREFIX/etc/gtk-2.0/gtkrc + echo 'gtk-fallback-icon-theme = "Tango"' >> $PREFIX/etc/gtk-2.0/gtkrc + + if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then + install_glob $PREFIX/etc/gtk-2.0/'*' $PREFIXCOQ/gtk-2.0 + install_glob $PREFIX/share/gtksourceview-2.0/language-specs/'*' $PREFIXCOQ/share/gtksourceview-2.0/language-specs + install_glob $PREFIX/share/gtksourceview-2.0/styles/'*' $PREFIXCOQ/share/gtksourceview-2.0/styles + install_rec $PREFIX/share/themes/ '*' $PREFIXCOQ/share/themes + + # This below item look like a bug in make install + if [[ ! $COQ_VERSION == 8.4* ]] ; then + mv $PREFIXCOQ/share/coq/*.lang $PREFIXCOQ/share/gtksourceview-2.0/language-specs + mv $PREFIXCOQ/share/coq/*.xml $PREFIXCOQ/share/gtksourceview-2.0/styles + fi + mkdir -p $PREFIXCOQ/ide + mv $PREFIXCOQ/share/coq/*.png $PREFIXCOQ/ide + rmdir $PREFIXCOQ/share/coq + fi +} + +# Copy license and other info files + +function copy_coq_license { + if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then + install -D doc/LICENSE $PREFIXCOQ/license_readme/coq/LicenseDoc.txt + install -D LICENSE $PREFIXCOQ/license_readme/coq/License.txt + install -D plugins/micromega/LICENSE.sos $PREFIXCOQ/license_readme/coq/LicenseMicromega.txt + install -D README $PREFIXCOQ/license_readme/coq/ReadMe.txt || true + install -D README.md $PREFIXCOQ/license_readme/coq/ReadMe.md || true + install -D README.win $PREFIXCOQ/license_readme/coq/ReadMeWindows.txt + install -D README.doc $PREFIXCOQ/license_readme/coq/ReadMeDoc.txt + install -D CHANGES $PREFIXCOQ/license_readme/coq/Changes.txt + install -D INSTALL $PREFIXCOQ/license_readme/coq/Install.txt + install -D INSTALL.doc $PREFIXCOQ/license_readme/coq/InstallDoc.txt + install -D INSTALL.ide $PREFIXCOQ/license_readme/coq/InstallIde.txt + fi +} + +# Main function for creating Coq + +function make_coq { + make_ocaml + make_lablgtk + make_camlp5 + if + case $COQ_VERSION in + git-*) build_prep https://github.com/coq/coq/archive ${COQ_VERSION##git-} zip 1 coq-${COQ_VERSION} ;; + *) build_prep https://coq.inria.fr/distrib/V$COQ_VERSION/files coq-$COQ_VERSION tar.gz ;; + esac + then + if [ "$INSTALLMODE" == "relocatable" ]; then + # HACK: for relocatable builds, first configure with ./, then build but before install reconfigure with the real target path + logn configure ./configure -debug -with-doc no -prefix ./ -libdir ./lib -mandir ./man + elif [ "$INSTALLMODE" == "absolute" ]; then + logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man + else + logn configure ./configure -debug -with-doc no -prefix $PREFIXCOQ + fi + + # The windows resource compiler binary name is hard coded + sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.build + sed -i "s/i686-w64-mingw32-windres/$TARGET_ARCH-windres/" Makefile.ide || true + + # 8.4x doesn't support parallel make + if [[ $COQ_VERSION == 8.4* ]] ; then + log1 make + else + log1 make $MAKE_OPT + fi + + if [ "$INSTALLMODE" == "relocatable" ]; then + ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man + fi + + log2 make install + log1 copy_coq_dlls + if [ "$INSTALLOCAML" == "Y" ]; then + log1 copy_coq_objects + fi + + copq_coq_gtk + copy_coq_license + + # make clean seems to br broken for 8.5pl2 + # 1.) find | xargs fails on cygwin, can be fixed by sed -i 's|\| xargs rm -f|-exec rm -fv \{\} \+|' Makefile + # 2.) clean of test suites fails with "cannot run complexity tests (no bogomips found)" + # make clean + + build_post + fi +} + +##### GNU Make for MinGW ##### + +function make_mingw_make { + if build_prep http://ftp.gnu.org/gnu/make make-4.2 tar.bz2 ; then + # The config.h.win32 file is fine - don't edit it + # We need to copy the mingw gcc here as "gcc" - then the batch file will use it + cp /usr/bin/${ARCH}-w64-mingw32-gcc-5.4.0.exe ./gcc.exe + # By some magic cygwin bash can run batch files + logn build ./build_w32.bat gcc + # Copy make to Coq folder + cp GccRel/gnumake.exe $PREFIXCOQ/bin/make.exe + build_post + fi +} + +##### GNU binutils for native OCaml ##### + +function make_binutils { + if build_prep http://ftp.gnu.org/gnu/binutils binutils-2.27 tar.gz ; then + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix=$PREFIXCOQ --program-prefix=$TARGET- + log1 make $MAKE_OPT + log2 make install + # log2 make clean + build_post + fi +} + +##### GNU GCC for native OCaml ##### + +function make_gcc { + # Note: the bz2 file is smaller, but decompressing bz2 really takes ages + if build_prep ftp://ftp.fu-berlin.de/unix/languages/gcc/releases/gcc-5.4.0 gcc-5.4.0 tar.gz ; then + # This is equivalent to "contrib/download_prerequisites" but uses caching + # Update versions when updating gcc version + get_expand_source_tar ftp://gcc.gnu.org/pub/gcc/infrastructure mpfr-2.4.2 tar.bz2 1 mpfr-2.4.2 mpfr + get_expand_source_tar ftp://gcc.gnu.org/pub/gcc/infrastructure gmp-4.3.2 tar.bz2 1 gmp-4.3.2 gmp + get_expand_source_tar ftp://gcc.gnu.org/pub/gcc/infrastructure mpc-0.8.1 tar.gz 1 mpc-0.8.1 mpc + get_expand_source_tar ftp://gcc.gnu.org/pub/gcc/infrastructure isl-0.14 tar.bz2 1 isl-0.14 isl + + # For whatever reason gcc needs this (although it never puts anything into it) + # Error: "The directory that should contain system headers does not exist:" + # mkdir -p /mingw/include without --with-sysroot + mkdir -p $PREFIXCOQ/mingw/include + + # See https://gcc.gnu.org/install/configure.html + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET \ + --prefix=$PREFIXCOQ --program-prefix=$TARGET- --disable-win32-registry --with-sysroot=$PREFIXCOQ \ + --enable-languages=c --disable-nls \ + --disable-libsanitizer --disable-libssp --disable-libquadmath --disable-libgomp --disable-libvtv --disable-lto + # --disable-decimal-float seems to be required + # --with-sysroot=$PREFIX results in configure error that this is not an absolute path + log1 make $MAKE_OPT + log2 make install + # log2 make clean + build_post + fi +} + +##### Get sources for Cygwin MinGW packages ##### + +function get_cygwin_mingw_sources { + if [ ! -f flagfiles/cygwin_mingw_sources.finished ] ; then + touch flagfiles/cygwin_mingw_sources.started + + # Find all installed files with mingw in the name and download the corresponding source code file from cygwin + # Steps: + # grep /etc/setup/installed.db for mingw => mingw64-x86_64-gcc-g++ mingw64-x86_64-gcc-g++-5.4.0-2.tar.bz2 1 + # remove archive ending and trailing number => mingw64-x86_64-gcc-g++ mingw64-x86_64-gcc-g++-5.4.0-2 + # replace space with / => ${ARCHIVE} = mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g++-5.4.0-2 + # escape + signs using ${var//pattern/replace} => ${ARCHIVEESC} = mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g\+\+-5.4.0-2 + # grep cygwin setup.ini for installed line + next line (the -A 1 option includes and "after context" of 1 line) + # Note that the folders of the installed binaries and source are different. So we cannot grep just for the source line. + # We could strip off the path and just grep for the file, though. + # => install: x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-g++/mingw64-x86_64-gcc-g++-5.4.0-2.tar.xz 10163848 2f8cb7ba3e16ac8ce0455af01de490ded09061b1b06a9a8e367426635b5a33ce230e04005f059d4ea7b52580757da1f6d5bae88eba6b9da76d1bd95e8844b705 + # source: x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-5.4.0-2-src.tar.xz 95565368 03f22997b7173b243fff65ea46a39613a2e4e75fc7e6cf0fa73b7bcb86071e15ba6d0ca29d330c047fb556a5e684cad57cd2f5adb6e794249e4b01fe27f92c95 + # Take the 2nd field of the last line => ${SOURCE} = x86_64/release/mingw64-x86_64-gcc/mingw64-x86_64-gcc-5.4.0-2-src.tar.xz + # Remove that path part => ${SOURCEFILE} = mingw64-x86_64-gcc-5.4.0-2-src.tar.xz + + grep "mingw" /etc/setup/installed.db | sed 's/\.tar\.bz2 [0-1]$//' | sed 's/ /\//' | while read ARCHIVE ; do + local ARCHIVEESC=${ARCHIVE//+/\\+} + local SOURCE=`egrep -A 1 "install: ($CYGWINARCH|noarch)/release/[-+_/a-z0-9]*$ARCHIVEESC" $TARBALLS/setup.ini | tail -1 | cut -d " " -f 2` + local SOURCEFILE=${SOURCE##*/} + + # Get the source file (either from the source cache or online) + if [ ! -f $TARBALLS/$SOURCEFILE ] ; then + if [ -f $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE ] ; then + cp $SOURCE_LOCAL_CACHE_CFMT/$SOURCEFILE $TARBALLS + else + wget "$CYGWIN_REPOSITORY/$SOURCE" + mv $SOURCEFILE $TARBALLS + # Save the source archive in the source cache + if [ -d $SOURCE_LOCAL_CACHE_CFMT ] ; then + cp $TARBALLS/$SOURCEFILE $SOURCE_LOCAL_CACHE_CFMT + fi + fi + fi + + done + + touch flagfiles/cygwin_mingw_sources.finished + fi +} + +##### Coq Windows Installer ##### + +function make_coq_installer { + make_coq + make_mingw_make + get_cygwin_mingw_sources + + # Prepare the file lists for the installer. We created to file list dumps of the target folder during the build: + # ocaml: ocaml + menhir + camlp5 + findlib + # ocal_coq: as above + coq + + # Create coq file list as ocaml_coq / ocaml + diff_files coq ocaml_coq ocaml + + # Filter out object files + filter_files coq_objects coq '\.(cmxa|cmi|cma|cmo|a|o)$' + + # Filter out plugin object files + filter_files coq_objects_plugins coq_objects '/lib/plugins/.*\.(cmxa|cmi|cma|cmo|a|o)$' + + # Coq objects objects required for plugin development = coq objects except those for pre installed plugins + diff_files coq_plugindev coq_objects coq_objects_plugins + + # Coq files, except objects needed only for plugin development + diff_files coq_base coq coq_plugindev + + # Convert section files to NSIS format + files_to_nsis coq_base + files_to_nsis coq_plugindev + files_to_nsis ocaml + + # Get and extract NSIS Binaries + if build_prep http://downloads.sourceforge.net/project/nsis/NSIS%202/2.51 nsis-2.51 zip ; then + NSIS=`pwd`/makensis.exe + chmod u+x "$NSIS" + # Change to Coq folder + cd ../coq-${COQ_VERSION} + # Copy patched nsi file + cp ../patches/coq_new.nsi dev/nsis + cp ../patches/StrRep.nsh dev/nsis + cp ../patches/ReplaceInFile.nsh dev/nsis + VERSION=`grep ^VERSION= config/Makefile | cut -d = -f 2` + cd dev/nsis + logn nsis-installer "$NSIS" -DVERSION=$VERSION -DARCH=$ARCH -DCOQ_SRC_PATH=$PREFIXCOQ -DCOQ_ICON=..\\..\\ide\\coq.ico coq_new.nsi + + build_post + fi +} + +###################### TOP LEVEL BUILD ##################### + +make_gtk2 +make_gtk_sourceview2 + +make_ocaml +make_findlib +make_lablgtk +make_camlp4 +make_camlp5 +make_menhir +make_stdint +list_files ocaml +make_coq + +if [ "$INSTALLMAKE" == "Y" ] ; then + make_mingw_make +fi + +list_files ocaml_coq + +if [ "$MAKEINSTALLER" == "Y" ] ; then + make_coq_installer +fi + diff --git a/dev/build/windows/patches_coq/ReplaceInFile.nsh b/dev/build/windows/patches_coq/ReplaceInFile.nsh new file mode 100644 index 000000000..27c7eb2fd --- /dev/null +++ b/dev/build/windows/patches_coq/ReplaceInFile.nsh @@ -0,0 +1,67 @@ +; From NSIS Wiki http://nsis.sourceforge.net/ReplaceInFile +; Modifications: +; - Replace only once per line +; - Don't keep original as .old +; - Use StrRep instead of StrReplace (seems to be cleaner) + +Function Func_ReplaceInFile + ClearErrors + + Exch $0 ; REPLACEMENT + Exch + Exch $1 ; SEARCH_TEXT + Exch 2 + Exch $2 ; SOURCE_FILE + + Push $R0 ; SOURCE_FILE file handle + Push $R1 ; temporary file handle + Push $R2 ; unique temporary file name + Push $R3 ; a line to search and replace / save + Push $R4 ; shift puffer + + IfFileExists $2 +1 error ; Check if file exists and open it + FileOpen $R0 $2 "r" + + GetTempFileName $R2 ; Create temporary output file + FileOpen $R1 $R2 "w" + + loop: ; Loop over lines of file + FileRead $R0 $R3 ; Read line + IfErrors finished + Push "$R3" ; Replacine string in line once + Push "$1" + Push "$0" + Call Func_StrRep + Pop $R3 + FileWrite $R1 "$R3" ; Write result + Goto loop + + finished: + FileClose $R1 ; Close files + FileClose $R0 + Delete "$2" ; Delete original file and rename temporary file to target + Rename "$R2" "$2" + ClearErrors + Goto out + + error: + SetErrors + + out: + Pop $R4 + Pop $R3 + Pop $R2 + Pop $R1 + Pop $R0 + Pop $2 + Pop $0 + Pop $1 +FunctionEnd + +!macro ReplaceInFile SOURCE_FILE SEARCH_TEXT REPLACEMENT + Push "${SOURCE_FILE}" + Push "${SEARCH_TEXT}" + Push "${REPLACEMENT}" + Call Func_ReplaceInFile +!macroend + diff --git a/dev/build/windows/patches_coq/StrRep.nsh b/dev/build/windows/patches_coq/StrRep.nsh new file mode 100644 index 000000000..d94a9f88b --- /dev/null +++ b/dev/build/windows/patches_coq/StrRep.nsh @@ -0,0 +1,60 @@ +; From NSIS Wiki http://nsis.sourceforge.net/StrRep +; Slightly modified + +Function Func_StrRep + Exch $R2 ;new + Exch 1 + Exch $R1 ;old + Exch 2 + Exch $R0 ;string + Push $R3 + Push $R4 + Push $R5 + Push $R6 + Push $R7 + Push $R8 + Push $R9 + + StrCpy $R3 0 + StrLen $R4 $R1 + StrLen $R6 $R0 + StrLen $R9 $R2 + loop: + StrCpy $R5 $R0 $R4 $R3 + StrCmp $R5 $R1 found + StrCmp $R3 $R6 done + IntOp $R3 $R3 + 1 ;move offset by 1 to check the next character + Goto loop + found: + StrCpy $R5 $R0 $R3 + IntOp $R8 $R3 + $R4 + StrCpy $R7 $R0 "" $R8 + StrCpy $R0 $R5$R2$R7 + StrLen $R6 $R0 + IntOp $R3 $R3 + $R9 ;move offset by length of the replacement string + Goto loop + done: + + Pop $R9 + Pop $R8 + Pop $R7 + Pop $R6 + Pop $R5 + Pop $R4 + Pop $R3 + Push $R0 + Push $R1 + Pop $R0 + Pop $R1 + Pop $R0 + Pop $R2 + Exch $R1 +FunctionEnd + +!macro StrRep output string old new + Push `${string}` + Push `${old}` + Push `${new}` + Call Func_StrRep + Pop ${output} +!macroend diff --git a/dev/build/windows/patches_coq/camlp4-4.02+6.patch b/dev/build/windows/patches_coq/camlp4-4.02+6.patch new file mode 100644 index 000000000..0cdb4a929 --- /dev/null +++ b/dev/build/windows/patches_coq/camlp4-4.02+6.patch @@ -0,0 +1,11 @@ +--- camlp4-4.02-6.orig/myocamlbuild.ml 2015-06-17 13:37:36.000000000 +0200 ++++ camlp4-4.02+6/myocamlbuild.ml 2016-10-13 13:57:35.512213600 +0200 +@@ -86,7 +86,7 @@ + let dep = "camlp4"/"boot"/exe in + let cmd = + let ( / ) = Filename.concat in +- "camlp4"/"boot"/exe ++ String.escaped (String.escaped ("camlp4"/"boot"/exe)) + in + (Some dep, cmd) + in diff --git a/dev/build/windows/patches_coq/coq-8.4pl2.patch b/dev/build/windows/patches_coq/coq-8.4pl2.patch new file mode 100644 index 000000000..45a66d0bf --- /dev/null +++ b/dev/build/windows/patches_coq/coq-8.4pl2.patch @@ -0,0 +1,11 @@ +--- configure 2014-04-14 22:28:39.174177924 +0200 ++++ configure 2014-04-14 22:29:23.253025166 +0200 +@@ -335,7 +335,7 @@ + MAKEVERSION=`$MAKE -v | head -1 | cut -d" " -f3` + MAKEVERSIONMAJOR=`echo $MAKEVERSION | cut -d. -f1` + MAKEVERSIONMINOR=`echo $MAKEVERSION | cut -d. -f2` +- if [ "$MAKEVERSIONMAJOR" -eq 3 -a "$MAKEVERSIONMINOR" -ge 81 ]; then ++ if [ "$MAKEVERSIONMAJOR" -eq 3 -a "$MAKEVERSIONMINOR" -ge 81 ] || [ "$MAKEVERSIONMAJOR" -ge 4 ] ; then + echo "You have GNU Make $MAKEVERSION. Good!" + else + OK="no" \ No newline at end of file diff --git a/dev/build/windows/patches_coq/coq-8.4pl6.patch b/dev/build/windows/patches_coq/coq-8.4pl6.patch new file mode 100644 index 000000000..c3b7f8574 --- /dev/null +++ b/dev/build/windows/patches_coq/coq-8.4pl6.patch @@ -0,0 +1,13 @@ +coq-8.4pl6.orig +--- coq-8.4pl6.orig/configure 2015-04-09 15:59:35.000000000 +0200 ++++ coq-8.4pl6//configure 2016-11-09 13:29:42.235319800 +0100 +@@ -309,9 +309,6 @@ + # executable extension + + case "$ARCH,$CYGWIN" in +- win32,yes) +- EXE=".exe" +- DLLEXT=".so";; + win32,*) + EXE=".exe" + DLLEXT=".dll";; diff --git a/dev/build/windows/patches_coq/coq_new.nsi b/dev/build/windows/patches_coq/coq_new.nsi new file mode 100644 index 000000000..b88aa066d --- /dev/null +++ b/dev/build/windows/patches_coq/coq_new.nsi @@ -0,0 +1,223 @@ +; This script is used to build the Windows install program for Coq. + +; NSIS Modern User Interface +; Written by Joost Verburg +; Modified by Julien Narboux, Pierre Letouzey, Enrico Tassi and Michael Soegtrop + +; The following command line defines are expected: +; VERSION Coq version, e.g. 8.5-pl2 +; ARCH The target architecture, either x86_64 or i686 +; COQ_SRC_PATH path of Coq installation in Windows or MinGW format (either \\ or /, but with drive letter) +; COQ_ICON path of Coq icon file in Windows or MinGW format + +; Enable compression after debugging. +; SetCompress off +SetCompressor lzma + +!define MY_PRODUCT "Coq" ;Define your own software name here +!define OUTFILE "coq-installer-${VERSION}-${ARCH}.exe" + +!include "MUI2.nsh" +!include "FileAssociation.nsh" +!include "StrRep.nsh" +!include "ReplaceInFile.nsh" +!include "winmessages.nsh" + +Var COQ_SRC_PATH_BS ; COQ_SRC_PATH with \ instead of / +Var COQ_SRC_PATH_DBS ; COQ_SRC_PATH with \\ instead of / +Var INSTDIR_DBS ; INSTDIR with \\ instead of \ + +;-------------------------------- +;Configuration + + Name "Coq" + + ;General + OutFile "${OUTFILE}" + + ;Folder selection page + InstallDir "C:\${MY_PRODUCT}" + + ;Remember install folder + InstallDirRegKey HKCU "Software\${MY_PRODUCT}" "" + +;-------------------------------- +;Modern UI Configuration + + !define MUI_ICON "${COQ_ICON}" + + !insertmacro MUI_PAGE_WELCOME + !insertmacro MUI_PAGE_LICENSE "${COQ_SRC_PATH}/license_readme/coq/License.txt" + !insertmacro MUI_PAGE_COMPONENTS + !define MUI_DIRECTORYPAGE_TEXT_TOP "Select where to install Coq. The path MUST NOT include spaces." + !insertmacro MUI_PAGE_DIRECTORY + !insertmacro MUI_PAGE_INSTFILES + !insertmacro MUI_PAGE_FINISH + + !insertmacro MUI_UNPAGE_WELCOME + !insertmacro MUI_UNPAGE_CONFIRM + !insertmacro MUI_UNPAGE_INSTFILES + !insertmacro MUI_UNPAGE_FINISH + +;-------------------------------- +;Languages + + !insertmacro MUI_LANGUAGE "English" + +;-------------------------------- +;Language Strings + + ;Description + LangString DESC_1 ${LANG_ENGLISH} "This package contains Coq and CoqIDE." + LangString DESC_2 ${LANG_ENGLISH} "This package contains an OCaml compiler for Coq native compute and plugin development." + LangString DESC_3 ${LANG_ENGLISH} "This package contains the development files needed in order to build a plugin for Coq." + LangString DESC_4 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for the current user." + LangString DESC_5 ${LANG_ENGLISH} "Set the OCAMLLIB environment variable for all users." + +;-------------------------------- +; Check for white spaces +Function .onVerifyInstDir + StrLen $0 "$INSTDIR" + StrCpy $1 0 + ${While} $1 < $0 + StrCpy $3 $INSTDIR 1 $1 + StrCmp $3 " " SpacesInPath + IntOp $1 $1 + 1 + ${EndWhile} + Goto done + SpacesInPath: + Abort + done: +FunctionEnd + +;-------------------------------- +;Installer Sections + + +Section "Coq" Sec1 + + SetOutPath "$INSTDIR\" + !include "..\..\..\filelists\coq_base.nsh" + + ${registerExtension} "$INSTDIR\bin\coqide.exe" ".v" "Coq Script File" + + ;Store install folder + WriteRegStr HKCU "Software\${MY_PRODUCT}" "" $INSTDIR + + ;Create uninstaller + WriteUninstaller "$INSTDIR\Uninstall.exe" + WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "DisplayName" "Coq Version ${VERSION}" + WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "UninstallString" '"$INSTDIR\Uninstall.exe"' + WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "DisplayVersion" "${VERSION}" + WriteRegDWORD HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "NoModify" "1" + WriteRegDWORD HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "NoRepair" "1" + WriteRegStr HKEY_LOCAL_MACHINE "Software\Microsoft\Windows\CurrentVersion\Uninstall\Coq" \ + "URLInfoAbout" "http://coq.inria.fr" + + ; Create start menu entries + ; SetOutPath is required for the path in the .lnk files + SetOutPath "$INSTDIR" + CreateDirectory "$SMPROGRAMS\Coq" + ; The first shortcut set here is treated as main application by Windows 7/8. + ; Use CoqIDE as main application + CreateShortCut "$SMPROGRAMS\Coq\CoqIde.lnk" "$INSTDIR\bin\coqide.exe" + CreateShortCut "$SMPROGRAMS\Coq\Coq.lnk" "$INSTDIR\bin\coqtop.exe" + WriteINIStr "$SMPROGRAMS\Coq\The Coq HomePage.url" "InternetShortcut" "URL" "http://coq.inria.fr" + WriteINIStr "$SMPROGRAMS\Coq\The Coq Standard Library.url" "InternetShortcut" "URL" "http://coq.inria.fr/library" + CreateShortCut "$SMPROGRAMS\Coq\Uninstall.lnk" "$INSTDIR\Uninstall.exe" "" "$INSTDIR\Uninstall.exe" 0 + +SectionEnd + +;OCAML Section "Ocaml for native compute and plugin development" Sec2 +;OCAML SetOutPath "$INSTDIR\" +;OCAML !include "..\..\..\filelists\ocaml.nsh" +;OCAML +;OCAML ; Create a few slash / backslash variants of the source and install path +;OCAML ; Note: NSIS has variables, written as $VAR and defines, written as ${VAR} +;OCAML !insertmacro StrRep $COQ_SRC_PATH_BS ${COQ_SRC_PATH} "/" "\" +;OCAML !insertmacro StrRep $COQ_SRC_PATH_DBS ${COQ_SRC_PATH} "/" "\\" +;OCAML !insertmacro StrRep $INSTDIR_DBS $INSTDIR "\" "\\" +;OCAML +;OCAML ; Replace absolute paths in some OCaml config files +;OCAML ; These are not all, see ReadMe.txt +;OCAML !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "/" "\" +;OCAML !insertmacro ReplaceInFile "$INSTDIR\libocaml\ld.conf" "$COQ_SRC_PATH_BS" "$INSTDIR" +;OCAML !insertmacro ReplaceInFile "$INSTDIR\etc\findlib.conf" "$COQ_SRC_PATH_DBS" "$INSTDIR_DBS" +;OCAML SectionEnd + +Section "Coq files for plugin developers" Sec3 + SetOutPath "$INSTDIR\" + !include "..\..\..\filelists\coq_plugindev.nsh" +SectionEnd + +;OCAML Section "OCAMLLIB current user" Sec4 +;OCAML WriteRegStr HKCU "Environment" "OCAMLLIB" "$INSTDIR\libocaml" +;OCAML ; This is required, so that a newly started shell gets the new environment variable +;OCAML ; But it really takes a few seconds +;OCAML DetailPrint "Broadcasting OCAMLLIB environment variable change (current user)" +;OCAML SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=1000 +;OCAML SectionEnd + +;OCAML Section "OCAMLLIB all users" Sec5 +;OCAML WriteRegStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "OCAMLLIB" "$INSTDIR\libocaml" +;OCAML ; This is required, so that a newly started shell gets the new environment variable +;OCAML ; But it really takes a few seconds +;OCAML DetailPrint "Broadcasting OCAMLLIB environment variable change (all users)" +;OCAML SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=1000 +;OCAML SectionEnd + +;-------------------------------- +;Descriptions + +!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN + !insertmacro MUI_DESCRIPTION_TEXT ${Sec1} $(DESC_1) + ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec2} $(DESC_2) + !insertmacro MUI_DESCRIPTION_TEXT ${Sec3} $(DESC_3) + ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec4} $(DESC_4) + ;OCAML !insertmacro MUI_DESCRIPTION_TEXT ${Sec5} $(DESC_5) +!insertmacro MUI_FUNCTION_DESCRIPTION_END + +;-------------------------------- +;Uninstaller Section + +Section "Uninstall" + ; Files and folders + RMDir /r "$INSTDIR\bin" + RMDir /r "$INSTDIR\dev" + RMDir /r "$INSTDIR\etc" + RMDir /r "$INSTDIR\lib" + RMDir /r "$INSTDIR\libocaml" + RMDir /r "$INSTDIR\share" + RMDir /r "$INSTDIR\ide" + RMDir /r "$INSTDIR\gtk-2.0" + RMDir /r "$INSTDIR\latex" + RMDir /r "$INSTDIR\license_readme" + RMDir /r "$INSTDIR\man" + RMDir /r "$INSTDIR\emacs" + + ; Start Menu + Delete "$SMPROGRAMS\Coq\Coq.lnk" + Delete "$SMPROGRAMS\Coq\CoqIde.lnk" + Delete "$SMPROGRAMS\Coq\Uninstall.lnk" + Delete "$SMPROGRAMS\Coq\The Coq HomePage.url" + Delete "$SMPROGRAMS\Coq\The Coq Standard Library.url" + Delete "$INSTDIR\Uninstall.exe" + + ; Registry keys + DeleteRegKey HKCU "Software\${MY_PRODUCT}" + DeleteRegKey HKLM "SOFTWARE\Coq" + DeleteRegKey HKLM "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Coq" + DeleteRegKey HKCU "Environment\OCAMLLIB" + DeleteRegKey HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment\OCAMLLIB" + ${unregisterExtension} ".v" "Coq Script File" + + ; Root folders + RMDir "$INSTDIR" + RMDir "$SMPROGRAMS\Coq" + +SectionEnd diff --git a/dev/build/windows/patches_coq/flexdll-0.34.patch b/dev/build/windows/patches_coq/flexdll-0.34.patch new file mode 100644 index 000000000..16389baca --- /dev/null +++ b/dev/build/windows/patches_coq/flexdll-0.34.patch @@ -0,0 +1,14 @@ +reloc.ml +--- orig.flexdll-0.34/reloc.ml 2015-01-22 17:30:07.000000000 +0100 ++++ flexdll-0.34/reloc.ml 2016-10-12 11:59:16.885829700 +0200 +@@ -117,8 +117,8 @@ + + let new_cmdline () = + let rf = match !toolchain with +- | `MSVC | `MSVC64 | `LIGHTLD -> true +- | `MINGW | `MINGW64 | `GNAT | `CYGWIN | `CYGWIN64 -> false ++ | `MSVC | `MSVC64 | `LIGHTLD | `MINGW | `MINGW64 -> true ++ | `GNAT | `CYGWIN | `CYGWIN64 -> false + in + { + may_use_response_file = rf; diff --git a/dev/build/windows/patches_coq/glib-2.46.0.patch b/dev/build/windows/patches_coq/glib-2.46.0.patch new file mode 100644 index 000000000..9082460bf --- /dev/null +++ b/dev/build/windows/patches_coq/glib-2.46.0.patch @@ -0,0 +1,30 @@ +diff -u -r glib-2.46.0/gio/glocalfile.c glib-2.46.0.patched/gio/glocalfile.c +--- glib-2.46.0/gio/glocalfile.c 2015-08-27 05:32:26.000000000 +0200 ++++ glib-2.46.0.patched/gio/glocalfile.c 2016-01-27 13:08:30.059736400 +0100 +@@ -2682,7 +2682,10 @@ + (!g_path_is_absolute (filename) || len > g_path_skip_root (filename) - filename)) + wfilename[len] = '\0'; + +- retval = _wstat32i64 (wfilename, &buf); ++ // MSoegtrop: _wstat32i64 is the wrong function for GLocalFileStat = struct _stati64 ++ // The correct function is _wstati64, see https://msdn.microsoft.com/en-us/library/14h5k7ff.aspx ++ // Also _wstat32i64 is a VC function, not a windows SDK function, see https://msdn.microsoft.com/en-us/library/aa273365(v=vs.60).aspx ++ retval = _wstati64 (wfilename, &buf); + save_errno = errno; + + g_free (wfilename); +diff -u -r glib-2.46.0/glib/gstdio.c glib-2.46.0.patched/glib/gstdio.c +--- glib-2.46.0/glib/gstdio.c 2015-02-26 13:57:09.000000000 +0100 ++++ glib-2.46.0.patched/glib/gstdio.c 2016-01-27 13:31:12.708987700 +0100 +@@ -493,7 +493,10 @@ + (!g_path_is_absolute (filename) || len > g_path_skip_root (filename) - filename)) + wfilename[len] = '\0'; + +- retval = _wstat (wfilename, buf); ++ // MSoegtrop: _wstat32i64 is the wrong function for GLocalFileStat = struct _stati64 ++ // The correct function is _wstati64, see https://msdn.microsoft.com/en-us/library/14h5k7ff.aspx ++ // Also _wstat32i64 is a VC function, not a windows SDK function, see https://msdn.microsoft.com/en-us/library/aa273365(v=vs.60).aspx ++ retval = _wstati64 (wfilename, buf); + save_errno = errno; + + g_free (wfilename); diff --git a/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch b/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch new file mode 100644 index 000000000..73a098d12 --- /dev/null +++ b/dev/build/windows/patches_coq/gtksourceview-2.11.2.patch @@ -0,0 +1,213 @@ +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourceiter.c gtksourceview-2.11.2.patched/gtksourceview/gtksourceiter.c +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourceiter.c 2010-05-30 12:24:14.000000000 +0200 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourceiter.c 2015-10-27 14:58:54.422888400 +0100 +*************** +*** 80,86 **** + /* If string contains prefix, check that prefix is not followed + * by a unicode mark symbol, e.g. that trailing 'a' in prefix + * is not part of two-char a-with-hat symbol in string. */ +! return type != G_UNICODE_COMBINING_MARK && + type != G_UNICODE_ENCLOSING_MARK && + type != G_UNICODE_NON_SPACING_MARK; + } +--- 80,86 ---- + /* If string contains prefix, check that prefix is not followed + * by a unicode mark symbol, e.g. that trailing 'a' in prefix + * is not part of two-char a-with-hat symbol in string. */ +! return type != G_UNICODE_SPACING_MARK && + type != G_UNICODE_ENCLOSING_MARK && + type != G_UNICODE_NON_SPACING_MARK; + } +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.c +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.c 2010-05-30 12:24:14.000000000 +0200 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.c 2015-10-27 14:55:30.294477600 +0100 +*************** +*** 274,280 **** + * containg a list of language files directories. + * The array is owned by @lm and must not be modified. + */ +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm) + { + g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL); +--- 274,280 ---- + * containg a list of language files directories. + * The array is owned by @lm and must not be modified. + */ +! const gchar* const * + gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm) + { + g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL); +*************** +*** 392,398 **** + * available languages or %NULL if no language is available. The array + * is owned by @lm and must not be modified. + */ +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm) + { + g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL); +--- 392,398 ---- + * available languages or %NULL if no language is available. The array + * is owned by @lm and must not be modified. + */ +! const gchar* const * + gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm) + { + g_return_val_if_fail (GTK_IS_SOURCE_LANGUAGE_MANAGER (lm), NULL); +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.h +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcelanguagemanager.h 2009-11-15 00:41:33.000000000 +0100 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcelanguagemanager.h 2015-10-27 14:55:30.518500000 +0100 +*************** +*** 62,74 **** + + GtkSourceLanguageManager *gtk_source_language_manager_get_default (void); + +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm); + + void gtk_source_language_manager_set_search_path (GtkSourceLanguageManager *lm, + gchar **dirs); + +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm); + + GtkSourceLanguage *gtk_source_language_manager_get_language (GtkSourceLanguageManager *lm, +--- 62,74 ---- + + GtkSourceLanguageManager *gtk_source_language_manager_get_default (void); + +! const gchar* const * + gtk_source_language_manager_get_search_path (GtkSourceLanguageManager *lm); + + void gtk_source_language_manager_set_search_path (GtkSourceLanguageManager *lm, + gchar **dirs); + +! const gchar* const * + gtk_source_language_manager_get_language_ids (GtkSourceLanguageManager *lm); + + GtkSourceLanguage *gtk_source_language_manager_get_language (GtkSourceLanguageManager *lm, +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.c +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.c 2010-05-30 12:24:14.000000000 +0200 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.c 2015-10-27 14:55:30.545502700 +0100 +*************** +*** 310,316 **** + * + * Since: 2.0 + */ +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME (scheme), NULL); +--- 310,316 ---- + * + * Since: 2.0 + */ +! const gchar* const * + gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME (scheme), NULL); +*************** +*** 318,324 **** + if (scheme->priv->authors == NULL) + return NULL; + +! return (G_CONST_RETURN gchar* G_CONST_RETURN *)scheme->priv->authors->pdata; + } + + /** +--- 318,324 ---- + if (scheme->priv->authors == NULL) + return NULL; + +! return (const gchar* const *)scheme->priv->authors->pdata; + } + + /** +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.h +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestylescheme.h 2010-03-29 15:02:56.000000000 +0200 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestylescheme.h 2015-10-27 14:55:30.565504700 +0100 +*************** +*** 61,67 **** + const gchar *gtk_source_style_scheme_get_name (GtkSourceStyleScheme *scheme); + const gchar *gtk_source_style_scheme_get_description(GtkSourceStyleScheme *scheme); + +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme); + + const gchar *gtk_source_style_scheme_get_filename (GtkSourceStyleScheme *scheme); +--- 61,67 ---- + const gchar *gtk_source_style_scheme_get_name (GtkSourceStyleScheme *scheme); + const gchar *gtk_source_style_scheme_get_description(GtkSourceStyleScheme *scheme); + +! const gchar* const * + gtk_source_style_scheme_get_authors (GtkSourceStyleScheme *scheme); + + const gchar *gtk_source_style_scheme_get_filename (GtkSourceStyleScheme *scheme); +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.c gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.c +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.c 2010-05-30 12:24:14.000000000 +0200 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.c 2015-10-27 14:55:30.583506500 +0100 +*************** +*** 515,521 **** + * of string containing the search path. + * The array is owned by the @manager and must not be modified. + */ +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL); +--- 515,521 ---- + * of string containing the search path. + * The array is owned by the @manager and must not be modified. + */ +! const gchar* const * + gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL); +*************** +*** 554,560 **** + * of string containing the ids of the available style schemes or %NULL if no + * style scheme is available. The array is owned by the @manager and must not be modified. + */ +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL); +--- 554,560 ---- + * of string containing the ids of the available style schemes or %NULL if no + * style scheme is available. The array is owned by the @manager and must not be modified. + */ +! const gchar* const * + gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager) + { + g_return_val_if_fail (GTK_IS_SOURCE_STYLE_SCHEME_MANAGER (manager), NULL); +diff -c -r gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.h gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.h +*** gtksourceview-2.11.2.orig/gtksourceview/gtksourcestyleschememanager.h 2009-11-15 00:41:33.000000000 +0100 +--- gtksourceview-2.11.2.patched/gtksourceview/gtksourcestyleschememanager.h 2015-10-27 14:56:24.498897500 +0100 +*************** +*** 73,84 **** + void gtk_source_style_scheme_manager_prepend_search_path (GtkSourceStyleSchemeManager *manager, + const gchar *path); + +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager); + + void gtk_source_style_scheme_manager_force_rescan (GtkSourceStyleSchemeManager *manager); + +! G_CONST_RETURN gchar* G_CONST_RETURN * + gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager); + + GtkSourceStyleScheme *gtk_source_style_scheme_manager_get_scheme (GtkSourceStyleSchemeManager *manager, +--- 73,84 ---- + void gtk_source_style_scheme_manager_prepend_search_path (GtkSourceStyleSchemeManager *manager, + const gchar *path); + +! const gchar* const * + gtk_source_style_scheme_manager_get_search_path (GtkSourceStyleSchemeManager *manager); + + void gtk_source_style_scheme_manager_force_rescan (GtkSourceStyleSchemeManager *manager); + +! const gchar* const * + gtk_source_style_scheme_manager_get_scheme_ids (GtkSourceStyleSchemeManager *manager); + + GtkSourceStyleScheme *gtk_source_style_scheme_manager_get_scheme (GtkSourceStyleSchemeManager *manager, diff --git a/dev/build/windows/patches_coq/isl-0.14.patch b/dev/build/windows/patches_coq/isl-0.14.patch new file mode 100644 index 000000000..f3b8ead1a --- /dev/null +++ b/dev/build/windows/patches_coq/isl-0.14.patch @@ -0,0 +1,11 @@ +--- orig.isl-0.14/configure 2014-10-26 08:36:32.000000000 +0100 ++++ isl-0.14/configure 2016-10-10 18:16:01.430224500 +0200 +@@ -8134,7 +8134,7 @@ + lt_sysroot=`$CC --print-sysroot 2>/dev/null` + fi + ;; #( +- /*) ++ /*|[A-Z]:\\*|[A-Z]:/*) + lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"` + ;; #( + no|'') diff --git a/dev/build/windows/patches_coq/lablgtk-2.18.3.patch b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch new file mode 100644 index 000000000..0691c1fc8 --- /dev/null +++ b/dev/build/windows/patches_coq/lablgtk-2.18.3.patch @@ -0,0 +1,87 @@ +diff -u -r lablgtk-2.18.3/configure lablgtk-2.18.3.patched/configure +--- lablgtk-2.18.3/configure 2014-10-29 08:51:05.000000000 +0100 ++++ lablgtk-2.18.3.patched/configure 2015-10-29 08:58:08.543985500 +0100 +@@ -2667,7 +2667,7 @@ + fi + + +-if test "`$OCAMLFIND printconf stdlib`" != "`$CAMLC -where`"; then ++if test "`$OCAMLFIND printconf stdlib | tr '\\' '/'`" != "`$CAMLC -where | tr '\\' '/'`"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ignoring ocamlfind" >&5 + $as_echo "$as_me: WARNING: Ignoring ocamlfind" >&2;} + OCAMLFIND=no + +diff -u -r lablgtk-2.18.3/src/glib.mli lablgtk-2.18.3.patched/src/glib.mli +--- lablgtk-2.18.3/src/glib.mli 2014-10-29 08:51:06.000000000 +0100 ++++ lablgtk-2.18.3.patched/src/glib.mli 2016-01-25 09:50:59.884715200 +0100 +@@ -75,6 +75,7 @@ + type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI] + type id + val channel_of_descr : Unix.file_descr -> channel ++ val channel_of_descr_socket : Unix.file_descr -> channel + val add_watch : + cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id + val remove : id -> unit + +diff -u -r lablgtk-2.18.3/src/glib.ml lablgtk-2.18.3.patched/src/glib.ml +--- lablgtk-2.18.3/src/glib.ml 2014-10-29 08:51:06.000000000 +0100 ++++ lablgtk-2.18.3.patched/src/glib.ml 2016-01-25 09:50:59.891715900 +0100 +@@ -72,6 +72,8 @@ + type id + external channel_of_descr : Unix.file_descr -> channel + = "ml_g_io_channel_unix_new" ++ external channel_of_descr_socket : Unix.file_descr -> channel ++ = "ml_g_io_channel_unix_new_socket" + external remove : id -> unit = "ml_g_source_remove" + external add_watch : + cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id + +diff -u -r lablgtk-2.18.3/src/ml_glib.c lablgtk-2.18.3.patched/src/ml_glib.c +--- lablgtk-2.18.3/src/ml_glib.c 2014-10-29 08:51:06.000000000 +0100 ++++ lablgtk-2.18.3.patched/src/ml_glib.c 2016-01-25 09:50:59.898716600 +0100 +@@ -25,6 +25,8 @@ + #include + #include + #ifdef _WIN32 ++/* to kill a #warning: include winsock2.h before windows.h */ ++#include + #include "win32.h" + #include + #include +@@ -38,6 +40,11 @@ + #include + #include + ++#ifdef _WIN32 ++/* for Socket_val */ ++#include ++#endif ++ + #include "wrappers.h" + #include "ml_glib.h" + #include "glib_tags.h" +@@ -325,14 +332,23 @@ + + #ifndef _WIN32 + ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref) ++CAMLprim value ml_g_io_channel_unix_new_socket (value arg1) { ++ return Val_GIOChannel_noref (g_io_channel_unix_new (Int_val (arg1))); ++} + + #else + CAMLprim value ml_g_io_channel_unix_new(value wh) + { + return Val_GIOChannel_noref +- (g_io_channel_unix_new ++ (g_io_channel_win32_new_fd + (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY))); + } ++ ++CAMLprim value ml_g_io_channel_unix_new_socket(value wh) ++{ ++ return Val_GIOChannel_noref ++ (g_io_channel_win32_new_socket(Socket_val(wh))); ++} + #endif + + static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c, diff --git a/dev/build/windows/patches_coq/ln.c b/dev/build/windows/patches_coq/ln.c new file mode 100644 index 000000000..5e02c72bb --- /dev/null +++ b/dev/build/windows/patches_coq/ln.c @@ -0,0 +1,137 @@ +// (C) 2016 Intel Deutschland GmbH +// Author: Michael Soegtrop +// Released to the public under CC0 +// See https://creativecommons.org/publicdomain/zero/1.0/ + +// Windows drop in repacement for Linux ln +// Supports command form "ln TARGET LINK_NAME" +// Supports -s and -f options +// Does not support hard links to folders (but symlinks are ok) + +#include +#include +#include + +// Cygwin MinGW doesn't have this Vista++ function in windows.h +#ifdef UNICODE + WINBASEAPI BOOLEAN APIENTRY CreateSymbolicLinkW ( LPCWSTR, LPCWSTR, DWORD ); + #define CreateSymbolicLink CreateSymbolicLinkW + #define CommandLineToArgv CommandLineToArgvW +#else + WINBASEAPI BOOLEAN APIENTRY CreateSymbolicLinkA ( LPCSTR, LPCSTR, DWORD ); + #define CreateSymbolicLink CreateSymbolicLinkA + #define CommandLineToArgv CommandLineToArgvA +#endif +#define SYMBOLIC_LINK_FLAG_DIRECTORY 1 + +int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLineA, int nShowCmd ) +{ + int iarg; + BOOL symbolic = FALSE; + BOOL force = FALSE; + BOOL folder; + const _TCHAR *target; + const _TCHAR *link; + LPTSTR lpCmdLine; + int argc; + LPTSTR *argv; + + // Parse command line + // This is done explicitly here for two reasons + // 1.) MinGW doesn't seem to support _tmain, wWinMain and the like + // 2.) We want to make sure that CommandLineToArgv is used + lpCmdLine = GetCommandLine(); + argv = CommandLineToArgv( lpCmdLine, &argc ); + + // Get target and link name + if( argc<3 ) + { + _ftprintf( stderr, _T("Expecting at least 2 arguments, got %d\n"), argc-1 ); + return 1; + } + target = argv[argc-2]; + link = argv[argc-1]; + + // Parse options + // The last two arguments are interpreted as file names + // All other arguments must be -s or -f os multi letter options like -sf + for(iarg=1; iarg '%s'!\n"), link, target ); + return 1; + } + } + else + { + if( folder ) + { + _ftprintf( stderr, _T("Cannot create hard link to folder") ); + return 1; + } + else + { + if( !CreateHardLink( link, target, NULL ) ) + { + _ftprintf( stderr, _T("Error creating hard link '%s' -> '%s'!\n"), link, target ); + return 1; + } + } + } + + // Everything is fine + return 0; +} \ No newline at end of file -- cgit v1.2.3 From 5a95de009158be1166b3998b99cafbccf4a0b2fa Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 10 Nov 2016 12:27:20 +0100 Subject: Move OSX script. --- dev/build/osx/make-macos-dmg.sh | 35 +++++++++++++++++++++++++++++++++++ dev/make-macos-dmg.sh | 35 ----------------------------------- 2 files changed, 35 insertions(+), 35 deletions(-) create mode 100755 dev/build/osx/make-macos-dmg.sh delete mode 100755 dev/make-macos-dmg.sh diff --git a/dev/build/osx/make-macos-dmg.sh b/dev/build/osx/make-macos-dmg.sh new file mode 100755 index 000000000..b43ada907 --- /dev/null +++ b/dev/build/osx/make-macos-dmg.sh @@ -0,0 +1,35 @@ +#!/bin/bash + +# Fail on first error +set -e + +# Configuration setup +eval `opam config env` +make distclean +OUTDIR=$PWD/_install +DMGDIR=$PWD/_dmg +./configure -debug -prefix $OUTDIR -native-compiler no +VERSION=$(sed -n -e '/^let coq_version/ s/^[^"]*"\([^"]*\)"$/\1/p' configure.ml) +APP=bin/CoqIDE_${VERSION}.app + +# Create a .app file with CoqIDE +~/.local/bin/jhbuild run make -j -l2 $APP + +# Build Coq and run test-suite +make && make check + +# Add Coq to the .app file +make OLDROOT=$OUTDIR COQINSTALLPREFIX=$APP/Contents/Resources/ install-coq install-ide-toploop + +# Sign the .app file +codesign -f -s - $APP + +# Create the dmg bundle +mkdir -p $DMGDIR +ln -sf /Applications $DMGDIR/Applications +cp -r $APP $DMGDIR + +# Temporary countermeasure to hdiutil error 5341 +head -c9703424 /dev/urandom > $DMGDIR/.padding + +hdiutil create -imagekey zlib-level=9 -volname CoqIDE_$VERSION -srcfolder $DMGDIR -ov -format UDZO CoqIDE_$VERSION.dmg diff --git a/dev/make-macos-dmg.sh b/dev/make-macos-dmg.sh deleted file mode 100755 index b43ada907..000000000 --- a/dev/make-macos-dmg.sh +++ /dev/null @@ -1,35 +0,0 @@ -#!/bin/bash - -# Fail on first error -set -e - -# Configuration setup -eval `opam config env` -make distclean -OUTDIR=$PWD/_install -DMGDIR=$PWD/_dmg -./configure -debug -prefix $OUTDIR -native-compiler no -VERSION=$(sed -n -e '/^let coq_version/ s/^[^"]*"\([^"]*\)"$/\1/p' configure.ml) -APP=bin/CoqIDE_${VERSION}.app - -# Create a .app file with CoqIDE -~/.local/bin/jhbuild run make -j -l2 $APP - -# Build Coq and run test-suite -make && make check - -# Add Coq to the .app file -make OLDROOT=$OUTDIR COQINSTALLPREFIX=$APP/Contents/Resources/ install-coq install-ide-toploop - -# Sign the .app file -codesign -f -s - $APP - -# Create the dmg bundle -mkdir -p $DMGDIR -ln -sf /Applications $DMGDIR/Applications -cp -r $APP $DMGDIR - -# Temporary countermeasure to hdiutil error 5341 -head -c9703424 /dev/urandom > $DMGDIR/.padding - -hdiutil create -imagekey zlib-level=9 -volname CoqIDE_$VERSION -srcfolder $DMGDIR -ov -format UDZO CoqIDE_$VERSION.dmg -- cgit v1.2.3 From dd47fcfc08c43288a49797cc72829da3f9642094 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Fri, 11 Nov 2016 10:57:47 +0100 Subject: Making explicit that a result is discarded (ocaml warning). --- ide/preferences.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ide/preferences.ml b/ide/preferences.ml index 64327d74f..b16d45b54 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -468,7 +468,7 @@ let create_tag name default = let iter table = let tag = GText.tag ~name () in table#add tag#as_tag; - pref#connect#changed (fun _ -> set_tag tag); + ignore (pref#connect#changed (fun _ -> set_tag tag)); set_tag tag; in List.iter iter [Tags.Script.table; Tags.Proof.table; Tags.Message.table]; -- cgit v1.2.3 From 7e992fa784ee6fa48af8a2e461385c094985587d Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Fri, 11 Nov 2016 11:20:38 +0100 Subject: Coqide: fixing default local links for refman and stdlib. --- ide/preferences.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ide/preferences.ml b/ide/preferences.ml index b16d45b54..f0fd45d77 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -918,7 +918,7 @@ let configure ?(apply=(fun () -> ())) () = in let doc_url = let predefined = [ - "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"refman";""]); + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["refman";"html"]); Coq_config.wwwrefman; use_default_doc_url ] in @@ -931,7 +931,7 @@ let configure ?(apply=(fun () -> ())) () = doc_url#get in let library_url = let predefined = [ - "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["html";"stdlib";""]); + "file://"^(List.fold_left Filename.concat (Coq_config.docdir) ["stdlib";"html"]); Coq_config.wwwstdlib ] in combo -- cgit v1.2.3 From 30f222b1aad7ec483902b74dfa7dad7aefd5fca3 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 10 Nov 2016 13:24:28 +0100 Subject: Do not mention "none" in warnings doc, as it is there for compatibility. --- doc/refman/RefMan-oth.tex | 22 +++++++++++----------- toplevel/usage.ml | 4 ++-- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex index 3a9db5ead..56ce753cd 100644 --- a/doc/refman/RefMan-oth.tex +++ b/doc/refman/RefMan-oth.tex @@ -914,18 +914,18 @@ This command turns off the normal displaying. \subsection[\tt Unset Silent.]{\tt Unset Silent.\optindex{Silent}} This command turns the normal display on. -\subsection[\tt Set Warnings (\nterm{all}|\nterm{none}|\nterm{w}$_1$,\ldots,% - \nterm{w}$_n$).]{{\tt Set Warnings (\nterm{all}|\nterm{none}|\nterm{w}$_1$,\ldots,% - \nterm{w}$_n$)}.\optindex{Warnings}} +\subsection[\tt Set Warnings ``(\nterm{w}$_1$,\ldots,% + \nterm{w}$_n$)''.]{{\tt Set Warnings ``(\nterm{w}$_1$,\ldots,% + \nterm{w}$_n$)''}.\optindex{Warnings}} \label{SetWarnings} -This command configures the display of warnings. It is experimental, and expects -\texttt{all}, \texttt{none} or a comma-separated list of warning names or -categories. Adding~\texttt{-} in front of a warning disables it, -adding~\texttt{+} makes it an error. It is possible to use the special categories -\texttt{all} and \texttt{default}, the latter containing the warnings enabled by -default. The flags are interpreted from left to right, so in case of an overlap, -the flags on the right have higher priority, meaning that \texttt{A,-A} is -equivalent to \texttt{-A}. +This command configures the display of warnings. It is experimental, and +expects, between quotes, a comma-separated list of warning names or +categories. Adding~\texttt{-} in front of a warning or category disables it, +adding~\texttt{+} makes it an error. It is possible to use the special +categories \texttt{all} and \texttt{default}, the latter containing the warnings +enabled by default. The flags are interpreted from left to right, so in case of +an overlap, the flags on the right have higher priority, meaning that +\texttt{A,-A} is equivalent to \texttt{-A}. \subsection[\tt Set Search Output Name Only.]{\tt Set Search Output Name Only.\optindex{Search Output Name Only} \label{Search-Output-Name-Only} diff --git a/toplevel/usage.ml b/toplevel/usage.ml index 2bde1dc46..956a40261 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -61,8 +61,8 @@ let print_usage_channel co command = \n -v print Coq version and exit\ \n -list-tags print highlight color tags known by Coq and exit\ \n\ -\n -quiet unset display of extra information (implies -w none)\ -\n -w (all|none|w1,..,wn) configure display of warnings\ +\n -quiet unset display of extra information (implies -w \"-all\")\ +\n -w (w1,..,wn) configure display of warnings\ \n -color (yes|no|auto) configure color output\ \n\ \n -q skip loading of rcfile\ -- cgit v1.2.3 From 8fe6da32544ee73201f7c64b3dd45afb56c75b71 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Thu, 10 Nov 2016 13:24:54 +0100 Subject: Fix bug in warnings: -w foo was silent when foo did not exist. --- lib/cWarnings.ml | 14 ++++++++++---- toplevel/coqtop.ml | 2 +- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index 1a1944d61..cc2463e22 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -35,6 +35,10 @@ let add_warning_in_category ~name ~category = in Hashtbl.replace categories category (name::ws) +let refine_loc = function + | None when not (Loc.is_ghost !current_loc) -> Some !current_loc + | loc -> loc + let create ~name ~category ?(default=Enabled) pp = Hashtbl.add warnings name { default; category; status = default }; add_warning_in_category ~name ~category; @@ -44,15 +48,17 @@ let create ~name ~category ?(default=Enabled) pp = match w.status with | Disabled -> () | AsError -> - let loc = Option.default !current_loc loc in - CErrors.user_err_loc (loc,"_",pp x) + begin match refine_loc loc with + | Some loc -> CErrors.user_err_loc (loc,"_",pp x) + | None -> CErrors.errorlabstrm "_" (pp x) + end | Enabled -> let msg = pp x ++ spc () ++ str "[" ++ str name ++ str "," ++ str category ++ str "]" in - let loc = Option.default !current_loc loc in - Feedback.msg_warning ~loc msg + let loc = refine_loc loc in + Feedback.msg_warning ?loc msg let warn_unknown_warning = create ~name:"unknown-warning" ~category:"toplevel" diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 5ae1c36ed..d9f8ed881 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -524,7 +524,7 @@ let parse_args arglist = |"-control-channel" -> Spawned.control_channel := get_host_port opt (next()) |"-vio2vo" -> add_compile false (next ()); Flags.compilation_mode := Vio2Vo |"-toploop" -> set_toploop (next ()) - |"-w" | "-W" -> CWarnings.set_flags (next ()) + |"-w" | "-W" -> CWarnings.set_flags (CWarnings.normalize_flags_string (next ())) |"-o" -> Flags.compilation_output_name := Some (next()) (* Options with zero arg *) -- cgit v1.2.3 From 5c78ca4d8fcaa37ab72d91b408223f683c1a48ac Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Mon, 14 Nov 2016 13:57:21 +0100 Subject: Remove the list of bug fixes from CHANGES. We could not produce an exhaustive list of such fixes, and the usefulness of such a list is not clear. --- CHANGES | 126 ++++------------------------------------------------------------ 1 file changed, 6 insertions(+), 120 deletions(-) diff --git a/CHANGES b/CHANGES index 5f4b36151..c08d782b7 100644 --- a/CHANGES +++ b/CHANGES @@ -70,7 +70,10 @@ Tactics for the new flags match, fix and cofix. - The ssreflect subterm selection algorithm is now accessible to tactic writers through the ssrmatching plugin. - +- When used as an argument of an ltac function, "auto" without "with" + nor "using" clause now correctly uses only the core hint database by + default. + Hints - Revised the syntax of [Hint Cut] to follow standard notation for regexps. @@ -119,125 +122,8 @@ Tools Verbose Compat vernacular, since these warnings can now be silenced or turned into errors using "-w". -Bugfixes - -- #2498: Coqide navigation preferences delayed effect -- #3035: Avoiding trailing arguments in the Arguments command -- #3070: fixing "subst" in the presence of a chain of dependencies. -- #3317: spurious type error with primitive projections. -- #3441: Use pf_get_type_of to avoid blowup -- #3450: [End foo.] is slower in trunk in some cases. -- #3683: add references to the web site for the bug tracker -- #3753: anomaly with implicit arguments and renamings -- #3849: hyp_list passing isn't transitive -- #3920: eapply masks an hypothesis name. -- #3957: ML Tactic Extension failure -- #4058: STM: if_verbose on "Checking task ..." -- #4095: constr forces typeclass resolution that it did not previously force -- #4368: CoqIDE: Errors are sticky -- #4421: Messages dialog in Coqide resets. -- #4437: CoqIDE doesn't preserve unix encoding under windows -- #4464: "Anomaly: variable H' unbound. Please report.". -- #4471: [generalize dependent] permits ill-typed terms in trunk. -- #4479: "Error: Rewriting base foo does not exist." should be catchable. -- #4527: when typechecking the statement of a lemma using universe polymorphic - definitions with explicit universe binders, check that the type can indeed be - typechecked using only those universes (after minimization of the other, - flexible universes), or raise an error (fixed scripts can be made forward - compatible). -- #4553: CoqIDE gives warnings about deprecated GTK features. -- #4592, #4932: notations sharing recursive patterns or sharing -- #4592, #4932: notations sharing recursive patterns or sharing - binders made more robust. -- #4595: making notations containing "ltac:" unused for printing. -- #4609: document an option governing the generation of equalities -- #4610: Fails to build with camlp4 since the TACTIC EXTEND move. -- #4622: [injection] on an equality between records with primitive projections - generates a match with invalid information -- #4661: Cannot mask the absolute name. -- #4679: weakened setoid_rewrite unification -- #4723: "Obligations: Cannot infer this placeholder of type" -- #4724: get_host_port error message -- #4726: treat user-provided sorts of universe polymorphic records as rigid - (i.e. non-minimizable). -- #4750: Change format of inconsistent assumptions message. -- #4756: STM: nested Abort is like nested Qed -- #4763, #4955: regressions in unification -- #4764: Syntactic notation externalization breaks. -- #4768: CoqIDE much slower than coqc -quick -- #4780: Induction with universe polymorphism on was creating ill-typed terms. -- #4784: [Set Printing Width] to >= 114 causes (some?) syntax errors to print in - the wrong location, confusing emacs mode -- #4785: use [ ] for vector nil -- #4787: Unset Bracketing Last Introduction Pattern not working. -- #4793: Coq 8.6 should accept -compat 8.6 -- #4798: compat notations should not modify the parser. -- #4816: Global universes and constraints should not depend on local ones -- #4825: [clear] should not dependency-check hypotheses that come above it. -- #4828: "make" broken on Widows -- #4836: Anomaly: Uncaught exception Invalid_argument. -- #4842: Time prints in multiple lines -- #4854: Notations with binders -- #4864: Argument : assert does fail if no arg is given -- #4865: deciding on which arguments to recompute scopes was not robust. -- #4869, allow Prop, Set, and level names in constraints. -- #4873: transparency option not used. -- #4893: not_evar: unexpected failure. -- #4904: [Import] does not load intermediately unqualified names of aliases. -- #4906: regression in printing an error message. -- #4914: LtacProf printout has too many newlines. -- #4919: Warning: Unused local entry "move_location" -- #4923: Warning: appcontext is deprecated. -- #4924: CoqIDE should have an option to use Unix-style newlines on Windows -- #4932: anomaly when using binders as terms in recursive notations. -- #4939: LtacProf prints tactic notations weirdly. -- #4940: Tactic notation printing could be more informative. -- #4941: ~/.coqrc file confusing locations -- #4958: [debug auto] should specify hint databases. -- #4964: Severe inefficiency with evars -- #4968: STM: sideff: report safe_id correctly -- #4978: priorities of Equivalence instances -- #5003: more careful generalisation of dependent terms. -- #5005: micromega tactics is now robust to failure of 'abstract'. -- #5011: Anomaly on [Existing Class]. -- #5023: JSON extraction doesn't generate "for xxx". -- #5029: anomaly on user-inputted projection name. -- #5036: autorewrite, sections and universes -- #5045: [generalize] creates ill-typed terms in 8.6. -- #5048: Casts in pattern raise an anomaly in Constrintern. -- #5051: Large outputs are garbled. -- #5061: Warnings flag has no discernible value -- #5066: Anomaly: cannot find Coq.Logic.JMeq.JMeq. -- #5069: Scheme Equality gives anomalies in sections. -- #5073: regression of micromega plugin -- #5078: wrong detection of evaluable local hypotheses. -- #5079: LtacProf: fix reset_profile -- #5080: LtacProf: "Show Ltac Profile CutOff $N" -- #5087: Improve the error message on record with duplicated fields. -- #5090: Effect of -Q depends on coqtop's current directory. -- #5093: typeclasses eauto depth arg does not accept a var. -- #5096: [vm_compute] is exponentially slower than [native_compute]. -- #5098: Symmetry broken in HoTT. -- #5102: "Illegal begin of vernac" on bullets -- #5116: [Print Ltac] should be able to print strategies. -- #5125: Bad error message when attempting to use where with Class. -- #5133: error reporting delayed. -- #5136: Stopping warning on unrecognized unicode character in notation. -- #5139: Anomalies should not be caught by || / try. -- #5141: Bogus message "Error: Cannot infer type of pattern-matching". -- #5145: Anomaly: index to an anonymous variable. -- #5149: [subst] breaks evars -- #5161: case of a notation with unability to detect a recursive binder. -- #5164: regression in locating error in argument of "refine". -- #5181: [Arguments] no longer correctly checks the length of arguments lists -- #5182: "Arguments names must be distinct." is bogus and underinformative -- Qcanon : fix names of lemmas Qcle_alt & Qcge_alt (were Qle_alt & Qge_alt) -- When used as an argument of an ltac function, "auto" without "with" - nor "using" clause now correctly uses only the core hint database by - default. - -Some other fixes, minor changes and documentation improvements are not -mentionned here. +Many bug fixes, minor changes and documentation improvements are not mentioned +here. Changes from V8.5pl2 to V8.5pl3 =============================== -- cgit v1.2.3 From 36fd5ebe558b8a51c2929077bde9f0460c4313c3 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Mon, 14 Nov 2016 14:08:31 +0100 Subject: Set version number to 8.6beta1. --- INSTALL | 4 ++-- configure.ml | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/INSTALL b/INSTALL index 5a300010d..df9e85527 100644 --- a/INSTALL +++ b/INSTALL @@ -1,5 +1,5 @@ - INSTALLATION PROCEDURES FOR THE COQ V8.5 SYSTEM + INSTALLATION PROCEDURES FOR THE COQ V8.6 SYSTEM ----------------------------------------------- @@ -27,7 +27,7 @@ WHAT DO YOU NEED ? port install coq - To compile Coq V8.5 yourself, you need: + To compile Coq V8.6 yourself, you need: - Objective Caml version 4.01.0 or later (available at http://caml.inria.fr/) diff --git a/configure.ml b/configure.ml index 507fd351a..b97bf9a71 100644 --- a/configure.ml +++ b/configure.ml @@ -11,11 +11,11 @@ #load "str.cma" open Printf -let coq_version = "8.6.0" -let coq_macos_version = "8.4.90" (** "[...] should be a string comprised of +let coq_version = "8.6beta1" +let coq_macos_version = "8.5.90" (** "[...] should be a string comprised of three non-negative, period-separated integers [...]" *) -let vo_magic = 8511 -let state_magic = 58511 +let vo_magic = 8591 +let state_magic = 58591 let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr"; "coqdoc";"coq_makefile";"coq-tex";"gallina";"coqwc";"csdpcert";"coqdep"] -- cgit v1.2.3 From dfefd12ee432e5b0d145934e74bb939ddecfa522 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Mon, 14 Nov 2016 14:09:08 +0100 Subject: Remove README.win until we come up with new instructions. The recommended way to install Coq under windows is anyway to use the precompiled installer. --- README.win | 44 -------------------------------------- dev/build/windows/makecoq_mingw.sh | 1 - 2 files changed, 45 deletions(-) delete mode 100644 README.win diff --git a/README.win b/README.win deleted file mode 100644 index 8302a707f..000000000 --- a/README.win +++ /dev/null @@ -1,44 +0,0 @@ -THE COQ V8 SYSTEM -================= - - This file contains remarks specific to the windows port of Coq. - -INSTALLATION. -============= - - The Coq package for Windows comes with an auto-installer. It will -install Coq binaries and libraries under any directory you specify -(C:\Coq is the default path). It also creates shortcuts -in the Windows menus. Binaries, like coqc.exe, -are in the bin sub-directory of the installation -(C:\Coq\bin by default). - -COMPILATION. -============ - - If you want to install coq, you had better transfer the precompiled - distribution. If you really need to recompile under Windows, here - are some indications: - - 1- Install cygwin and the wget package - See: http://cygwin.com - - 2- Download and unzip in C:\ the SDK for windows - See: https://coq.inria.fr/distrib/current/files/ - - 3- From the cygwin prompt type - - . /cygdrive/c/CoqSDK-85-1/environ - - The first time the script installs the C toolchain. - - 4- Then Coq can be compiled as follows: - - ./configure -local - make - - 5- To build the installer, type: - - dev/make-installer-win32.sh - - The Coq Team. diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index bfc7ce4dd..52b158871 100644 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -1029,7 +1029,6 @@ function copy_coq_license { install -D plugins/micromega/LICENSE.sos $PREFIXCOQ/license_readme/coq/LicenseMicromega.txt install -D README $PREFIXCOQ/license_readme/coq/ReadMe.txt || true install -D README.md $PREFIXCOQ/license_readme/coq/ReadMe.md || true - install -D README.win $PREFIXCOQ/license_readme/coq/ReadMeWindows.txt install -D README.doc $PREFIXCOQ/license_readme/coq/ReadMeDoc.txt install -D CHANGES $PREFIXCOQ/license_readme/coq/Changes.txt install -D INSTALL $PREFIXCOQ/license_readme/coq/Install.txt -- cgit v1.2.3 From 4b8f19c58a2b6cc841db2c011d23aa8106211fd6 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Tue, 15 Nov 2016 13:53:57 +0100 Subject: Revert part of a477dc, disallow_shelved In only_classes mode we do not try to implement a stricter semantics for shelved goals in 8.6. Leaving this for 8.7. Update the documentation as well. Remove a spurious printf call as well. Fix test-suite now that shelved goals are allowed --- doc/refman/Classes.tex | 13 ++++++------- tactics/class_tactics.ml | 24 +----------------------- test-suite/bugs/closed/3513.v | 3 ++- test-suite/bugs/closed/4095.v | 4 ++-- test-suite/success/Typeclasses.v | 2 +- test-suite/success/bteauto.v | 6 +++--- 6 files changed, 15 insertions(+), 37 deletions(-) diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index 58ae7191f..7c4bd4d20 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -392,13 +392,12 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: backtracking on subgoals that are entirely independent. \item When called with no arguments, {\tt typeclasses eauto} uses the {\tt typeclass\_instances} database by default (instead of {\tt core}) - and will try to solve \emph{only} typeclass goals. If some subgoal of - a hint/instance is non-dependent and not of class type, that hint - application will fail. Dependent subgoals are automatically shelved - and \emph{must be} resolved entirely when the other typeclass subgoals - are resolved or the proof search will fail \emph{globally}, - \emph{without} the possibility to find another complete solution with - no shelved subgoals. + and will try to solve \emph{only} typeclass goals, shelving the other + goals. If some subgoal of a hint/instance is non-dependent and not of + class type, the hint application will fail when faced with that + subgoal. Dependent subgoals are automatically shelved, and shelved + goals can remain after resolution ends (following the behavior of + \Coq{} 8.5). \emph{Note: } As of Coq 8.6, {\tt all:once (typeclasses eauto)} faithfully mimicks what happens during typeclass resolution when it is diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 262b30893..99a1a9899 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1176,7 +1176,7 @@ module Search = struct (fun e' -> if CErrors.noncritical (fst e') then (pr_error e'; aux (merge_exceptions e e') tl) - else (Printf.printf "raising again\n%!"; iraise e')) + else iraise e') and aux e = function | x :: xs -> onetac e x xs | [] -> @@ -1274,27 +1274,6 @@ module Search = struct | (e,ie) -> Proofview.tclZERO ~info:ie e) in aux 1 - let disallow_shelved initshelf tac = - let open Proofview in - let casefn = function - | Fail (e,info) -> tclZERO ~info e - | Next ((shelved, result), k) -> - if not (List.is_empty shelved) then - begin - Proofview.tclEVARMAP >>= fun sigma -> - let gls = prlist_with_sep spc (pr_ev sigma) shelved in - (if !typeclasses_debug > 0 then - let initgls = prlist_with_sep spc (pr_ev sigma) initshelf in - Feedback.msg_debug (str"Non-empty shelf at end of resolution:" ++ gls - ++ str" initially: " ++ initgls ++ str".")); - Tacticals.New.tclZEROMSG (str"Proof search failed: " ++ - str"shelved goals remain: " ++ gls) - end - else - tclOR (tclUNIT result) (fun e -> k e >>= fun (gls, result) -> tclUNIT result) - in - tclCASE (with_shelf tac) >>= casefn - let eauto_tac ?(st=full_transparent_state) ?(unique=false) ~only_classes ?strategy ~depth ~dep hints = let open Proofview in @@ -1342,7 +1321,6 @@ module Search = struct str " in regular mode" ++ match depth with None -> str ", unbounded" | Some i -> str ", with depth limit " ++ int i)); - let tac = if only_classes then disallow_shelved initshelf tac else tac in tac let run_on_evars p evm tac = diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v index ff515038e..9ed0926a6 100644 --- a/test-suite/bugs/closed/3513.v +++ b/test-suite/bugs/closed/3513.v @@ -89,5 +89,6 @@ Debug: 2.2.1.1.1.1: apply ILFun_ILogic on (ILogic OPred) Show Existentials. Set Typeclasses Debug Verbosity 2. Set Printing All. - Fail apply reflexivity. + (* As in 8.5, allow a shelved subgoal to remain *) + apply reflexivity. \ No newline at end of file diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v index 83d4ed69d..ffd33d381 100644 --- a/test-suite/bugs/closed/4095.v +++ b/test-suite/bugs/closed/4095.v @@ -1,10 +1,10 @@ (* File reduced by coq-bug-finder from original input, then from 5752 lines to 3828 lines, then from 2707 lines to 558 lines, then from 472 lines to 168 lines, then from 110 lines to 101 lines, then from 96 lines to 77 lines, then from 80 lines to 64 lines, then from 92 lines to 79 lines *) (* coqc version 8.5beta1 (February 2015) compiled on Feb 23 2015 18:32:3 with OCaml 4.01.0 coqtop version cagnode15:/afs/csail.mit.edu/u/j/jgross/coq-8.5,v8.5 (ebfc19d792492417b129063fb511aa423e9d9e08) *) -Require Import TestSuite.admit. Require Import Coq.Setoids.Setoid. Generalizable All Variables. Axiom admit : forall {T}, T. +Ltac admit := apply admit. Class Equiv (A : Type) := equiv : relation A. Class type (A : Type) {e : Equiv A} := eq_equiv : Equivalence equiv. Class ILogicOps Frm := { lentails: relation Frm; @@ -71,7 +71,7 @@ Goal forall (T : Type) (O0 : T -> OPred) (O1 : T -> PointedOPred) refine (P _ _) end. Undo. - lazymatch goal with + Fail lazymatch goal with | |- ?R (?f ?a ?b) (?f ?a' ?b') => let P := constr:(fun H H' => Morphisms.proper_prf a a' H b b' H') in set(p:=P) diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index 6885717ec..5557ba837 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -6,7 +6,7 @@ Module onlyclasses. Goal Foo * Foo. split. shelve. Set Typeclasses Debug. - Fail typeclasses eauto. + Fail (unshelve typeclasses eauto); fail. typeclasses eauto with typeclass_instances. Unshelve. typeclasses eauto with typeclass_instances. Qed. diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v index 3178c6fc1..0af367781 100644 --- a/test-suite/success/bteauto.v +++ b/test-suite/success/bteauto.v @@ -24,9 +24,9 @@ Module Backtracking. Fail all:((once (typeclasses eauto with typeclass_instances)) + apply eq_refl). (* Does backtrack if other goals fail *) - all:[> typeclasses eauto + reflexivity .. ]. + all:[> (unshelve typeclasses eauto; fail) + reflexivity .. ]. Undo 1. - all:(typeclasses eauto + reflexivity). (* Note "+" is a focussing combinator *) + all:((unshelve typeclasses eauto; fail) + reflexivity). (* Note "+" is a focussing combinator *) Show Proof. Qed. @@ -66,7 +66,7 @@ Module Backtracking. unshelve evar (t : A). all:cycle 1. refine (@ex_intro _ _ t _). all:cycle 1. - all:(typeclasses eauto + reflexivity). + all:((unshelve typeclasses eauto; fail) + reflexivity). Qed. End Leivant. End Backtracking. -- cgit v1.2.3 From 1053c873bdaedf37c1fd35be4e7021bfc806c23d Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Wed, 16 Nov 2016 11:17:39 +0100 Subject: [doc] Mention XML protocol on changes. It may be worth it, also added a note about file reorganization. --- CHANGES | 5 +++++ dev/doc/changes.txt | 2 ++ 2 files changed, 7 insertions(+) diff --git a/CHANGES b/CHANGES index c08d782b7..984e91946 100644 --- a/CHANGES +++ b/CHANGES @@ -104,6 +104,7 @@ Notations - "Bind Scope" can once again bind "Funclass" and "Sortclass". General infrastructure + - New configurable warning system which can be controlled with the vernacular command "Set Warnings", or, under coqc/coqtop, with the flag "-w". In particular, the default is now that warnings are printed by coqc. @@ -122,6 +123,10 @@ Tools Verbose Compat vernacular, since these warnings can now be silenced or turned into errors using "-w". +XML protocol + +- message format has changed, see dev/doc/changes.txt for more details. + Many bug fixes, minor changes and documentation improvements are not mentioned here. diff --git a/dev/doc/changes.txt b/dev/doc/changes.txt index 79a0c6312..d052468f9 100644 --- a/dev/doc/changes.txt +++ b/dev/doc/changes.txt @@ -14,6 +14,8 @@ kernel/closure.ml{,i} -> kernel/cClosure.ml{,i} lib/errors.ml{,i} -> lib/cErrors.ml{,i} toplevel/cerror.ml{,i} -> toplevel/explainErr.mli{,i} +All IDE-specific files, including the XML protocol have been moved to ide/ + ** Reduction functions ** In closure.ml, we introduced the more precise reduction flags fMATCH, fFIX, -- cgit v1.2.3 From 09fd1e8b5e810bae0e50ecd4901cd7c8f1464f4a Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 16 Nov 2016 10:45:25 +0100 Subject: Revert more of a477dc for good measure We stop failing automatically on non-declared-class nested or toplevel subgoals as in 8.5, instead of the previous a477dc behavior of shelving those goals and failing if shelved goals remained at the end of resolution. It means typeclass resolution during refinement is closer to all:typeclasses eauto. Hints in typeclass_instances for non-declared classes can be used during resolution of _nested_ subgoals when it is fired from type-inference, toplevel goals considered in this case are still only classes (as in 8.5 and before). The code that triggers the restriction to only declared class subgoals is commented. Revert changes to test-suite, adding test for #5203, #5198 is fixed too. Add corresponding tests in the test-suite (that will break if we, e.g. disallow non-class subgoals) and update the refman accordingly. --- doc/refman/Classes.tex | 16 +++++++------- tactics/class_tactics.ml | 7 +++--- test-suite/bugs/closed/5198.v | 39 ++++++++++++++++++++++++++++++++++ test-suite/bugs/closed/5203.v | 5 +++++ test-suite/success/Typeclasses.v | 46 ++++++++++++++++++++++++++++++++++------ test-suite/success/bteauto.v | 6 +++--- 6 files changed, 99 insertions(+), 20 deletions(-) create mode 100644 test-suite/bugs/closed/5198.v create mode 100644 test-suite/bugs/closed/5203.v diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index 7c4bd4d20..bd8ee450e 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -391,19 +391,19 @@ than {\tt eauto} and {\tt auto}. The main differences are the following: It analyses the dependencies between subgoals to avoid backtracking on subgoals that are entirely independent. \item When called with no arguments, {\tt typeclasses eauto} uses the - {\tt typeclass\_instances} database by default (instead of {\tt core}) - and will try to solve \emph{only} typeclass goals, shelving the other - goals. If some subgoal of a hint/instance is non-dependent and not of - class type, the hint application will fail when faced with that - subgoal. Dependent subgoals are automatically shelved, and shelved + {\tt typeclass\_instances} database by default (instead of {\tt + core}). + Dependent subgoals are automatically shelved, and shelved goals can remain after resolution ends (following the behavior of \Coq{} 8.5). \emph{Note: } As of Coq 8.6, {\tt all:once (typeclasses eauto)} faithfully mimicks what happens during typeclass resolution when it is - called during refinement/type-inference. It might move to {\tt - all:typeclasses eauto} in future versions when the refinement engine - will be able to backtrack. + called during refinement/type-inference, except that \emph{only} + declared class subgoals are considered at the start of resolution + during type inference, while ``all'' can select non-class subgoals as + well. It might move to {\tt all:typeclasses eauto} in future versions + when the refinement engine will be able to backtrack. \item When called with specific databases (e.g. {\tt with}), {\tt typeclasses eauto} allows shelved goals to remain at any point during search and treat typeclasses goals like any other. diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 99a1a9899..4138562c6 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1167,7 +1167,8 @@ module Search = struct if path_matches derivs [] then aux e tl else let filter = - if info.search_only_classes then fail_if_nonclass info + if false (* in 8.6, still allow non-class subgoals + info.search_only_classes *) then fail_if_nonclass info else Proofview.tclUNIT () in ortac @@ -1238,8 +1239,8 @@ module Search = struct unit Proofview.tactic = let open Proofview in let open Proofview.Notations in - if only_classes && not (is_class_type sigma (Goal.concl gl)) then - Proofview.shelve + if false (* In 8.6, still allow non-class goals only_classes && not (is_class_type sigma (Goal.concl gl)) *) then + Tacticals.New.tclZEROMSG (str"Not a subgoal for a class") else let dep = dep || Proofview.unifiable sigma (Goal.goal gl) gls in let info = make_autogoal ?st only_classes dep (cut_of_hints hints) i gl in diff --git a/test-suite/bugs/closed/5198.v b/test-suite/bugs/closed/5198.v new file mode 100644 index 000000000..7254afb42 --- /dev/null +++ b/test-suite/bugs/closed/5198.v @@ -0,0 +1,39 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-boot" "-nois") -*- *) +(* File reduced by coq-bug-finder from original input, then from 286 lines to +27 lines, then from 224 lines to 53 lines, then from 218 lines to 56 lines, +then from 269 lines to 180 lines, then from 132 lines to 48 lines, then from +253 lines to 65 lines, then from 79 lines to 65 lines *) +(* coqc version 8.6.0 (November 2016) compiled on Nov 12 2016 14:43:52 with +OCaml 4.02.3 + coqtop version jgross-Leopard-WS:/home/jgross/Downloads/coq/coq-v8.6,v8.6 +(7e992fa784ee6fa48af8a2e461385c094985587d) *) +Axiom admit : forall {T}, T. +Set Printing Implicit. +Inductive nat := O | S (_ : nat). +Axiom f : forall (_ _ : nat), nat. +Class ZLikeOps (e : nat) + := { LargeT : Type ; SmallT : Type ; CarryAdd : forall (_ _ : LargeT), LargeT +}. +Class BarrettParameters := + { b : nat ; k : nat ; ops : ZLikeOps (f b k) }. +Axiom barrett_reduce_function_bundled : forall {params : BarrettParameters} + (_ : @LargeT _ (@ops params)), + @SmallT _ (@ops params). + +Global Instance ZZLikeOps e : ZLikeOps (f (S O) e) + := { LargeT := nat ; SmallT := nat ; CarryAdd x y := y }. +Definition SRep := nat. +Local Instance x86_25519_Barrett : BarrettParameters + := { b := S O ; k := O ; ops := ZZLikeOps O }. +Definition SRepAdd : forall (_ _ : SRep), SRep + := let v := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)) in + v. +Definition SRepAdd' : forall (_ _ : SRep), SRep + := (fun x y => barrett_reduce_function_bundled (CarryAdd x y)). +(* Error: +In environment +x : SRep +y : SRep +The term "x" has type "SRep" while it is expected to have type + "@LargeT ?e ?ZLikeOps". + *) diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v new file mode 100644 index 000000000..ed137395f --- /dev/null +++ b/test-suite/bugs/closed/5203.v @@ -0,0 +1,5 @@ +Goal True. + Typeclasses eauto := debug. + Fail solve [ typeclasses eauto ]. + Fail typeclasses eauto. + \ No newline at end of file diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v index 5557ba837..f62427ef4 100644 --- a/test-suite/success/Typeclasses.v +++ b/test-suite/success/Typeclasses.v @@ -1,15 +1,28 @@ Module onlyclasses. +(* In 8.6 we still allow non-class subgoals *) Variable Foo : Type. Variable foo : Foo. Hint Extern 0 Foo => exact foo : typeclass_instances. Goal Foo * Foo. split. shelve. Set Typeclasses Debug. - Fail (unshelve typeclasses eauto); fail. - typeclasses eauto with typeclass_instances. - Unshelve. typeclasses eauto with typeclass_instances. + typeclasses eauto. + Unshelve. typeclasses eauto. Qed. + + Module RJung. + Class Foo (x : nat). + + Instance foo x : x = 2 -> Foo x. + Hint Extern 0 (_ = _) => reflexivity : typeclass_instances. + Typeclasses eauto := debug. + Check (_ : Foo 2). + + + Fail Definition foo := (_ : 0 = 0). + + End RJung. End onlyclasses. Module shelve_non_class_subgoals. @@ -17,16 +30,36 @@ Module shelve_non_class_subgoals. Variable foo : Foo. Hint Extern 0 Foo => exact foo : typeclass_instances. Class Bar := {}. - Instance bar1 (f:Foo) : Bar. + Instance bar1 (f:Foo) : Bar := {}. Typeclasses eauto := debug. Set Typeclasses Debug Verbosity 2. Goal Bar. (* Solution has shelved subgoals (of non typeclass type) *) - Fail typeclasses eauto. + typeclasses eauto. Abort. End shelve_non_class_subgoals. +Module RefineVsNoTceauto. + + Class Foo (A : Type) := foo : A. + Instance: Foo nat := { foo := 0 }. + Instance: Foo nat := { foo := 42 }. + Hint Extern 0 (_ = _) => refine eq_refl : typeclass_instances. + Goal exists (f : Foo nat), @foo _ f = 0. + Proof. + unshelve (notypeclasses refine (ex_intro _ _ _)). + Set Typeclasses Debug. Set Printing All. + all:once (typeclasses eauto). + Fail idtac. (* Check no subgoals are left *) + Undo 3. + (** In this case, the (_ = _) subgoal is not considered + by typeclass resolution *) + refine (ex_intro _ _ _). Fail reflexivity. + Abort. + +End RefineVsNoTceauto. + Module Leivantex2PR339. (** Was a bug preventing to find hints associated with no pattern *) Class Bar := {}. @@ -34,8 +67,9 @@ Module Leivantex2PR339. Hint Extern 0 => exact True : typeclass_instances. Typeclasses eauto := debug. Goal Bar. - Fail typeclasses eauto. Set Typeclasses Debug Verbosity 2. + typeclasses eauto. (* Relies on resolution of a non-class subgoal *) + Undo 1. typeclasses eauto with typeclass_instances. Qed. End Leivantex2PR339. diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v index 0af367781..3178c6fc1 100644 --- a/test-suite/success/bteauto.v +++ b/test-suite/success/bteauto.v @@ -24,9 +24,9 @@ Module Backtracking. Fail all:((once (typeclasses eauto with typeclass_instances)) + apply eq_refl). (* Does backtrack if other goals fail *) - all:[> (unshelve typeclasses eauto; fail) + reflexivity .. ]. + all:[> typeclasses eauto + reflexivity .. ]. Undo 1. - all:((unshelve typeclasses eauto; fail) + reflexivity). (* Note "+" is a focussing combinator *) + all:(typeclasses eauto + reflexivity). (* Note "+" is a focussing combinator *) Show Proof. Qed. @@ -66,7 +66,7 @@ Module Backtracking. unshelve evar (t : A). all:cycle 1. refine (@ex_intro _ _ t _). all:cycle 1. - all:((unshelve typeclasses eauto; fail) + reflexivity). + all:(typeclasses eauto + reflexivity). Qed. End Leivant. End Backtracking. -- cgit v1.2.3 From 37e0ce25f88a77c48c480e37ccca444a8f5fe4e8 Mon Sep 17 00:00:00 2001 From: Matthieu Sozeau Date: Wed, 16 Nov 2016 16:22:53 +0100 Subject: Minor debug printing bug, Hit by OCaml's "if then else" with no "end" once more --- tactics/class_tactics.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 4138562c6..e44ace425 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1318,10 +1318,9 @@ module Search = struct Feedback.msg_debug (str"Starting resolution with " ++ int i ++ str" goal(s) under focus and " ++ int (List.length initshelf) ++ str " shelved goal(s)" ++ - if only_classes then str " in only_classes mode" else - str " in regular mode" ++ - match depth with None -> str ", unbounded" - | Some i -> str ", with depth limit " ++ int i)); + (if only_classes then str " in only_classes mode" else str " in regular mode") ++ + match depth with None -> str ", unbounded" + | Some i -> str ", with depth limit " ++ int i)); tac let run_on_evars p evm tac = -- cgit v1.2.3 From 26d180fa0b27edc773fd07c73906e4ed56475200 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Wed, 16 Nov 2016 10:51:39 +0100 Subject: [stm] Remove STM-related vernaculars I think these commands never make a lot of sense on scripts other than debugging and we have better methods now. The last remaining command, used for the tty emulation has been renamed to VtBack, but it should go away at some point too once the legacy interfaces are removed. --- ide/texmacspp.ml | 3 --- intf/vernacexpr.mli | 23 +-------------------- parsing/g_vernac.ml4 | 10 ---------- printing/ppvernac.ml | 16 --------------- stm/stm.ml | 51 +++++++++++++---------------------------------- stm/vernac_classifier.ml | 22 ++++---------------- toplevel/vernac.ml | 3 +-- toplevel/vernacentries.ml | 4 ---- 8 files changed, 20 insertions(+), 112 deletions(-) diff --git a/ide/texmacspp.ml b/ide/texmacspp.ml index 680da7f54..dbcd8630b 100644 --- a/ide/texmacspp.ml +++ b/ide/texmacspp.ml @@ -724,9 +724,6 @@ let rec tmpp v loc = | VernacComments (cl) -> xmlComment loc (List.flatten (List.map pp_comment cl)) - (* Stm backdoor *) - | VernacStm _ as x -> xmlTODO loc x - (* Proof management *) | VernacGoal _ as x -> xmlTODO loc x | VernacAbort _ as x -> xmlTODO loc x diff --git a/intf/vernacexpr.mli b/intf/vernacexpr.mli index 92e4dd618..f77a940a7 100644 --- a/intf/vernacexpr.mli +++ b/intf/vernacexpr.mli @@ -283,16 +283,6 @@ type bullet = | Star of int | Plus of int -(** {6 Types concerning Stm} *) -type 'a stm_vernac = - | JoinDocument - | Finish - | Wait - | PrintDag - | Observe of Stateid.t - | Command of 'a (* An out of flow command not to be recorded by Stm *) - | PGLast of 'a (* To ease the life of PG *) - (** {6 Types concerning the module layer} *) (** Rigid / flexible module signature *) @@ -451,9 +441,6 @@ type vernac_expr = | VernacRegister of lident * register_kind | VernacComments of comment list - (* Stm backdoor *) - | VernacStm of vernac_expr stm_vernac - (* Proof management *) | VernacGoal of constr_expr | VernacAbort of lident option @@ -508,7 +495,7 @@ type vernac_type = | VtProofStep of proof_step | VtProofMode of string | VtQuery of vernac_part_of_script * report_with - | VtStm of vernac_control * vernac_part_of_script + | VtBack of Stateid.t * vernac_part_of_script | VtUnknown and report_with = Stateid.t * Feedback.route_id (* feedback on id/route *) and vernac_qed_type = VtKeep | VtKeepAsAxiom | VtDrop (* Qed/Admitted, Abort *) @@ -516,14 +503,6 @@ and vernac_start = string * opacity_guarantee * Id.t list and vernac_sideff_type = Id.t list and vernac_is_alias = bool and vernac_part_of_script = bool -and vernac_control = - | VtFinish - | VtWait - | VtJoinDocument - | VtPrintDag - | VtObserve of Stateid.t - | VtBack of Stateid.t - | VtPG and opacity_guarantee = | GuaranteesOpacity (** Only generates opaque terms at [Qed] *) | Doesn'tGuaranteeOpacity (** May generate transparent terms even with [Qed].*) diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index 9b52d1bf3..4ba9eeefa 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -64,16 +64,6 @@ GEXTEND Gram | IDENT "Local"; v = vernac_poly -> VernacLocal (true, v) | IDENT "Global"; v = vernac_poly -> VernacLocal (false, v) - (* Stm backdoor *) - | IDENT "Stm"; IDENT "JoinDocument"; "." -> VernacStm JoinDocument - | IDENT "Stm"; IDENT "Finish"; "." -> VernacStm Finish - | IDENT "Stm"; IDENT "Wait"; "." -> VernacStm Wait - | IDENT "Stm"; IDENT "PrintDag"; "." -> VernacStm PrintDag - | IDENT "Stm"; IDENT "Observe"; id = INT; "." -> - VernacStm (Observe (Stateid.of_int (int_of_string id))) - | IDENT "Stm"; IDENT "Command"; v = vernac_aux -> VernacStm (Command v) - | IDENT "Stm"; IDENT "PGLast"; v = vernac_aux -> VernacStm (PGLast v) - | v = vernac_poly -> v ] ] ; diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index 3494ad006..a6b1c97f5 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -538,22 +538,6 @@ module Make | VernacLocal (local, v) -> return (pr_locality local ++ spc() ++ pr_vernac_body v) - (* Stm *) - | VernacStm JoinDocument -> - return (keyword "Stm JoinDocument") - | VernacStm PrintDag -> - return (keyword "Stm PrintDag") - | VernacStm Finish -> - return (keyword "Stm Finish") - | VernacStm Wait -> - return (keyword "Stm Wait") - | VernacStm (Observe id) -> - return (keyword "Stm Observe " ++ str(Stateid.to_string id)) - | VernacStm (Command v) -> - return (keyword "Stm Command " ++ pr_vernac_body v) - | VernacStm (PGLast v) -> - return (keyword "Stm PGLast " ++ pr_vernac_body v) - (* Proof management *) | VernacAbortAll -> return (keyword "Abort All") diff --git a/stm/stm.ml b/stm/stm.ml index e387e6322..0ddaf604a 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -989,7 +989,7 @@ end = struct (* {{{ *) try match v with | VernacResetInitial -> - VtStm (VtBack Stateid.initial, true), VtNow + VtBack (Stateid.initial, true), VtNow | VernacResetName (_,name) -> let id = VCS.get_branch_pos (VCS.current_branch ()) in (try @@ -997,20 +997,20 @@ end = struct (* {{{ *) fold_until (fun b (id,_,label,_,_) -> if b then `Stop id else `Cont (List.mem name label)) false id in - VtStm (VtBack oid, true), VtNow + VtBack (oid, true), VtNow with Not_found -> - VtStm (VtBack id, true), VtNow) + VtBack (id, true), VtNow) | VernacBack n -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun n (id,_,_,_,_) -> if Int.equal n 0 then `Stop id else `Cont (n-1)) n id in - VtStm (VtBack oid, true), VtNow + VtBack (oid, true), VtNow | VernacUndo n -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun n (id,_,_,tactic,undo) -> let value = (if tactic then 1 else 0) - undo in if Int.equal n 0 then `Stop id else `Cont (n-value)) n id in - VtStm (VtBack oid, true), VtLater + VtBack (oid, true), VtLater | VernacUndoTo _ | VernacRestart as e -> let m = match e with VernacUndoTo m -> m | _ -> 0 in @@ -1027,16 +1027,16 @@ end = struct (* {{{ *) 0 id in let oid = fold_until (fun n (id,_,_,_,_) -> if Int.equal n 0 then `Stop id else `Cont (n-1)) (n-m-1) id in - VtStm (VtBack oid, true), VtLater + VtBack (oid, true), VtLater | VernacAbortAll -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun () (id,vcs,_,_,_) -> match Vcs_.branches vcs with [_] -> `Stop id | _ -> `Cont ()) () id in - VtStm (VtBack oid, true), VtLater + VtBack (oid, true), VtLater | VernacBacktrack (id,_,_) | VernacBackTo id -> - VtStm (VtBack (Stateid.of_int id), not !Flags.print_emacs), VtNow + VtBack (Stateid.of_int id, not !Flags.print_emacs), VtNow | _ -> VtUnknown, VtNow with | Not_found -> @@ -2428,22 +2428,8 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty prerr_endline (fun () -> " classified as: " ^ string_of_vernac_classification c); match c with - (* PG stuff *) - | VtStm(VtPG,false), VtNow -> vernac_interp Stateid.dummy x; `Ok - | VtStm(VtPG,_), _ -> anomaly(str "PG command in script or VtLater") - (* Joining various parts of the document *) - | VtStm (VtJoinDocument, b), VtNow -> join (); `Ok - | VtStm (VtFinish, b), VtNow -> finish (); `Ok - | VtStm (VtWait, b), VtNow -> finish (); wait (); `Ok - | VtStm (VtPrintDag, b), VtNow -> - VCS.print ~now:true (); `Ok - | VtStm (VtObserve id, b), VtNow -> observe id; `Ok - | VtStm ((VtObserve _ | VtFinish | VtJoinDocument - |VtPrintDag |VtWait),_), VtLater -> - anomaly(str"classifier: join actions cannot be classified as VtLater") - (* Back *) - | VtStm (VtBack oid, true), w -> + | VtBack(oid, true), w -> let id = VCS.new_node ~id:newtip () in let { mine; others } = Backtrack.branches_of oid in let valid = VCS.get_branch_pos head in @@ -2462,12 +2448,12 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty VCS.checkout_shallowest_proof_branch (); VCS.commit id (Alias (oid,x)); Backtrack.record (); if w == VtNow then finish (); `Ok - | VtStm (VtBack id, false), VtNow -> + | VtBack (id, false), VtNow -> prerr_endline (fun () -> "undo to state " ^ Stateid.to_string id); Backtrack.backto id; VCS.checkout_shallowest_proof_branch (); Reach.known_state ~cache:(interactive ()) id; `Ok - | VtStm (VtBack id, false), VtLater -> + | VtBack (id, false), VtLater -> anomaly(str"classifier: VtBack + VtLater must imply part_of_script") (* Query *) @@ -2604,15 +2590,6 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty | VtUnknown, VtLater -> anomaly(str"classifier: VtUnknown must imply VtNow") end in - (* Proof General *) - begin match expr with - | VernacStm (PGLast _) -> - if not (VCS.Branch.equal head VCS.Branch.master) then - vernac_interp Stateid.dummy - { verbose = true; loc = Loc.ghost; indentation = 0; strlen = 0; - expr = VernacShow (ShowGoal OpenSubgoals) } - | _ -> () - end; prerr_endline (fun () -> "processed }}}"); VCS.print (); rc @@ -2674,8 +2651,8 @@ let query ~at ?(report_with=(Stateid.dummy,default_route)) s = let clas = classify_vernac ast in let aast = { verbose = true; indentation; strlen; loc; expr = ast } in match clas with - | VtStm (w,_), _ -> - ignore(process_transaction ~tty:false aast (VtStm (w,false), VtNow)) + | VtBack (w,_), _ -> + ignore(process_transaction ~tty:false aast (VtBack (w,false), VtNow)) | _ -> ignore(process_transaction ~tty:false aast (VtQuery (false,report_with), VtNow))) @@ -2822,7 +2799,7 @@ let interp verb (loc,e) = let print_goals = verb && match clas with | VtQuery _, _ -> false - | (VtProofStep _ | VtStm (VtBack _, _) | VtStartProof _), _ -> true + | (VtProofStep _ | VtBack (_, _) | VtStartProof _), _ -> true | _ -> not !Flags.coqtop_ui in try finish ~print_goals () with e -> diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml index dc5be08a3..f9bf9653f 100644 --- a/stm/vernac_classifier.ml +++ b/stm/vernac_classifier.ml @@ -33,10 +33,7 @@ let string_of_vernac_type = function | VtQuery (b,(id,route)) -> "Query " ^ string_of_in_script b ^ " report " ^ Stateid.to_string id ^ " route " ^ string_of_int route - | VtStm ((VtFinish|VtJoinDocument|VtObserve _|VtPrintDag|VtWait), b) -> - "Stm " ^ string_of_in_script b - | VtStm (VtPG, b) -> "Stm PG " ^ string_of_in_script b - | VtStm (VtBack _, b) -> "Stm Back " ^ string_of_in_script b + | VtBack(_, b) -> "Stm Back " ^ string_of_in_script b let string_of_vernac_when = function | VtLater -> "Later" @@ -55,7 +52,7 @@ let declare_vernac_classifier let elide_part_of_script_and_now (a, _) = match a with | VtQuery (_,id) -> VtQuery (false,id), VtNow - | VtStm (x, _) -> VtStm (x, false), VtNow + | VtBack (x, _) -> VtBack (x, false), VtNow | x -> x, VtNow let make_polymorphic (a, b as x) = @@ -69,23 +66,12 @@ let set_undo_classifier f = undo_classifier := f let rec classify_vernac e = let static_classifier e = match e with - (* PG compatibility *) - | VernacUnsetOption (["Silent"]|["Undo"]|["Printing";"Depth"]) - | VernacSetOption ((["Silent"]|["Undo"]|["Printing";"Depth"]),_) - when !Flags.print_emacs -> VtStm(VtPG,false), VtNow (* Univ poly compatibility: we run it now, so that we can just * look at Flags in stm.ml. Would be nicer to have the stm * look at the entire dag to detect this option. *) | VernacSetOption (["Universe"; "Polymorphism"],_) | VernacUnsetOption (["Universe"; "Polymorphism"]) -> VtSideff [], VtNow - (* Stm *) - | VernacStm Finish -> VtStm (VtFinish, true), VtNow - | VernacStm Wait -> VtStm (VtWait, true), VtNow - | VernacStm JoinDocument -> VtStm (VtJoinDocument, true), VtNow - | VernacStm PrintDag -> VtStm (VtPrintDag, true), VtNow - | VernacStm (Observe id) -> VtStm (VtObserve id, true), VtNow - | VernacStm (Command x) -> elide_part_of_script_and_now (classify_vernac x) - | VernacStm (PGLast x) -> fst (classify_vernac x), VtNow + (* Nested vernac exprs *) | VernacProgram e -> classify_vernac e | VernacLocal (_,e) -> classify_vernac e @@ -98,7 +84,7 @@ let rec classify_vernac e = | VernacFail e -> (* Fail Qed or Fail Lemma must not join/fork the DAG *) (match classify_vernac e with | ( VtQuery _ | VtProofStep _ | VtSideff _ - | VtStm _ | VtProofMode _ ), _ as x -> x + | VtBack _ | VtProofMode _ ), _ as x -> x | VtQed _, _ -> VtProofStep { parallel = `No; proof_block_detection = None }, VtNow diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index bfdae85d5..ba5bc5506 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -27,8 +27,7 @@ let rec is_navigation_vernac = function | VernacResetName _ | VernacBacktrack _ | VernacBackTo _ - | VernacBack _ - | VernacStm _ -> true + | VernacBack _ -> true | VernacRedirect (_, (_,c)) | VernacTime (_,c) -> is_navigation_vernac c (* Time Back* is harmless *) diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 230e62607..f0e63aa7c 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1941,7 +1941,6 @@ let interp ?proof ~loc locality poly c = | VernacTime _ -> assert false | VernacRedirect _ -> assert false | VernacTimeout _ -> assert false - | VernacStm _ -> assert false | VernacError e -> raise e @@ -2209,9 +2208,6 @@ let interp ?(verbosely=true) ?proof (loc,c) = aux ?locality ~polymorphism:b isprogcmd c | VernacPolymorphic (b, c) -> CErrors.error "Polymorphism specified twice" | VernacLocal _ -> CErrors.error "Locality specified twice" - | VernacStm (Command c) -> aux ?locality ?polymorphism isprogcmd c - | VernacStm (PGLast c) -> aux ?locality ?polymorphism isprogcmd c - | VernacStm _ -> assert false (* Done by Stm *) | VernacFail v -> with_fail true (fun () -> aux ?locality ?polymorphism isprogcmd v) | VernacTimeout (n,v) -> -- cgit v1.2.3 From 633ed9c528c64dc2daa0b3e83749bc392aab7fd2 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 6 Jun 2016 14:54:23 -0400 Subject: Add test suite files for 4700-4785 I didn't add any test-cases for timing-based bugs (4707, 4768, 4776, 4777, 4779, 4783), nor CoqIDE bugs (4700, 4751, 4752, 4756), nor bugs about printing (4709, 4711, 4720, 4723, 4734, 4736, 4738, 4741, 4743, 4748, 4749, 4750, 4757, 4758, 4765, 4784). I'm not sure what to do with 4712, 4714, 4732, 4740. --- test-suite/bugs/closed/4708.v | 8 ++++ test-suite/bugs/closed/4718.v | 15 +++++++ test-suite/bugs/closed/4722.v | 1 + test-suite/bugs/closed/4722/tata | 1 + test-suite/bugs/closed/4727.v | 10 +++++ test-suite/bugs/closed/4745.v | 35 +++++++++++++++ test-suite/bugs/closed/4772.v | 6 +++ test-suite/bugs/opened/4701.v | 23 ++++++++++ test-suite/bugs/opened/4717.v | 19 ++++++++ test-suite/bugs/opened/4721.v | 13 ++++++ test-suite/bugs/opened/4728.v | 72 ++++++++++++++++++++++++++++++ test-suite/bugs/opened/4755.v | 34 +++++++++++++++ test-suite/bugs/opened/4771.v | 22 ++++++++++ test-suite/bugs/opened/4778.v | 35 +++++++++++++++ test-suite/bugs/opened/4781.v | 94 ++++++++++++++++++++++++++++++++++++++++ 15 files changed, 388 insertions(+) create mode 100644 test-suite/bugs/closed/4708.v create mode 100644 test-suite/bugs/closed/4718.v create mode 100644 test-suite/bugs/closed/4722.v create mode 120000 test-suite/bugs/closed/4722/tata create mode 100644 test-suite/bugs/closed/4727.v create mode 100644 test-suite/bugs/closed/4745.v create mode 100644 test-suite/bugs/closed/4772.v create mode 100644 test-suite/bugs/opened/4701.v create mode 100644 test-suite/bugs/opened/4717.v create mode 100644 test-suite/bugs/opened/4721.v create mode 100644 test-suite/bugs/opened/4728.v create mode 100644 test-suite/bugs/opened/4755.v create mode 100644 test-suite/bugs/opened/4771.v create mode 100644 test-suite/bugs/opened/4778.v create mode 100644 test-suite/bugs/opened/4781.v diff --git a/test-suite/bugs/closed/4708.v b/test-suite/bugs/closed/4708.v new file mode 100644 index 000000000..ad2e58100 --- /dev/null +++ b/test-suite/bugs/closed/4708.v @@ -0,0 +1,8 @@ +(*Doc, it hurts when I poke myself.*) + +Notation "'" := 1. (* was: +Setting notation at level 0. +Toplevel input, characters 0-18: +> Notation "'" := 1. +> ^^^^^^^^^^^^^^^^^^ +Anomaly: Uncaught exception Invalid_argument("index out of bounds"). Please report. *) diff --git a/test-suite/bugs/closed/4718.v b/test-suite/bugs/closed/4718.v new file mode 100644 index 000000000..12a4e8fc1 --- /dev/null +++ b/test-suite/bugs/closed/4718.v @@ -0,0 +1,15 @@ +(*Congruence is weaker than reflexivity when it comes to higher level than necessary equalities:*) + +Goal @eq Set nat nat. +congruence. +Qed. + +Goal @eq Type nat nat. +congruence. (*bug*) +Qed. + +Variable T : Type. + +Goal @eq Type T T. +congruence. +Qed. diff --git a/test-suite/bugs/closed/4722.v b/test-suite/bugs/closed/4722.v new file mode 100644 index 000000000..f047624c8 --- /dev/null +++ b/test-suite/bugs/closed/4722.v @@ -0,0 +1 @@ +(* -*- coq-prog-args: ("-emacs" "-R" "4722" "Foo") -*- *) diff --git a/test-suite/bugs/closed/4722/tata b/test-suite/bugs/closed/4722/tata new file mode 120000 index 000000000..b38e66e75 --- /dev/null +++ b/test-suite/bugs/closed/4722/tata @@ -0,0 +1 @@ +toto \ No newline at end of file diff --git a/test-suite/bugs/closed/4727.v b/test-suite/bugs/closed/4727.v new file mode 100644 index 000000000..3854bbffd --- /dev/null +++ b/test-suite/bugs/closed/4727.v @@ -0,0 +1,10 @@ +(* -*- coq-prog-args: ("-emacs" "-compat" "8.4") -*- *) +Goal forall (P : Set) (l : P) (P0 : Set) (w w0 : P0) (T : Type) (a : P * T) (o : P -> option P0), + (forall (l1 l2 : P) (w1 : P0), o l1 = Some w1 -> o l2 = Some w1 -> l1 = l2) -> + o l = Some w -> o (fst a) = Some w0 -> {w = w0} + {w <> w0} -> False. +Proof. + clear; intros ???????? inj H0 H1 H2. + destruct H2; intuition subst. + eapply inj in H1; [ | eauto ]. + progress subst. (* should succeed, used to not succeed *) +Abort. diff --git a/test-suite/bugs/closed/4745.v b/test-suite/bugs/closed/4745.v new file mode 100644 index 000000000..c090125e6 --- /dev/null +++ b/test-suite/bugs/closed/4745.v @@ -0,0 +1,35 @@ +(*I get an Anomaly in the following code. + +```*) +Require Vector. + +Module M. + Lemma Vector_map_map : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v; simpl; auto using f_equal. + Qed. + + Lemma Vector_map_map_transparent : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v; simpl; auto using f_equal. + Defined. + (* Anomaly: constant not found in kind_of_head: Coq.Vectors.Vector.t_ind. Please report. *) + + (* strangely, explicitly passing the principle to induction works *) + Lemma Vector_map_map_transparent' : + forall A B C (f : A -> B) (g : B -> C) n (v : Vector.t A n), + Vector.map g (Vector.map f v) = Vector.map (fun a => g (f a)) v. + Proof. + induction v using Vector.t_ind; simpl; auto using f_equal. + Defined. +End M. +(*``` + +Changing any of the following things eliminates the Anomaly + * moving the lemma out of the module M to the top level + * proving the lemma as a Fixpoint instead of using induction + * proving the analogous lemma on lists instead of vectors*) diff --git a/test-suite/bugs/closed/4772.v b/test-suite/bugs/closed/4772.v new file mode 100644 index 000000000..c3109fa31 --- /dev/null +++ b/test-suite/bugs/closed/4772.v @@ -0,0 +1,6 @@ + +Record TruncType := BuildTruncType { + trunctype_type : Type +}. + +Fail Arguments BuildTruncType _ _ {_}. (* This should fail *) diff --git a/test-suite/bugs/opened/4701.v b/test-suite/bugs/opened/4701.v new file mode 100644 index 000000000..9286f0f1f --- /dev/null +++ b/test-suite/bugs/opened/4701.v @@ -0,0 +1,23 @@ +(*Suppose we have*) + + Inductive my_if {A B} : bool -> Type := + | then_case (_ : A) : my_if true + | else_case (_ : B) : my_if false. + Notation "'If' b 'Then' A 'Else' B" := (@my_if A B b) (at level 10). + +(*then here are three inductive type declarations that work:*) + + Inductive I1 := + | i1 (x : I1). + Inductive I2 := + | i2 (x : nat). + Inductive I3 := + | i3 (b : bool) (x : If b Then I3 Else nat). + +(*and here is one that does not, despite being equivalent to [I3]:*) + + Fail Inductive I4 := + | i4 (b : bool) (x : if b then I4 else nat). (* Error: Non strictly positive occurrence of "I4" in + "forall b : bool, (if b then I4 else nat) -> I4". *) + +(*I think this one should work. I believe this is a conservative extension over CIC: Since [match] statements returning types can always be re-encoded as inductive type families, the analysis should be independent of whether the constructor uses an inductive or a [match] statement.*) diff --git a/test-suite/bugs/opened/4717.v b/test-suite/bugs/opened/4717.v new file mode 100644 index 000000000..9ad474672 --- /dev/null +++ b/test-suite/bugs/opened/4717.v @@ -0,0 +1,19 @@ +(*See below. They sometimes work, and sometimes do not. Is this a bug?*) + +Require Import Omega Psatz. + +Definition foo := nat. + +Goal forall (n : foo), 0 = n - n. +Proof. intros. omega. (* works *) Qed. + +Goal forall (x n : foo), x = x + n - n. +Proof. + intros. + Fail omega. (* Omega can't solve this system *) + Fail lia. (* Cannot find witness. *) + unfold foo in *. + omega. (* works *) +Qed. + +(* Guillaume Melquiond: What matters is the equality. In the first case, it is @eq nat. In the second case, it is @eq foo. The same issue exists for ring and field. So it is not a bug, but it is worth fixing.*) diff --git a/test-suite/bugs/opened/4721.v b/test-suite/bugs/opened/4721.v new file mode 100644 index 000000000..1f184b393 --- /dev/null +++ b/test-suite/bugs/opened/4721.v @@ -0,0 +1,13 @@ +Variables S1 S2 : Set. + +Goal @eq Type S1 S2 -> @eq Type S1 S2. +intro H. +Fail tauto. +assumption. +Qed. + +(*This is in 8.5pl1, and Matthieq Sozeau says: "That's a regression in tauto indeed, which now requires exact equality of the universes, through a non linear goal pattern matching: +match goal with ?X1 |- ?X1 forces both instances of X1 to be convertible, +with no additional universe constraints currently, but the two types are +initially different. This can be fixed easily to allow the same flexibility +as in 8.4 (or assumption) to unify the universes as well."*) diff --git a/test-suite/bugs/opened/4728.v b/test-suite/bugs/opened/4728.v new file mode 100644 index 000000000..230b4beb6 --- /dev/null +++ b/test-suite/bugs/opened/4728.v @@ -0,0 +1,72 @@ +(*I'd like the final [Check] in the following to work:*) + +Ltac fin_eta_expand := + [ > lazymatch goal with + | [ H : _ |- _ ] => clear H + end.. + | lazymatch goal with + | [ H : ?T |- ?T ] + => exact H + | [ |- ?G ] + => fail 0 "No hypothesis matching" G + end ]; + let n := numgoals in + tryif constr_eq numgoals 0 + then idtac + else fin_eta_expand. + +Ltac pre_eta_expand x := + let T := type of x in + let G := match goal with |- ?G => G end in + unify T G; + unshelve econstructor; + destruct x; + fin_eta_expand. + +Ltac eta_expand x := + let v := constr:(ltac:(pre_eta_expand x)) in + idtac v; + let v := (eval cbv beta iota zeta in v) in + exact v. + +Notation eta_expand x := (ltac:(eta_expand x)) (only parsing). + +Ltac partial_unify eqn := + lazymatch eqn with + | ?x = ?x => idtac + | ?f ?x = ?g ?y + => partial_unify (f = g); + (tryif unify x y then + idtac + else tryif has_evar x then + unify x y + else tryif has_evar y then + unify x y + else + idtac) + | ?x = ?y + => idtac; + (tryif unify x y then + idtac + else tryif has_evar x then + unify x y + else tryif has_evar y then + unify x y + else + idtac) + end. + +Tactic Notation "{" open_constr(old_record) "with" open_constr(new_record) "}" := + let old_record' := eta_expand old_record in + partial_unify (old_record = new_record); + eexact new_record. + +Set Implicit Arguments. +Record prod A B := pair { fst : A ; snd : B }. +Infix "*" := prod : type_scope. +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +Notation "{ old 'with' new }" := (ltac:({ old with new })) (only parsing). + +Check ltac:({ (1, 1) with {| snd := 2 |} }). +Fail Check { (1, 1) with {| snd := 2 |} }. (* Error: Cannot infer this placeholder of type "Type"; should succeed *) diff --git a/test-suite/bugs/opened/4755.v b/test-suite/bugs/opened/4755.v new file mode 100644 index 000000000..9cc0d361e --- /dev/null +++ b/test-suite/bugs/opened/4755.v @@ -0,0 +1,34 @@ +(*I'm not sure which behavior is better. But if the change is intentional, it should be documented (I don't think it is), and it'd be nice if there were a flag for this, or if -compat 8.4 restored the old behavior.*) + +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. +Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); []. (* In 8.5: Error: Tactic failure: Incorrect number of goals (expected 2 tactics); works in 8.4 *) diff --git a/test-suite/bugs/opened/4771.v b/test-suite/bugs/opened/4771.v new file mode 100644 index 000000000..396d74bdb --- /dev/null +++ b/test-suite/bugs/opened/4771.v @@ -0,0 +1,22 @@ +Module Type Foo. + +Parameter Inline t : nat. + +End Foo. + +Module F(X : Foo). + +Tactic Notation "foo" ref(x) := idtac. + +Ltac g := foo X.t. + +End F. + +Module N. +Definition t := 0 + 0. +End N. + +Module K := F(N). + +(* Was +Anomaly: Uncaught exception Not_found. Please report. *) diff --git a/test-suite/bugs/opened/4778.v b/test-suite/bugs/opened/4778.v new file mode 100644 index 000000000..633d158e9 --- /dev/null +++ b/test-suite/bugs/opened/4778.v @@ -0,0 +1,35 @@ +Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. +Definition f (v : option nat) := match v with + | Some k => Some k + | None => None + end. + +Axioms F G : (option nat -> option nat) -> Prop. +Axiom FG : forall f, f None = None -> F f = G f. + +Axiom admit : forall {T}, T. + +Existing Instance eq_Reflexive. + +(* This instance is needed in 8.4, but is useless in 8.5 *) +Global Instance foo (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> forall_relation (fun _ => Basics.flip Basics.impl)) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. + +(* +(* This is required in 8.5, but useless in 8.4 *) +Global Instance bar (A := nat) + : Proper ((pointwise_relation _ eq) + ==> eq ==> eq ==> Basics.flip Basics.impl) + (@option_rect A (fun _ => Prop)) | 0. +exact admit. +Qed. +*) + +Goal forall k, option_rect (fun _ => Prop) (fun v : nat => v = v /\ F f) True k. Proof. + intro. + pose proof (_ : (Proper (_ ==> eq ==> _) and)). + Fail setoid_rewrite (FG _ _); [ | reflexivity.. ]. (* this should succeed without [Fail], as it does in 8.4 *) diff --git a/test-suite/bugs/opened/4781.v b/test-suite/bugs/opened/4781.v new file mode 100644 index 000000000..8b651ac22 --- /dev/null +++ b/test-suite/bugs/opened/4781.v @@ -0,0 +1,94 @@ +Ltac force_clear := + clear; + repeat match goal with + | [ H : _ |- _ ] => clear H + | [ H := _ |- _ ] => clearbody H + end. + +Class abstract_term {T} (x : T) := by_abstract_term : T. +Hint Extern 0 (@abstract_term ?T ?x) => force_clear; change T; abstract (exact x) : typeclass_instances. + +Goal True. +(* These work: *) + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + pose x. + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := (eval cbv iota in (let v : T := x in v)) in + pose x. + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(Set) with ?y => constr:(y) end in + pose x. +(* This fails with an error: *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(x) with ?y => constr:(y) end in + pose x. (* The command has indeed failed with message: +Error: Variable y should be bound to a term. *) +(* And the rest fail with Anomaly: Uncaught exception Not_found. Please report. *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := match constr:(x) with ?y => y end in + pose x. + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := (eval cbv iota in x) in + pose x. + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let x := type of x in + pose x. (* should succeed *) + Fail let term := constr:(I) in + let T := type of term in + let x := constr:(_ : abstract_term term) in + let x := type of x in + pose x. (* should succeed *) + +(*Apparently what [cbv iota] doesn't see can't hurt it, and [pose] is perfectly happy with abstracted lemmas only some of the time. + +Even stranger, consider:*) + let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'. + let x := (eval cbv delta [x'] in x') in + pose x; + let z := (eval cbv iota in x) in + pose z. + +(*This works fine. But if I change the period to a semicolon, I get:*) + + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'; + let x := (eval cbv delta [x'] in x') in + pose x. (* Anomaly: Uncaught exception Not_found. Please report. *) + (* should succeed *) +(*and if I use the second one instead of [pose x] (note that using [idtac] works fine), I get:*) + + Fail let term := constr:(I) in + let T := type of term in + let x := constr:((_ : abstract_term term) : T) in + let y := (eval cbv iota in (let v : T := x in v)) in + pose y; + let x' := fresh "x'" in + pose x as x'; + let x := (eval cbv delta [x'] in x') in + let z := (eval cbv iota in x) in (* Error: Variable x should be bound to a term. *) + idtac. (* should succeed *) -- cgit v1.2.3 From 81c9fa0de99400b51c029cdbd1519b4f724e320a Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Thu, 17 Nov 2016 13:06:07 +0100 Subject: fake_ide: use the now available Status XML message --- tools/fake_ide.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index 8fcca535d..214dfb470 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -266,11 +266,9 @@ let eval_print l coq = let to_id, _ = get_id id in eval_call (query (phrase, to_id)) coq | [ Tok(_,"WAIT") ] -> - let phrase = "Stm Wait." in - eval_call (query (phrase,tip_id())) coq + eval_call (status false) coq | [ Tok(_,"JOIN") ] -> - let phrase = "Stm JoinDocument." in - eval_call (query (phrase,tip_id())) coq + eval_call (status true) coq | [ Tok(_,"ASSERT"); Tok(_,"TIP"); Tok(_,id) ] -> let to_id, _ = get_id id in if not(Stateid.equal (Document.tip doc) to_id) then error "Wrong tip" -- cgit v1.2.3 From 954f1697fb750eecf4612bbb191a91c3a4bafb7c Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 18 Nov 2016 08:38:12 +0100 Subject: Revert "fake_ide: use the now available Status XML message" This reverts commit 81c9fa0de99400b51c029cdbd1519b4f724e320a. --- tools/fake_ide.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index 214dfb470..8fcca535d 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -266,9 +266,11 @@ let eval_print l coq = let to_id, _ = get_id id in eval_call (query (phrase, to_id)) coq | [ Tok(_,"WAIT") ] -> - eval_call (status false) coq + let phrase = "Stm Wait." in + eval_call (query (phrase,tip_id())) coq | [ Tok(_,"JOIN") ] -> - eval_call (status true) coq + let phrase = "Stm JoinDocument." in + eval_call (query (phrase,tip_id())) coq | [ Tok(_,"ASSERT"); Tok(_,"TIP"); Tok(_,id) ] -> let to_id, _ = get_id id in if not(Stateid.equal (Document.tip doc) to_id) then error "Wrong tip" -- cgit v1.2.3 From bdcf5b040b975a179fe9b2889fea0d38ae4689df Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Fri, 18 Nov 2016 08:38:30 +0100 Subject: Revert "Merge remote-tracking branch 'github/pr/360' into v8.6" This reverts commit b00e039b957b8428c21faec5c76f3a3484cde2cf, reversing changes made to ca9e00ff9b2a8ee17430398a5e0bef2345c39341. It turns out that calling from fake_ide the STM commands that were removed by this PR requires an extension of the XML protocol. So postponing the integration. --- ide/texmacspp.ml | 3 +++ intf/vernacexpr.mli | 23 ++++++++++++++++++++- parsing/g_vernac.ml4 | 10 ++++++++++ printing/ppvernac.ml | 16 +++++++++++++++ stm/stm.ml | 51 ++++++++++++++++++++++++++++++++++------------- stm/vernac_classifier.ml | 22 ++++++++++++++++---- toplevel/vernac.ml | 3 ++- toplevel/vernacentries.ml | 4 ++++ 8 files changed, 112 insertions(+), 20 deletions(-) diff --git a/ide/texmacspp.ml b/ide/texmacspp.ml index dbcd8630b..680da7f54 100644 --- a/ide/texmacspp.ml +++ b/ide/texmacspp.ml @@ -724,6 +724,9 @@ let rec tmpp v loc = | VernacComments (cl) -> xmlComment loc (List.flatten (List.map pp_comment cl)) + (* Stm backdoor *) + | VernacStm _ as x -> xmlTODO loc x + (* Proof management *) | VernacGoal _ as x -> xmlTODO loc x | VernacAbort _ as x -> xmlTODO loc x diff --git a/intf/vernacexpr.mli b/intf/vernacexpr.mli index f77a940a7..92e4dd618 100644 --- a/intf/vernacexpr.mli +++ b/intf/vernacexpr.mli @@ -283,6 +283,16 @@ type bullet = | Star of int | Plus of int +(** {6 Types concerning Stm} *) +type 'a stm_vernac = + | JoinDocument + | Finish + | Wait + | PrintDag + | Observe of Stateid.t + | Command of 'a (* An out of flow command not to be recorded by Stm *) + | PGLast of 'a (* To ease the life of PG *) + (** {6 Types concerning the module layer} *) (** Rigid / flexible module signature *) @@ -441,6 +451,9 @@ type vernac_expr = | VernacRegister of lident * register_kind | VernacComments of comment list + (* Stm backdoor *) + | VernacStm of vernac_expr stm_vernac + (* Proof management *) | VernacGoal of constr_expr | VernacAbort of lident option @@ -495,7 +508,7 @@ type vernac_type = | VtProofStep of proof_step | VtProofMode of string | VtQuery of vernac_part_of_script * report_with - | VtBack of Stateid.t * vernac_part_of_script + | VtStm of vernac_control * vernac_part_of_script | VtUnknown and report_with = Stateid.t * Feedback.route_id (* feedback on id/route *) and vernac_qed_type = VtKeep | VtKeepAsAxiom | VtDrop (* Qed/Admitted, Abort *) @@ -503,6 +516,14 @@ and vernac_start = string * opacity_guarantee * Id.t list and vernac_sideff_type = Id.t list and vernac_is_alias = bool and vernac_part_of_script = bool +and vernac_control = + | VtFinish + | VtWait + | VtJoinDocument + | VtPrintDag + | VtObserve of Stateid.t + | VtBack of Stateid.t + | VtPG and opacity_guarantee = | GuaranteesOpacity (** Only generates opaque terms at [Qed] *) | Doesn'tGuaranteeOpacity (** May generate transparent terms even with [Qed].*) diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index 4ba9eeefa..9b52d1bf3 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -64,6 +64,16 @@ GEXTEND Gram | IDENT "Local"; v = vernac_poly -> VernacLocal (true, v) | IDENT "Global"; v = vernac_poly -> VernacLocal (false, v) + (* Stm backdoor *) + | IDENT "Stm"; IDENT "JoinDocument"; "." -> VernacStm JoinDocument + | IDENT "Stm"; IDENT "Finish"; "." -> VernacStm Finish + | IDENT "Stm"; IDENT "Wait"; "." -> VernacStm Wait + | IDENT "Stm"; IDENT "PrintDag"; "." -> VernacStm PrintDag + | IDENT "Stm"; IDENT "Observe"; id = INT; "." -> + VernacStm (Observe (Stateid.of_int (int_of_string id))) + | IDENT "Stm"; IDENT "Command"; v = vernac_aux -> VernacStm (Command v) + | IDENT "Stm"; IDENT "PGLast"; v = vernac_aux -> VernacStm (PGLast v) + | v = vernac_poly -> v ] ] ; diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index a6b1c97f5..3494ad006 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -538,6 +538,22 @@ module Make | VernacLocal (local, v) -> return (pr_locality local ++ spc() ++ pr_vernac_body v) + (* Stm *) + | VernacStm JoinDocument -> + return (keyword "Stm JoinDocument") + | VernacStm PrintDag -> + return (keyword "Stm PrintDag") + | VernacStm Finish -> + return (keyword "Stm Finish") + | VernacStm Wait -> + return (keyword "Stm Wait") + | VernacStm (Observe id) -> + return (keyword "Stm Observe " ++ str(Stateid.to_string id)) + | VernacStm (Command v) -> + return (keyword "Stm Command " ++ pr_vernac_body v) + | VernacStm (PGLast v) -> + return (keyword "Stm PGLast " ++ pr_vernac_body v) + (* Proof management *) | VernacAbortAll -> return (keyword "Abort All") diff --git a/stm/stm.ml b/stm/stm.ml index 0ddaf604a..e387e6322 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -989,7 +989,7 @@ end = struct (* {{{ *) try match v with | VernacResetInitial -> - VtBack (Stateid.initial, true), VtNow + VtStm (VtBack Stateid.initial, true), VtNow | VernacResetName (_,name) -> let id = VCS.get_branch_pos (VCS.current_branch ()) in (try @@ -997,20 +997,20 @@ end = struct (* {{{ *) fold_until (fun b (id,_,label,_,_) -> if b then `Stop id else `Cont (List.mem name label)) false id in - VtBack (oid, true), VtNow + VtStm (VtBack oid, true), VtNow with Not_found -> - VtBack (id, true), VtNow) + VtStm (VtBack id, true), VtNow) | VernacBack n -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun n (id,_,_,_,_) -> if Int.equal n 0 then `Stop id else `Cont (n-1)) n id in - VtBack (oid, true), VtNow + VtStm (VtBack oid, true), VtNow | VernacUndo n -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun n (id,_,_,tactic,undo) -> let value = (if tactic then 1 else 0) - undo in if Int.equal n 0 then `Stop id else `Cont (n-value)) n id in - VtBack (oid, true), VtLater + VtStm (VtBack oid, true), VtLater | VernacUndoTo _ | VernacRestart as e -> let m = match e with VernacUndoTo m -> m | _ -> 0 in @@ -1027,16 +1027,16 @@ end = struct (* {{{ *) 0 id in let oid = fold_until (fun n (id,_,_,_,_) -> if Int.equal n 0 then `Stop id else `Cont (n-1)) (n-m-1) id in - VtBack (oid, true), VtLater + VtStm (VtBack oid, true), VtLater | VernacAbortAll -> let id = VCS.get_branch_pos (VCS.current_branch ()) in let oid = fold_until (fun () (id,vcs,_,_,_) -> match Vcs_.branches vcs with [_] -> `Stop id | _ -> `Cont ()) () id in - VtBack (oid, true), VtLater + VtStm (VtBack oid, true), VtLater | VernacBacktrack (id,_,_) | VernacBackTo id -> - VtBack (Stateid.of_int id, not !Flags.print_emacs), VtNow + VtStm (VtBack (Stateid.of_int id), not !Flags.print_emacs), VtNow | _ -> VtUnknown, VtNow with | Not_found -> @@ -2428,8 +2428,22 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty prerr_endline (fun () -> " classified as: " ^ string_of_vernac_classification c); match c with + (* PG stuff *) + | VtStm(VtPG,false), VtNow -> vernac_interp Stateid.dummy x; `Ok + | VtStm(VtPG,_), _ -> anomaly(str "PG command in script or VtLater") + (* Joining various parts of the document *) + | VtStm (VtJoinDocument, b), VtNow -> join (); `Ok + | VtStm (VtFinish, b), VtNow -> finish (); `Ok + | VtStm (VtWait, b), VtNow -> finish (); wait (); `Ok + | VtStm (VtPrintDag, b), VtNow -> + VCS.print ~now:true (); `Ok + | VtStm (VtObserve id, b), VtNow -> observe id; `Ok + | VtStm ((VtObserve _ | VtFinish | VtJoinDocument + |VtPrintDag |VtWait),_), VtLater -> + anomaly(str"classifier: join actions cannot be classified as VtLater") + (* Back *) - | VtBack(oid, true), w -> + | VtStm (VtBack oid, true), w -> let id = VCS.new_node ~id:newtip () in let { mine; others } = Backtrack.branches_of oid in let valid = VCS.get_branch_pos head in @@ -2448,12 +2462,12 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty VCS.checkout_shallowest_proof_branch (); VCS.commit id (Alias (oid,x)); Backtrack.record (); if w == VtNow then finish (); `Ok - | VtBack (id, false), VtNow -> + | VtStm (VtBack id, false), VtNow -> prerr_endline (fun () -> "undo to state " ^ Stateid.to_string id); Backtrack.backto id; VCS.checkout_shallowest_proof_branch (); Reach.known_state ~cache:(interactive ()) id; `Ok - | VtBack (id, false), VtLater -> + | VtStm (VtBack id, false), VtLater -> anomaly(str"classifier: VtBack + VtLater must imply part_of_script") (* Query *) @@ -2590,6 +2604,15 @@ let process_transaction ?(newtip=Stateid.fresh ()) ~tty | VtUnknown, VtLater -> anomaly(str"classifier: VtUnknown must imply VtNow") end in + (* Proof General *) + begin match expr with + | VernacStm (PGLast _) -> + if not (VCS.Branch.equal head VCS.Branch.master) then + vernac_interp Stateid.dummy + { verbose = true; loc = Loc.ghost; indentation = 0; strlen = 0; + expr = VernacShow (ShowGoal OpenSubgoals) } + | _ -> () + end; prerr_endline (fun () -> "processed }}}"); VCS.print (); rc @@ -2651,8 +2674,8 @@ let query ~at ?(report_with=(Stateid.dummy,default_route)) s = let clas = classify_vernac ast in let aast = { verbose = true; indentation; strlen; loc; expr = ast } in match clas with - | VtBack (w,_), _ -> - ignore(process_transaction ~tty:false aast (VtBack (w,false), VtNow)) + | VtStm (w,_), _ -> + ignore(process_transaction ~tty:false aast (VtStm (w,false), VtNow)) | _ -> ignore(process_transaction ~tty:false aast (VtQuery (false,report_with), VtNow))) @@ -2799,7 +2822,7 @@ let interp verb (loc,e) = let print_goals = verb && match clas with | VtQuery _, _ -> false - | (VtProofStep _ | VtBack (_, _) | VtStartProof _), _ -> true + | (VtProofStep _ | VtStm (VtBack _, _) | VtStartProof _), _ -> true | _ -> not !Flags.coqtop_ui in try finish ~print_goals () with e -> diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml index f9bf9653f..dc5be08a3 100644 --- a/stm/vernac_classifier.ml +++ b/stm/vernac_classifier.ml @@ -33,7 +33,10 @@ let string_of_vernac_type = function | VtQuery (b,(id,route)) -> "Query " ^ string_of_in_script b ^ " report " ^ Stateid.to_string id ^ " route " ^ string_of_int route - | VtBack(_, b) -> "Stm Back " ^ string_of_in_script b + | VtStm ((VtFinish|VtJoinDocument|VtObserve _|VtPrintDag|VtWait), b) -> + "Stm " ^ string_of_in_script b + | VtStm (VtPG, b) -> "Stm PG " ^ string_of_in_script b + | VtStm (VtBack _, b) -> "Stm Back " ^ string_of_in_script b let string_of_vernac_when = function | VtLater -> "Later" @@ -52,7 +55,7 @@ let declare_vernac_classifier let elide_part_of_script_and_now (a, _) = match a with | VtQuery (_,id) -> VtQuery (false,id), VtNow - | VtBack (x, _) -> VtBack (x, false), VtNow + | VtStm (x, _) -> VtStm (x, false), VtNow | x -> x, VtNow let make_polymorphic (a, b as x) = @@ -66,12 +69,23 @@ let set_undo_classifier f = undo_classifier := f let rec classify_vernac e = let static_classifier e = match e with + (* PG compatibility *) + | VernacUnsetOption (["Silent"]|["Undo"]|["Printing";"Depth"]) + | VernacSetOption ((["Silent"]|["Undo"]|["Printing";"Depth"]),_) + when !Flags.print_emacs -> VtStm(VtPG,false), VtNow (* Univ poly compatibility: we run it now, so that we can just * look at Flags in stm.ml. Would be nicer to have the stm * look at the entire dag to detect this option. *) | VernacSetOption (["Universe"; "Polymorphism"],_) | VernacUnsetOption (["Universe"; "Polymorphism"]) -> VtSideff [], VtNow - + (* Stm *) + | VernacStm Finish -> VtStm (VtFinish, true), VtNow + | VernacStm Wait -> VtStm (VtWait, true), VtNow + | VernacStm JoinDocument -> VtStm (VtJoinDocument, true), VtNow + | VernacStm PrintDag -> VtStm (VtPrintDag, true), VtNow + | VernacStm (Observe id) -> VtStm (VtObserve id, true), VtNow + | VernacStm (Command x) -> elide_part_of_script_and_now (classify_vernac x) + | VernacStm (PGLast x) -> fst (classify_vernac x), VtNow (* Nested vernac exprs *) | VernacProgram e -> classify_vernac e | VernacLocal (_,e) -> classify_vernac e @@ -84,7 +98,7 @@ let rec classify_vernac e = | VernacFail e -> (* Fail Qed or Fail Lemma must not join/fork the DAG *) (match classify_vernac e with | ( VtQuery _ | VtProofStep _ | VtSideff _ - | VtBack _ | VtProofMode _ ), _ as x -> x + | VtStm _ | VtProofMode _ ), _ as x -> x | VtQed _, _ -> VtProofStep { parallel = `No; proof_block_detection = None }, VtNow diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index ba5bc5506..bfdae85d5 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -27,7 +27,8 @@ let rec is_navigation_vernac = function | VernacResetName _ | VernacBacktrack _ | VernacBackTo _ - | VernacBack _ -> true + | VernacBack _ + | VernacStm _ -> true | VernacRedirect (_, (_,c)) | VernacTime (_,c) -> is_navigation_vernac c (* Time Back* is harmless *) diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index f0e63aa7c..230e62607 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1941,6 +1941,7 @@ let interp ?proof ~loc locality poly c = | VernacTime _ -> assert false | VernacRedirect _ -> assert false | VernacTimeout _ -> assert false + | VernacStm _ -> assert false | VernacError e -> raise e @@ -2208,6 +2209,9 @@ let interp ?(verbosely=true) ?proof (loc,c) = aux ?locality ~polymorphism:b isprogcmd c | VernacPolymorphic (b, c) -> CErrors.error "Polymorphism specified twice" | VernacLocal _ -> CErrors.error "Locality specified twice" + | VernacStm (Command c) -> aux ?locality ?polymorphism isprogcmd c + | VernacStm (PGLast c) -> aux ?locality ?polymorphism isprogcmd c + | VernacStm _ -> assert false (* Done by Stm *) | VernacFail v -> with_fail true (fun () -> aux ?locality ?polymorphism isprogcmd v) | VernacTimeout (n,v) -> -- cgit v1.2.3