diff options
Diffstat (limited to 'vernac')
| -rw-r--r-- | vernac/comFixpoint.ml | 2 | ||||
| -rw-r--r-- | vernac/g_proofs.ml4 | 13 | ||||
| -rw-r--r-- | vernac/g_vernac.ml4 | 4 | ||||
| -rw-r--r-- | vernac/obligations.ml | 9 | ||||
| -rw-r--r-- | vernac/ppvernac.ml | 3 | ||||
| -rw-r--r-- | vernac/vernacentries.ml | 19 | ||||
| -rw-r--r-- | vernac/vernacexpr.ml | 5 |
7 files changed, 28 insertions, 27 deletions
diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml index ea731b34c9..b5b8697d25 100644 --- a/vernac/comFixpoint.ml +++ b/vernac/comFixpoint.ml @@ -254,7 +254,7 @@ let declare_fixpoint local poly ((fixnames,fixdefs,fixtypes),pl,ctx,fiximps) ind Some (List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.New.tclIDTAC) fixdefs) in let evd = Evd.from_ctx ctx in - Lemmas.start_proof_with_initialization (Global,poly,DefinitionBody Fixpoint) + Lemmas.start_proof_with_initialization (local,poly,DefinitionBody Fixpoint) evd pl (Some(false,indexes,init_tac)) thms None (Lemmas.mk_hook (fun _ _ -> ())) else begin (* We shortcut the proof process *) diff --git a/vernac/g_proofs.ml4 b/vernac/g_proofs.ml4 index 56229c7654..a3806ff680 100644 --- a/vernac/g_proofs.ml4 +++ b/vernac/g_proofs.ml4 @@ -98,15 +98,8 @@ GEXTEND Gram VernacCreateHintDb (id, b) | IDENT "Remove"; IDENT "Hints"; ids = LIST1 global; dbnames = opt_hintbases -> VernacRemoveHints (dbnames, ids) - | IDENT "Hint"; h = hint; - dbnames = opt_hintbases -> + | IDENT "Hint"; h = hint; dbnames = opt_hintbases -> VernacHints (dbnames, h) - (* Declare "Resolve" explicitly so as to be able to later extend with - "Resolve ->" and "Resolve <-" *) - | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 reference_or_constr; - info = hint_info; dbnames = opt_hintbases -> - VernacHints (dbnames, - HintsResolve (List.map (fun x -> (info, true, x)) lc)) ] ]; reference_or_constr: [ [ r = global -> HintsReference r @@ -115,6 +108,10 @@ GEXTEND Gram hint: [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; info = hint_info -> HintsResolve (List.map (fun x -> (info, true, x)) lc) + | IDENT "Resolve"; "->"; lc = LIST1 global; n = OPT natural -> + HintsResolveIFF (true, lc, n) + | IDENT "Resolve"; "<-"; lc = LIST1 global; n = OPT natural -> + HintsResolveIFF (false, lc, n) | 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/vernac/g_vernac.ml4 b/vernac/g_vernac.ml4 index dd8149d0a1..b6523981c7 100644 --- a/vernac/g_vernac.ml4 +++ b/vernac/g_vernac.ml4 @@ -631,8 +631,8 @@ GEXTEND Gram t = class_rawexpr -> VernacCoercion (CAst.make ~loc:!@loc @@ ByNotation ntn, s, t) - | IDENT "Context"; c = binders -> - VernacContext c + | IDENT "Context"; c = LIST1 binder -> + VernacContext (List.flatten c) | IDENT "Instance"; namesup = instance_name; ":"; expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200"; diff --git a/vernac/obligations.ml b/vernac/obligations.ml index 1a3b1f39be..00f1760c22 100644 --- a/vernac/obligations.ml +++ b/vernac/obligations.ml @@ -565,9 +565,8 @@ let declare_mutual_definition l = List.iter (Metasyntax.add_notation_interpretation (Global.env())) first.prg_notations; Declare.recursive_message (fixkind != IsCoFixpoint) indexes fixnames; let gr = List.hd kns in - let kn = match gr with GlobRef.ConstRef kn -> kn | _ -> assert false in Lemmas.call_hook fix_exn first.prg_hook local gr first.prg_ctx; - List.iter progmap_remove l; kn + List.iter progmap_remove l; gr let decompose_lam_prod c ty = let open Context.Rel.Declaration in @@ -774,8 +773,8 @@ let update_obls prg obls rem = let progs = List.map (fun x -> get_info (ProgMap.find x !from_prg)) prg'.prg_deps in if List.for_all (fun x -> obligations_solved x) progs then let kn = declare_mutual_definition progs in - Defined (GlobRef.ConstRef kn) - else Dependent) + Defined kn + else Dependent) let is_defined obls x = not (Option.is_empty obls.(x).obl_body) @@ -962,7 +961,7 @@ and obligation (user_num, name, typ) tac = let num = pred user_num in let prg = get_prog_err name in let obls, rem = prg.prg_obligations in - if num < Array.length obls then + if num >= 0 && num < Array.length obls then let obl = obls.(num) in match obl.obl_body with None -> solve_obligation prg num tac diff --git a/vernac/ppvernac.ml b/vernac/ppvernac.ml index 7aff758e98..5490b9ce54 100644 --- a/vernac/ppvernac.ml +++ b/vernac/ppvernac.ml @@ -200,6 +200,9 @@ open Pputils keyword "Resolve " ++ prlist_with_sep sep (fun (info, _, c) -> pr_reference_or_constr pr_c c ++ pr_hint_info pr_pat info) l + | HintsResolveIFF (l2r, l, n) -> + keyword "Resolve " ++ str (if l2r then "->" else "<-") + ++ prlist_with_sep sep pr_reference l | HintsImmediate l -> keyword "Immediate" ++ spc() ++ prlist_with_sep sep (fun c -> pr_reference_or_constr pr_c c) l diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 9a7f59085c..7f6270df1a 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1131,15 +1131,16 @@ let vernac_arguments ~atts 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 !rename_flag_required && not rename_flag then - user_err ~hdr:"vernac_declare_arguments" - (strbrk "To rename arguments the \"rename\" flag must be specified." - ++ spc () ++ - match !example_renaming with - | None -> mt () - | Some (o,n) -> - str "Argument " ++ Name.print o ++ - str " renamed to " ++ Name.print n ++ str "."); + if !rename_flag_required && not rename_flag then begin + let msg = + match !example_renaming with + | None -> + strbrk "To rename arguments the \"rename\" flag must be specified." + | Some (o,n) -> + strbrk "Flag \"rename\" expected to rename " ++ Name.print o ++ + strbrk " into " ++ Name.print n ++ str "." + in user_err ~hdr:"vernac_declare_arguments" msg + end; let duplicate_names = List.duplicates Name.equal (List.filter ((!=) Anonymous) names) diff --git a/vernac/vernacexpr.ml b/vernac/vernacexpr.ml index 74355e1a7d..9e8dfc4f85 100644 --- a/vernac/vernacexpr.ml +++ b/vernac/vernacexpr.ml @@ -106,13 +106,13 @@ type comment = type reference_or_constr = Hints.reference_or_constr = | HintsReference of reference | HintsConstr of constr_expr -[@@ocaml.deprecated "Please use [Hints.hints_expr]"] +[@@ocaml.deprecated "Please use [Hints.reference_or_constr]"] type hint_mode = Hints.hint_mode = | ModeInput (* No evars *) | ModeNoHeadEvar (* No evar at the head *) | ModeOutput (* Anything *) -[@@ocaml.deprecated "Please use [Hints.hints_expr]"] +[@@ocaml.deprecated "Please use [Hints.hint_mode]"] type 'a hint_info_gen = 'a Typeclasses.hint_info_gen = { hint_priority : int option; @@ -124,6 +124,7 @@ type hint_info_expr = Hints.hint_info_expr type hints_expr = Hints.hints_expr = | HintsResolve of (Hints.hint_info_expr * bool * Hints.reference_or_constr) list + | HintsResolveIFF of bool * reference list * int option | HintsImmediate of Hints.reference_or_constr list | HintsUnfold of reference list | HintsTransparency of reference list * bool |