aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xdev/tools/pre-commit13
-rw-r--r--doc/changelog/07-commands-and-options/11534-let-with-annotations.rst3
-rw-r--r--doc/sphinx/language/core/sections.rst2
-rw-r--r--doc/tools/docgram/fullGrammar3
-rw-r--r--doc/tools/docgram/orderedGrammar3
-rw-r--r--lib/cErrors.ml4
-rw-r--r--pretyping/evarsolve.ml109
-rw-r--r--test-suite/success/let_universes.v5
-rw-r--r--theories/Structures/OrderedTypeEx.v200
-rw-r--r--tools/CoqMakefile.in2
-rw-r--r--vernac/g_vernac.mlg4
11 files changed, 253 insertions, 95 deletions
diff --git a/dev/tools/pre-commit b/dev/tools/pre-commit
index 633913aac6..448e224f2e 100755
--- a/dev/tools/pre-commit
+++ b/dev/tools/pre-commit
@@ -16,6 +16,15 @@ then
1>&2 echo "Warning: ocamlformat is not in path. Cannot check formatting."
fi
+# Verify that the version of ocamlformat matches the one in .ocamlformat
+# The following command will print an error message if that's not the case
+# (and will print nothing if the versions match)
+if ! echo "let () = ()" | "$ocamlformat" --impl - > /dev/null
+then
+ 1>&2 echo "Warning: Cannot check formatting."
+ ocamlformat=true
+fi
+
1>&2 echo "Auto fixing whitespace and formatting issues..."
# We fix whitespace in the index and in the working tree
@@ -43,7 +52,7 @@ if [ -s "$index" ]; then
git apply --cached --whitespace=fix "$index"
git apply --whitespace=fix "$index" 2>/dev/null # no need to repeat yourself
git diff --cached --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix
- git diff --cached --name-only -z | grep -E '.*\.mli?$' -z | xargs -0 "$ocamlformat" -i || true
+ { git diff --cached --name-only -z | grep -E '.*\.mli?$' -z | xargs -0 "$ocamlformat" -i || true; } 2> /dev/null
git add -u
1>&2 echo #newline
fi
@@ -59,7 +68,7 @@ if [ -s "$tree" ]; then
1>&2 echo "Fixing unstaged changes..."
git apply --whitespace=fix "$tree"
git diff --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix
- git diff --name-only -z | grep -E '.*\.mli?$' -z | xargs -0 "$ocamlformat" -i || true
+ { git diff --name-only -z | grep -E '.*\.mli?$' -z | xargs -0 "$ocamlformat" -i || true; } 2> /dev/null
1>&2 echo #newline
fi
diff --git a/doc/changelog/07-commands-and-options/11534-let-with-annotations.rst b/doc/changelog/07-commands-and-options/11534-let-with-annotations.rst
new file mode 100644
index 0000000000..7bcbb9a8e3
--- /dev/null
+++ b/doc/changelog/07-commands-and-options/11534-let-with-annotations.rst
@@ -0,0 +1,3 @@
+- **Added:** Support for universe bindings and universe contrainsts in
+ :cmd:`Let` definitions (`#11534
+ <https://github.com/coq/coq/pull/11534>`_, by Théo Zimmermann).
diff --git a/doc/sphinx/language/core/sections.rst b/doc/sphinx/language/core/sections.rst
index 9ad8df2b1b..df50dbafe3 100644
--- a/doc/sphinx/language/core/sections.rst
+++ b/doc/sphinx/language/core/sections.rst
@@ -72,7 +72,7 @@ Sections create local contexts which can be shared across multiple definitions.
Most commands, like :cmd:`Hint`, :cmd:`Notation`, option management, … which
appear inside a section are canceled when the section is closed.
-.. cmd:: Let @ident @def_body
+.. cmd:: Let @ident_decl @def_body
Let Fixpoint @fix_definition {* with @fix_definition }
Let CoFixpoint @cofix_definition {* with @cofix_definition }
:name: Let; Let Fixpoint; Let CoFixpoint
diff --git a/doc/tools/docgram/fullGrammar b/doc/tools/docgram/fullGrammar
index 272d17bb35..dc7e0fba37 100644
--- a/doc/tools/docgram/fullGrammar
+++ b/doc/tools/docgram/fullGrammar
@@ -773,7 +773,7 @@ gallina: [
| assumption_token inline assum_list
| assumptions_token inline assum_list
| def_token ident_decl def_body
-| "Let" identref def_body
+| "Let" ident_decl def_body
| finite_token LIST1 inductive_definition SEP "with"
| "Fixpoint" LIST1 rec_definition SEP "with"
| "Let" "Fixpoint" LIST1 rec_definition SEP "with"
@@ -1027,7 +1027,6 @@ gallina_ext: [
| "Module" "Type" identref LIST0 module_binder check_module_types is_module_type
| "Declare" "Module" export_token identref LIST0 module_binder ":" module_type_inl
| "Section" identref
-| "Chapter" identref
| "End" identref
| "Collection" identref ":=" section_subset_expr
| "Require" export_token LIST1 global
diff --git a/doc/tools/docgram/orderedGrammar b/doc/tools/docgram/orderedGrammar
index 0c9d7a853b..535976b7d9 100644
--- a/doc/tools/docgram/orderedGrammar
+++ b/doc/tools/docgram/orderedGrammar
@@ -851,7 +851,7 @@ command: [
| thm_token ident_decl LIST0 binder ":" type LIST0 [ "with" ident_decl LIST0 binder ":" type ]
| assumption_token OPT ( "Inline" OPT ( "(" num ")" ) ) [ LIST1 ( "(" assumpt ")" ) | assumpt ]
| [ "Definition" | "Example" ] ident_decl def_body
-| "Let" ident def_body
+| "Let" ident_decl def_body
| "Inductive" inductive_definition LIST0 ( "with" inductive_definition )
| "Fixpoint" fix_definition LIST0 ( "with" fix_definition )
| "Let" "Fixpoint" fix_definition LIST0 ( "with" fix_definition )
@@ -873,7 +873,6 @@ command: [
| "Module" "Type" ident LIST0 module_binder LIST0 ( "<:" module_type_inl ) OPT ( ":=" LIST1 module_type_inl SEP "<+" )
| "Declare" "Module" OPT [ "Import" | "Export" ] ident LIST0 module_binder ":" module_type_inl
| "Section" ident
-| "Chapter" ident
| "End" ident
| "Collection" ident ":=" section_subset_expr
| "Require" OPT [ "Import" | "Export" ] LIST1 qualid
diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index d1548ab12e..62d465c703 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -106,8 +106,10 @@ let print_gen ~anomaly (e, info) =
try
print_gen ~anomaly ~extra_msg !handle_stack e
with exn ->
+ let exn, info = Exninfo.capture exn in
(* exception in error printer *)
- str "<in exception printer>" ++ fnl () ++ print_anomaly anomaly exn
+ str "<in exception printer>:" ++ print_backtrace info ++
+ str "<original exception:" ++ print_anomaly anomaly exn
(** The standard exception printer *)
let iprint (e, info) =
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index 4eae0cf86c..e475e4c52b 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -416,19 +416,10 @@ let get_alias_chain_of sigma aliases x = match x with
| RelAlias n -> (try Int.Map.find n aliases.rel_aliases with Not_found -> empty_aliasing)
| VarAlias id -> (try cast_aliasing (Id.Map.find id aliases.var_aliases) with Not_found -> empty_aliasing)
-let normalize_alias_opt_alias sigma aliases x =
- match get_alias_chain_of sigma aliases x with
- | _, [] -> None
- | _, a :: _ -> Some a
-
-let normalize_alias_opt sigma aliases x = match to_alias sigma x with
-| None -> None
-| Some a -> normalize_alias_opt_alias sigma aliases a
-
let normalize_alias sigma aliases x =
- match normalize_alias_opt_alias sigma aliases x with
- | Some a -> a
- | None -> x
+ match get_alias_chain_of sigma aliases x with
+ | _, [] -> x
+ | _, a :: _ -> a
let normalize_alias_var sigma var_aliases id =
let aliases = { var_aliases; rel_aliases = Int.Map.empty } in
@@ -678,7 +669,7 @@ let make_projectable_subst aliases sigma evi args =
let l = try Constrmap.find (fst cstr) cstrs with Not_found -> [] in
Constrmap.add (fst cstr) ((args,id)::l) cstrs
| _ -> cstrs in
- let all = Int.Map.add i [a,normalize_alias_opt sigma aliases a,id] all in
+ let all = Int.Map.add i [a, id] all in
(rest,all,cstrs,revmap)
| LocalDef ({binder_name=id},c,_), a::rest ->
let revmap = Id.Map.add id i revmap in
@@ -688,13 +679,13 @@ let make_projectable_subst aliases sigma evi args =
let ic, sub =
try let ic = Id.Map.find idc revmap in ic, Int.Map.find ic all
with Not_found -> i, [] (* e.g. [idc] is a filtered variable: treat [id] as an assumption *) in
- if List.exists (fun (c,_,_) -> EConstr.eq_constr sigma a c) sub then
+ if List.exists (fun (c, _) -> EConstr.eq_constr sigma a c) sub then
(rest,all,cstrs,revmap)
else
- let all = Int.Map.add ic ((a,normalize_alias_opt sigma aliases a,id)::sub) all in
+ let all = Int.Map.add ic ((a, id)::sub) all in
(rest,all,cstrs,revmap)
| _ ->
- let all = Int.Map.add i [a,normalize_alias_opt sigma aliases a,id] all in
+ let all = Int.Map.add i [a, id] all in
(rest,all,cstrs,revmap))
| _ -> anomaly (Pp.str "Instance does not match its signature.")) 0
sign (Array.rev_to_list args,Int.Map.empty,Constrmap.empty,Id.Map.empty) in
@@ -862,47 +853,47 @@ type evar_projection =
exception NotUnique
exception NotUniqueInType of (Id.t * evar_projection) list
-let rec assoc_up_to_alias sigma aliases y yc = function
+let rec assoc_up_to_alias sigma aliases y = function
| [] -> raise Not_found
- | (c,cc,id)::l ->
- if is_alias sigma c y then id
+ | (c, id)::l ->
+ match to_alias sigma c with
+ | None -> assoc_up_to_alias sigma aliases y l
+ | Some c ->
+ if eq_alias c y then id
else
match l with
- | _ :: _ -> assoc_up_to_alias sigma aliases y yc l
+ | _ :: _ -> assoc_up_to_alias sigma aliases y l
| [] ->
(* Last chance, we reason up to alias conversion *)
- match (normalize_alias_opt sigma aliases c) with
- | Some cc when eq_alias yc cc -> id
- | _ -> if is_alias sigma c yc then id else raise Not_found
+ let cc = normalize_alias sigma aliases c in
+ let yc = normalize_alias sigma aliases y in
+ if eq_alias cc yc then id else raise Not_found
-let rec find_projectable_vars with_evars aliases sigma y subst =
- let yc = normalize_alias sigma aliases y in
- let is_projectable idc idcl (subst1,subst2 as subst') =
+let rec find_projectable_vars aliases sigma y subst =
+ let is_projectable _ idcl (subst1,subst2 as subst') =
(* First test if some [id] aliased to [idc] is bound to [y] in [subst] *)
try
- let id = assoc_up_to_alias sigma aliases y yc idcl in
+ let id = assoc_up_to_alias sigma aliases y idcl in
(id,ProjectVar)::subst1,subst2
with Not_found ->
(* Then test if [idc] is (indirectly) bound in [subst] to some evar *)
(* projectable on [y] *)
- if with_evars then
- let f (c,_,id) = isEvar sigma c in
- let idcl' = List.filter f idcl in
- match idcl' with
- | [c,_,id] ->
- begin
- let (evk,argsv as t) = destEvar sigma c in
- let evi = Evd.find sigma evk in
- let subst,_ = make_projectable_subst aliases sigma evi argsv in
- let l = find_projectable_vars with_evars aliases sigma y subst in
- match l with
- | [id',p] -> (subst1,(id,ProjectEvar (t,evi,id',p))::subst2)
- | _ -> subst'
- end
- | [] -> subst'
- | _ -> anomaly (Pp.str "More than one non var in aliases class of evar instance.")
- else
- subst' in
+ let f (c, id) = isEvar sigma c in
+ let idcl' = List.filter f idcl in
+ match idcl' with
+ | [c, id] ->
+ begin
+ let (evk,argsv as t) = destEvar sigma c in
+ let evi = Evd.find sigma evk in
+ let subst,_ = make_projectable_subst aliases sigma evi argsv in
+ let l = find_projectable_vars aliases sigma y subst in
+ match l with
+ | [id',p] -> (subst1,(id,ProjectEvar (t,evi,id',p))::subst2)
+ | _ -> subst'
+ end
+ | [] -> subst'
+ | _ -> anomaly (Pp.str "More than one non var in aliases class of evar instance.")
+ in
let subst1,subst2 = Int.Map.fold is_projectable subst ([],[]) in
(* We return the substitution with ProjectVar first (from most
recent to oldest var), followed by ProjectEvar (from most recent
@@ -914,14 +905,15 @@ let rec find_projectable_vars with_evars aliases sigma y subst =
let filter_solution = function
| [] -> raise Not_found
- | (id,p)::_::_ -> raise NotUnique
- | [id,p] -> (mkVar id, p)
+ | _ :: _ :: _ -> raise NotUnique
+ | [id] -> mkVar id
-let project_with_effects aliases sigma effects t subst =
- let c, p =
- filter_solution (find_projectable_vars false aliases sigma t subst) in
- effects := p :: !effects;
- c
+let project_with_effects aliases sigma t subst =
+ let is_projectable _ idcl accu =
+ try assoc_up_to_alias sigma aliases t idcl :: accu
+ with Not_found -> accu
+ in
+ filter_solution (Int.Map.fold is_projectable subst [])
open Context.Named.Declaration
let rec find_solution_type evarenv = function
@@ -981,28 +973,27 @@ let rec do_projection_effects unify flags define_fun env ty evd = function
type projectibility_kind =
| NoUniqueProjection
- | UniqueProjection of EConstr.constr * evar_projection list
+ | UniqueProjection of EConstr.constr
type projectibility_status =
| CannotInvert
| Invertible of projectibility_kind
let invert_arg_from_subst evd aliases k0 subst_in_env_extended_with_k_binders c_in_env_extended_with_k_binders =
- let effects = ref [] in
let rec aux k t =
match EConstr.kind evd t with
| Rel i when i>k0+k -> aux' k (RelAlias (i-k))
| Var id -> aux' k (VarAlias id)
| _ -> map_with_binders evd succ aux k t
and aux' k t =
- try project_with_effects aliases evd effects t subst_in_env_extended_with_k_binders
+ try project_with_effects aliases evd t subst_in_env_extended_with_k_binders
with Not_found ->
match expand_alias_once evd aliases t with
| None -> raise Not_found
| Some c -> aux k (Alias.eval (Alias.lift k c)) in
try
let c = aux 0 c_in_env_extended_with_k_binders in
- Invertible (UniqueProjection (c,!effects))
+ Invertible (UniqueProjection c)
with
| Not_found -> CannotInvert
| NotUnique -> Invertible NoUniqueProjection
@@ -1010,7 +1001,7 @@ let invert_arg_from_subst evd aliases k0 subst_in_env_extended_with_k_binders c_
let invert_arg fullenv evd aliases k evk subst_in_env_extended_with_k_binders c_in_env_extended_with_k_binders =
let res = invert_arg_from_subst evd aliases k subst_in_env_extended_with_k_binders c_in_env_extended_with_k_binders in
match res with
- | Invertible (UniqueProjection (c,_)) when not (noccur_evar fullenv evd evk c)
+ | Invertible (UniqueProjection c) when not (noccur_evar fullenv evd evk c)
->
CannotInvert
| _ ->
@@ -1019,7 +1010,7 @@ let invert_arg fullenv evd aliases k evk subst_in_env_extended_with_k_binders c_
exception NotEnoughInformationToInvert
let extract_unique_projection = function
-| Invertible (UniqueProjection (c,_)) -> c
+| Invertible (UniqueProjection c) -> c
| _ ->
(* For instance, there are evars with non-invertible arguments and *)
(* we cannot arbitrarily restrict these evars before knowing if there *)
@@ -1518,7 +1509,7 @@ let rec invert_definition unify flags choose imitate_defs
let project_variable t =
(* Evar/Var problem: unifiable iff variable projectable from ev subst *)
try
- let sols = find_projectable_vars true aliases !evdref t subst in
+ let sols = find_projectable_vars aliases !evdref t subst in
let c, p = match sols with
| [] -> raise Not_found
| [id,p] -> (mkVar id, p)
diff --git a/test-suite/success/let_universes.v b/test-suite/success/let_universes.v
new file mode 100644
index 0000000000..c780ec010f
--- /dev/null
+++ b/test-suite/success/let_universes.v
@@ -0,0 +1,5 @@
+Section S.
+Let bla@{} := Prop.
+Let bli@{u} := Type@{u}.
+Fail Let blo@{} := Type.
+End S.
diff --git a/theories/Structures/OrderedTypeEx.v b/theories/Structures/OrderedTypeEx.v
index 288aa0c789..83c690ab71 100644
--- a/theories/Structures/OrderedTypeEx.v
+++ b/theories/Structures/OrderedTypeEx.v
@@ -317,6 +317,82 @@ Module PositiveOrderedTypeBits <: UsualOrderedType.
End PositiveOrderedTypeBits.
+Module Ascii_as_OT <: UsualOrderedType.
+ Definition t := ascii.
+
+ Definition eq := @eq ascii.
+ Definition eq_refl := @eq_refl t.
+ Definition eq_sym := @eq_sym t.
+ Definition eq_trans := @eq_trans t.
+
+ Definition cmp (a b : ascii) : comparison :=
+ N.compare (N_of_ascii a) (N_of_ascii b).
+
+ Lemma cmp_eq (a b : ascii):
+ cmp a b = Eq <-> a = b.
+ Proof.
+ unfold cmp.
+ rewrite N.compare_eq_iff.
+ split. 2:{ intro. now subst. }
+ intro H.
+ rewrite<- (ascii_N_embedding a).
+ rewrite<- (ascii_N_embedding b).
+ now rewrite H.
+ Qed.
+
+ Lemma cmp_lt_nat (a b : ascii):
+ cmp a b = Lt <-> (nat_of_ascii a < nat_of_ascii b)%nat.
+ Proof.
+ unfold cmp. unfold nat_of_ascii.
+ rewrite N2Nat.inj_compare.
+ rewrite Nat.compare_lt_iff.
+ reflexivity.
+ Qed.
+
+ Lemma cmp_antisym (a b : ascii):
+ cmp a b = CompOpp (cmp b a).
+ Proof.
+ unfold cmp.
+ apply N.compare_antisym.
+ Qed.
+
+ Definition lt (x y : ascii) := (N_of_ascii x < N_of_ascii y)%N.
+
+ Lemma lt_trans (x y z : ascii):
+ lt x y -> lt y z -> lt x z.
+ Proof.
+ apply N.lt_trans.
+ Qed.
+
+ Lemma lt_not_eq (x y : ascii):
+ lt x y -> x <> y.
+ Proof.
+ intros L H. subst.
+ exact (N.lt_irrefl _ L).
+ Qed.
+
+ Local Lemma compare_helper_eq {a b : ascii} (E : cmp a b = Eq):
+ a = b.
+ Proof.
+ now apply cmp_eq.
+ Qed.
+
+ Local Lemma compare_helper_gt {a b : ascii} (G : cmp a b = Gt):
+ lt b a.
+ Proof.
+ now apply N.compare_gt_iff.
+ Qed.
+
+ Definition compare (a b : ascii) : Compare lt eq a b :=
+ match cmp a b as z return _ = z -> _ with
+ | Lt => fun E => LT E
+ | Gt => fun E => GT (compare_helper_gt E)
+ | Eq => fun E => EQ (compare_helper_eq E)
+ end Logic.eq_refl.
+
+ Definition eq_dec (x y : ascii): {x = y} + { ~ (x = y)} := ascii_dec x y.
+End Ascii_as_OT.
+
(** [String] is an ordered type with respect to the usual lexical order. *)
Module String_as_OT <: UsualOrderedType.
@@ -378,32 +454,106 @@ Module String_as_OT <: UsualOrderedType.
apply Nat.lt_irrefl in H2; auto.
Qed.
- Definition compare x y : Compare lt eq x y.
+ Fixpoint cmp (a b : string) : comparison :=
+ match a, b with
+ | EmptyString, EmptyString => Eq
+ | EmptyString, _ => Lt
+ | String _ _, EmptyString => Gt
+ | String a_head a_tail, String b_head b_tail =>
+ match Ascii_as_OT.cmp a_head b_head with
+ | Lt => Lt
+ | Gt => Gt
+ | Eq => cmp a_tail b_tail
+ end
+ end.
+
+ Lemma cmp_eq (a b : string):
+ cmp a b = Eq <-> a = b.
Proof.
- generalize dependent y.
- induction x as [ | a s1]; destruct y as [ | b s2].
- - apply EQ; constructor.
- - apply LT; constructor.
- - apply GT; constructor.
- - destruct ((nat_of_ascii a) ?= (nat_of_ascii b))%nat eqn:ltb.
- + assert (a = b).
- {
- apply Nat.compare_eq in ltb.
- assert (ascii_of_nat (nat_of_ascii a)
- = ascii_of_nat (nat_of_ascii b)) by auto.
- repeat rewrite ascii_nat_embedding in H.
- auto.
- }
- subst.
- destruct (IHs1 s2).
- * apply LT; constructor; auto.
- * apply EQ. unfold eq in e. subst. constructor; auto.
- * apply GT; constructor; auto.
- + apply nat_compare_lt in ltb.
- apply LT; constructor; auto.
- + apply nat_compare_gt in ltb.
- apply GT; constructor; auto.
- Defined.
+ revert b.
+ induction a, b; try easy.
+ cbn.
+ remember (Ascii_as_OT.cmp _ _) as c eqn:Heqc. symmetry in Heqc.
+ destruct c; split; try discriminate;
+ try rewrite Ascii_as_OT.cmp_eq in Heqc; try subst;
+ try rewrite IHa; intro H.
+ { now subst. }
+ { now inversion H. }
+ { inversion H; subst. rewrite<- Heqc. now rewrite Ascii_as_OT.cmp_eq. }
+ { inversion H; subst. rewrite<- Heqc. now rewrite Ascii_as_OT.cmp_eq. }
+ Qed.
+
+ Lemma cmp_antisym (a b : string):
+ cmp a b = CompOpp (cmp b a).
+ Proof.
+ revert b.
+ induction a, b; try easy.
+ cbn. rewrite IHa. clear IHa.
+ remember (Ascii_as_OT.cmp _ _) as c eqn:Heqc. symmetry in Heqc.
+ destruct c; rewrite Ascii_as_OT.cmp_antisym in Heqc;
+ destruct Ascii_as_OT.cmp; cbn in *; easy.
+ Qed.
+
+ Lemma cmp_lt (a b : string):
+ cmp a b = Lt <-> lt a b.
+ Proof.
+ revert b.
+ induction a as [ | a_head a_tail ], b; try easy; cbn.
+ { split; trivial. intro. apply lts_empty. }
+ remember (Ascii_as_OT.cmp _ _) as c eqn:Heqc. symmetry in Heqc.
+ destruct c; split; intro H; try discriminate; trivial.
+ {
+ rewrite Ascii_as_OT.cmp_eq in Heqc. subst.
+ apply String_as_OT.lts_tail.
+ apply IHa_tail.
+ assumption.
+ }
+ {
+ rewrite Ascii_as_OT.cmp_eq in Heqc. subst.
+ inversion H; subst. { rewrite IHa_tail. assumption. }
+ exfalso. apply (Nat.lt_irrefl (nat_of_ascii a)). assumption.
+ }
+ {
+ apply String_as_OT.lts_head.
+ rewrite<- Ascii_as_OT.cmp_lt_nat.
+ assumption.
+ }
+ {
+ exfalso. inversion H; subst.
+ {
+ assert(X: Ascii_as_OT.cmp a a = Eq). { apply Ascii_as_OT.cmp_eq. trivial. }
+ rewrite Heqc in X. discriminate.
+ }
+ rewrite<- Ascii_as_OT.cmp_lt_nat in *. rewrite Heqc in *. discriminate.
+ }
+ Qed.
+
+ Local Lemma compare_helper_lt {a b : string} (L : cmp a b = Lt):
+ lt a b.
+ Proof.
+ now apply cmp_lt.
+ Qed.
+
+ Local Lemma compare_helper_gt {a b : string} (G : cmp a b = Gt):
+ lt b a.
+ Proof.
+ rewrite cmp_antisym in G.
+ rewrite CompOpp_iff in G.
+ now apply cmp_lt.
+ Qed.
+
+ Local Lemma compare_helper_eq {a b : string} (E : cmp a b = Eq):
+ a = b.
+ Proof.
+ now apply cmp_eq.
+ Qed.
+
+ Definition compare (a b : string) : Compare lt eq a b :=
+ match cmp a b as z return _ = z -> _ with
+ | Lt => fun E => LT (compare_helper_lt E)
+ | Gt => fun E => GT (compare_helper_gt E)
+ | Eq => fun E => EQ (compare_helper_eq E)
+ end Logic.eq_refl.
Definition eq_dec (x y : string): {x = y} + { ~ (x = y)} := string_dec x y.
End String_as_OT.
diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
index f72b99c57c..597351db9b 100644
--- a/tools/CoqMakefile.in
+++ b/tools/CoqMakefile.in
@@ -54,7 +54,7 @@ OCAMLWARN := $(COQMF_WARN)
#
# Parameters are make variable assignments.
# They can be passed to (each call to) make on the command line.
-# They can also be put in @LOCAL_FILE@ once an for all.
+# They can also be put in @LOCAL_FILE@ once and for all.
# For retro-compatibility reasons they can be put in the _CoqProject, but this
# practice is discouraged since _CoqProject better not contain make specific
# code (be nice to user interfaces).
diff --git a/vernac/g_vernac.mlg b/vernac/g_vernac.mlg
index 31fc54c1fa..1f52641b82 100644
--- a/vernac/g_vernac.mlg
+++ b/vernac/g_vernac.mlg
@@ -199,8 +199,8 @@ GRAMMAR EXTEND Gram
VernacAssumption (stre, nl, bl) }
| d = def_token; id = ident_decl; b = def_body ->
{ VernacDefinition (d, name_of_ident_decl id, b) }
- | IDENT "Let"; id = identref; b = def_body ->
- { VernacDefinition ((DoDischarge, Let), (lname_of_lident id, None), b) }
+ | IDENT "Let"; id = ident_decl; b = def_body ->
+ { VernacDefinition ((DoDischarge, Let), name_of_ident_decl id, b) }
(* Gallina inductive declarations *)
| f = finite_token; indl = LIST1 inductive_definition SEP "with" ->
{ VernacInductive (f, indl) }