diff options
| author | herbelin | 2009-11-08 21:24:51 +0000 |
|---|---|---|
| committer | herbelin | 2009-11-08 21:24:51 +0000 |
| commit | 2857380470f8139217c7fe7d43f6adf355c1b139 (patch) | |
| tree | a923162d58c4d98e54fc81b37d86b27da356d682 | |
| parent | 272194ae1dd0769105e1f485c9b96670a19008a7 (diff) | |
Fixed "Scheme Equality" when another instance of the scheme on the
same type is already registered.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12482 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | dev/base_include | 1 | ||||
| -rw-r--r-- | toplevel/auto_ind_decl.ml | 21 |
2 files changed, 5 insertions, 17 deletions
diff --git a/dev/base_include b/dev/base_include index 41d1ac3bbc..d26d5b4db0 100644 --- a/dev/base_include +++ b/dev/base_include @@ -147,6 +147,7 @@ open Class open Command open Indschemes open Ind_tables +open Auto_ind_decl open Lemmas open Coqinit open Coqtop diff --git a/toplevel/auto_ind_decl.ml b/toplevel/auto_ind_decl.ml index 84f3420f26..231a17f852 100644 --- a/toplevel/auto_ind_decl.ml +++ b/toplevel/auto_ind_decl.ml @@ -262,32 +262,19 @@ let build_beq_scheme kn = in (* build_beq_scheme *) let names = Array.make nb_ind Anonymous and types = Array.make nb_ind mkSet and - cores = Array.make nb_ind mkSet and - res = Array.make nb_ind mkSet in + cores = Array.make nb_ind mkSet in for i=0 to (nb_ind-1) do names.(i) <- Name (id_of_string (rec_name i)); types.(i) <- mkArrow (mkFullInd (kn,i) 0) (mkArrow (mkFullInd (kn,i) 1) bb); cores.(i) <- make_one_eq i done; - if (string_of_mp (mind_modpath kn))="Coq.Init.Logic" - then print_string "Logic time, do nothing.\n" - else ( - for i=0 to (nb_ind-1) do - let cpack = Array.get mib.mind_packets i in - if check_scheme (!beq_scheme_kind_aux()) (kn,i) - then message ("Boolean equality is already defined on "^ - (string_of_id cpack.mind_typename)^".") - else ( - let kelim = Inductive.elim_sorts (mib,mib.mind_packets.(i)) in + Array.init nb_ind (fun i -> + let kelim = Inductive.elim_sorts (mib,mib.mind_packets.(i)) in if not (List.mem InSet kelim) then raise (NonSingletonProp (kn,i)); let fix = mkFix (((Array.make nb_ind 0),i),(names,types,cores)) in - res.(i) <- create_input fix - ) - done; - ); - res + create_input fix) let beq_scheme_kind = declare_mutual_scheme_object "_beq" build_beq_scheme |