diff options
1421 files changed, 13995 insertions, 8928 deletions
diff --git a/.gitignore b/.gitignore index acb1100bcf..5ee2f3f77b 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ *.spot *.o *.a +*.pyc *.log *.aux *.dvi @@ -35,6 +36,10 @@ *.tacind *.v.tex *.v.ps +*.v.timing +*.v.timing.diff +*.v.before-timing +*.v.after-timing *.v.html *.stamp *.native @@ -55,6 +60,10 @@ plugins/micromega/csdpcert plugins/micromega/.micromega.ml.generated kernel/byterun/dllcoqrun.so coqdoc.sty +time-of-build.log +time-of-build-pretty.log +time-of-build-before.log +time-of-build-after.log .csdp.cache test-suite/.lia.cache test-suite/.nra.cache @@ -63,8 +72,9 @@ test-suite/misc/universes/all_stdlib.v test-suite/misc/universes/universes.txt test-suite/coq-makefile/*/actual test-suite/coq-makefile/*/desired -test-suite/coq-makefile/*/Makefile -test-suite/coq-makefile/*/Makefile.conf +test-suite/coq-makefile/**/*.processed +test-suite/coq-makefile/**/Makefile +test-suite/coq-makefile/**/Makefile.conf test-suite/coq-makefile/*/src test-suite/coq-makefile/*/theories test-suite/coq-makefile/*/theories2 @@ -74,6 +84,8 @@ test-suite/coq-makefile/*/subdir/done test-suite/coq-makefile/merlin1/.merlin test-suite/coq-makefile/plugin-reach-outside-API-and-fail/_CoqProject test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/_CoqProject +test-suite/coqdoc/Coqdoc.* +test-suite/coqdoc/index.html # documentation @@ -106,6 +118,7 @@ doc/stdlib/FullLibrary.coqdoc.tex doc/stdlib/html/ doc/stdlib/index-body.html doc/stdlib/index-list.html +doc/tutorial/Tutorial.v.out doc/RecTutorial/RecTutorial.html doc/RecTutorial/RecTutorial.ps dev/ocamldoc/*.html diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e1feabd064..b47494d3ae 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -18,8 +18,10 @@ variables: # some useful values COMPILER_32BIT: "4.02.3+32bit" - COMPILER_BLEEDING_EDGE: "4.04.1" - CAMLP5_VER_BLEEDING_EDGE: "6.17" + COMPILER_BLEEDING_EDGE: "4.05.0" + CAMLP5_VER_BLEEDING_EDGE: "7.01" + + TEST_PACKAGES: "time python" COQIDE_PACKAGES: "libgtk2.0-dev libgtksourceview2.0-dev" #COQIDE_PACKAGES_32BIT: "libgtk2.0-dev:i386 libgtksourceview2.0-dev:i386" @@ -38,6 +40,11 @@ before_script: - if [ ! "(" -d .opamcache ")" ]; then mv ~/.opam .opamcache; else mv ~/.opam ~/.opam-old; fi - ln -s $(readlink -f .opamcache) ~/.opam + # the default repo in this docker image is a local directory + # at the time of 4aaeb8abf it lagged behind the official + # repository such that camlp5 7.01 was not available + - opam repository set-url default https://opam.ocaml.org + - opam update - opam switch ${COMPILER} - eval $(opam config env) - opam config list @@ -193,6 +200,8 @@ test-suite: <<: *test-suite-template dependencies: - build + variables: + EXTRA_PACKAGES: "$TEST_PACKAGES" test-suite:32bit: <<: *test-suite-template @@ -200,7 +209,7 @@ test-suite:32bit: - build:32bit variables: COMPILER: "$COMPILER_32BIT" - EXTRA_PACKAGES: "gcc-multilib" + EXTRA_PACKAGES: "gcc-multilib $TEST_PACKAGES" test-suite:bleeding-edge: <<: *test-suite-template @@ -209,6 +218,7 @@ test-suite:bleeding-edge: variables: COMPILER: "$COMPILER_BLEEDING_EDGE" CAMLP5_VER: "$CAMLP5_VER_BLEEDING_EDGE" + EXTRA_PACKAGES: "$TEST_PACKAGES" documentation: <<: *documentation-template diff --git a/.travis.yml b/.travis.yml index e7082a9eeb..9c7ad553f5 100644 --- a/.travis.yml +++ b/.travis.yml @@ -37,34 +37,33 @@ env: - TEST_TARGET="test-suite" COMPILER="4.02.3+32bit" - TEST_TARGET="validate" TW="travis_wait" - TEST_TARGET="validate" COMPILER="4.02.3+32bit" TW="travis_wait" - - TEST_TARGET="ci-bignums" - - TEST_TARGET="ci-color" - - TEST_TARGET="ci-compcert" + - TEST_TARGET="ci-bignums TIMED=1" + - TEST_TARGET="ci-color TIMED=1" + - TEST_TARGET="ci-compcert TIMED=1" - TEST_TARGET="ci-coq-dpdgraph" EXTRA_OPAM="ocamlgraph" - - TEST_TARGET="ci-coquelicot" - - TEST_TARGET="ci-geocoq" - - TEST_TARGET="ci-fiat-crypto" - - TEST_TARGET="ci-fiat-parsers" - - TEST_TARGET="ci-flocq" - - TEST_TARGET="ci-formal-topology" - - TEST_TARGET="ci-hott" - - TEST_TARGET="ci-iris-coq" - - TEST_TARGET="ci-math-classes" - - TEST_TARGET="ci-math-comp" - - TEST_TARGET="ci-sf" - - TEST_TARGET="ci-unimath" - - TEST_TARGET="ci-vst" + - TEST_TARGET="ci-coquelicot TIMED=1" + - TEST_TARGET="ci-geocoq TIMED=1" + - TEST_TARGET="ci-fiat-crypto TIMED=1" + - TEST_TARGET="ci-fiat-parsers TIMED=1" + - TEST_TARGET="ci-flocq TIMED=1" + - TEST_TARGET="ci-formal-topology TIMED=1" + - TEST_TARGET="ci-hott TIMED=1" + - TEST_TARGET="ci-iris-coq TIMED=1" + - TEST_TARGET="ci-math-classes TIMED=1" + - TEST_TARGET="ci-math-comp TIMED=1" + - TEST_TARGET="ci-sf TIMED=1" + - TEST_TARGET="ci-unimath TIMED=1" + - TEST_TARGET="ci-vst TIMED=1" # Not ready yet for 8.7 - # - TEST_TARGET="ci-cpdt" - # - TEST_TARGET="ci-metacoq" - # - TEST_TARGET="ci-tlc" + # - TEST_TARGET="ci-cpdt TIMED=1" + # - TEST_TARGET="ci-metacoq TIMED=1" + # - TEST_TARGET="ci-tlc TIMED=1" matrix: allow_failures: - env: TEST_TARGET="ci-coq-dpdgraph" EXTRA_OPAM="ocamlgraph" - - env: TEST_TARGET="ci-geocoq" - - env: TEST_TARGET="ci-fiat-parsers" + - env: TEST_TARGET="ci-geocoq TIMED=1" include: # Full Coq test-suite with two compilers @@ -95,8 +94,8 @@ matrix: - env: - TEST_TARGET="test-suite" - - COMPILER="4.04.1" - - CAMLP5_VER="6.17" + - COMPILER="4.05.0" + - CAMLP5_VER="7.01" - EXTRA_CONF="-coqide opt -with-doc yes" - EXTRA_OPAM="lablgtk-extras hevea" addons: @@ -124,8 +123,8 @@ matrix: - env: - TEST_TARGET="coqocaml" - - COMPILER="4.04.1" - - CAMLP5_VER="6.17" + - COMPILER="4.05.0" + - CAMLP5_VER="7.01" - EXTRA_CONF="-coqide opt -warn-error" - EXTRA_OPAM="lablgtk-extras hevea" # dummy target @@ -139,12 +138,15 @@ matrix: - os: osx env: - TEST_TARGET="test-suite" - - COMPILER="system" - - CAMLP5_VER="6.17" + - COMPILER="4.02.3" - NATIVE_COMP="no" before_install: - brew update - brew install opam + - brew install gnu-time + +before_install: +- if [ "${TRAVIS_PULL_REQUEST}" != "false" ]; then echo "Tested commit (followed by parent commits):"; git log -1; for commit in `git log -1 --format="%P"`; do echo; git log -1 $commit; done; fi install: - opam init -j ${NJOBS} --compiler=${COMPILER} -n -y diff --git a/API/API.ml b/API/API.ml index 29aa1b7a57..c952e123d4 100644 --- a/API/API.ml +++ b/API/API.ml @@ -1,203 +1,285 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -module Ppvernac = Ppvernac -module Command = Command -module States = States -module Kindops = Kindops +(* Warning, this file respects the dependency order established in Coq. + + To see such order issue the comand: + +``` +bash -c 'for i in kernel intf library engine pretyping interp proofs parsing printing tactics vernac stm toplevel; do echo -e "\n## $i files" && cat ${i}/${i}.mllib; done && echo -e "\n## highparsing files" && cat parsing/highparsing.mllib' > API/link +``` + *) + +(******************************************************************************) +(* config *) +(******************************************************************************) module Coq_config = Coq_config + +(******************************************************************************) +(* Kernel *) +(******************************************************************************) +(* "mli" files *) +module Declarations = Declarations +module Entries = Entries + +module Names = Names +(* module Uint31 *) +module Univ = Univ +module UGraph = UGraph module Esubst = Esubst +module Sorts = Sorts module Evar = Evar -module Constrexpr = Constrexpr -module Libobject = Libobject -module Evd = Evd -module Libnames = Libnames -module Nameops = Nameops -module Topfmt = Topfmt -module Locus = Locus -module Locusops = Locusops -module Lemmas = Lemmas -module Clenv = Clenv -module Elimschemes = Elimschemes -module Classes = Classes -module Class_tactics = Class_tactics -module Eauto = Eauto -module Keys = Keys -module Vernac_classifier = Vernac_classifier -module Autorewrite = Autorewrite -module Redops = Redops -module Elim = Elim -module Geninterp = Geninterp -module Obligations = Obligations -module Retroknowledge = Retroknowledge -module Evar_refiner = Evar_refiner -module Hipattern = Hipattern -module Auto = Auto -module Hints = Hints -module Contradiction = Contradiction -module Tacticals = Tacticals -module Tactics = Tactics -module Inv = Inv -module Leminv = Leminv -module Equality = Equality -module Redexpr = Redexpr -module Pfedit = Pfedit -module Stm = Stm -module Stateid = Stateid -module Declaremods = Declaremods -module Miscops = Miscops -module Miscprint = Miscprint -module Genprint = Genprint -module Ppconstr = Ppconstr -module Pputils = Pputils -module Extend = Extend -module Logic = Logic -module Himsg = Himsg -module Tacred = Tacred -module Names = Names -module Indrec = Indrec -module Glob_ops = Glob_ops -module Constrexpr_ops = Constrexpr_ops -module Eqdecide = Eqdecide -module Genredexpr = Genredexpr -module Detyping = Detyping -module Tactypes = Tactypes -module ExplainErr = ExplainErr -module Printer = Printer -module Constrextern = Constrextern -module Locality = Locality -module Impargs = Impargs -module Termops = Termops -module Refiner = Refiner -module Ppextend = Ppextend -module Nametab = Nametab -module Vernacentries = Vernacentries -module Mltop = Mltop -module Goal = Goal -module Proof_global = Proof_global -module Proof = Proof -module Smartlocate = Smartlocate -module Dumpglob = Dumpglob -module Constrintern = Constrintern -module Topconstr = Topconstr -module Notation_ops = Notation_ops -module Patternops = Patternops -module Mod_typing = Mod_typing -module Modops = Modops -module Opaqueproof = Opaqueproof -module Ind_tables = Ind_tables -module Typeops = Typeops -module Inductive = Inductive +module Constr = Constr +module Context = Context module Vars = Vars -module Reduction = Reduction +module Term = Term module Mod_subst = Mod_subst -module Sorts = Sorts -module Univ = Univ -module Constr = Constr +module Cbytecodes = Cbytecodes +(* module Copcodes *) +module Cemitcodes = Cemitcodes +(* module Nativevalues *) +(* module Primitives *) +module Opaqueproof = Opaqueproof +module Declareops = Declareops +module Retroknowledge = Retroknowledge +module Conv_oracle = Conv_oracle +(* module Pre_env *) +(* module Cbytegen *) +(* module Nativelambda *) +(* module Nativecode *) +(* module Nativelib *) +module Environ = Environ module CClosure = CClosure +module Reduction = Reduction +(* module Nativeconv *) module Type_errors = Type_errors +module Modops = Modops +module Inductive = Inductive +module Typeops = Typeops +(* module Indtypes *) +(* module Cooking *) +(* module Term_typing *) +(* module Subtyping *) +module Mod_typing = Mod_typing +(* module Nativelibrary *) module Safe_typing = Safe_typing -module UGraph = UGraph -module Namegen = Namegen -module Ftactic = Ftactic -module UState = UState -module Proofview_monad = Proofview_monad -module Classops = Classops +(* module Vm *) +(* module Csymtable *) +(* module Vconv *) + +(******************************************************************************) +(* Intf *) +(******************************************************************************) +module Constrexpr = Constrexpr +module Locus = Locus +module Glob_term = Glob_term +module Extend = Extend +module Misctypes = Misctypes +module Decl_kinds = Decl_kinds +module Vernacexpr = Vernacexpr +module Notation_term = Notation_term +module Evar_kinds = Evar_kinds +module Genredexpr = Genredexpr + +(******************************************************************************) +(* Library *) +(******************************************************************************) +module Univops = Univops +module Nameops = Nameops +module Libnames = Libnames +module Globnames = Globnames +module Libobject = Libobject +module Summary = Summary +module Nametab = Nametab module Global = Global -module Goptions = Goptions module Lib = Lib +module Declaremods = Declaremods +(* module Loadpath *) module Library = Library -module Summary = Summary +module States = States +module Kindops = Kindops +(* module Dischargedhypsmap *) +module Goptions = Goptions +(* module Decls *) +(* module Heads *) +module Keys = Keys +module Coqlib = Coqlib + +(******************************************************************************) +(* Engine *) +(******************************************************************************) +(* module Logic_monad *) module Universes = Universes -module Declare = Declare -module Refine = Refine -module Find_subterm = Find_subterm -module Evar_kinds = Evar_kinds -module Decl_kinds = Decl_kinds -module Misctypes = Misctypes +module UState = UState +module Evd = Evd +module EConstr = EConstr +module Tactypes = Tactypes module Pattern = Pattern -module Vernacexpr = Vernacexpr -module Search = Search -module Notation_term = Notation_term +module Namegen = Namegen +module Termops = Termops +module Proofview_monad = Proofview_monad +module Evarutil = Evarutil +module Proofview = Proofview +module Ftactic = Ftactic +module Geninterp = Geninterp + +(******************************************************************************) +(* Pretyping *) +(******************************************************************************) +module Locusops = Locusops +module Pretype_errors = Pretype_errors module Reductionops = Reductionops module Inductiveops = Inductiveops -module Recordops = Recordops +(* module Vnorm *) +(* module Arguments_renaming *) +module Impargs = Impargs +(* module Nativenorm *) module Retyping = Retyping -module Typing = Typing +(* module Cbv *) +module Find_subterm = Find_subterm +(* module Evardefine *) module Evarsolve = Evarsolve +module Recordops = Recordops +module Evarconv = Evarconv +module Typing = Typing +module Miscops = Miscops +module Glob_ops = Glob_ops +module Redops = Redops +module Patternops = Patternops module Constr_matching = Constr_matching +module Tacred = Tacred +module Typeclasses = Typeclasses +module Classops = Classops +(* module Program *) +(* module Coercion *) +module Detyping = Detyping +module Indrec = Indrec +(* module Cases *) module Pretyping = Pretyping -module Evarconv = Evarconv module Unification = Unification -module Typeclasses = Typeclasses -module Pretype_errors = Pretype_errors -module Notation = Notation -module Declarations = Declarations -module Univops = Univops -module Declareops = Declareops -module Globnames = Globnames -module Environ = Environ -module Term = Term -module Coqlib = Coqlib -module Glob_term = Glob_term -module Context = Context +(******************************************************************************) +(* interp *) +(******************************************************************************) module Stdarg = Stdarg +module Genintern = Genintern +module Constrexpr_ops = Constrexpr_ops +module Notation_ops = Notation_ops +module Ppextend = Ppextend +module Notation = Notation +module Dumpglob = Dumpglob +(* module Syntax_def *) +module Smartlocate = Smartlocate +module Topconstr = Topconstr +(* module Reserve *) +(* module Implicit_quantifiers *) +module Constrintern = Constrintern +(* module Modintern *) +module Constrextern = Constrextern +(* module Discharge *) +module Declare = Declare + +(******************************************************************************) +(* Proofs *) +(******************************************************************************) +module Miscprint = Miscprint +module Goal = Goal +module Evar_refiner = Evar_refiner +(* module Proof_using *) +module Proof_type = Proof_type +module Logic = Logic +module Refine = Refine +module Proof = Proof +module Proof_bullet = Proof_bullet +module Proof_global = Proof_global +module Redexpr = Redexpr +module Refiner = Refiner module Tacmach = Tacmach -module Proofview = Proofview -module Evarutil = Evarutil -module EConstr = EConstr +module Pfedit = Pfedit +module Clenv = Clenv +(* module Clenvtac *) +(* "mli" file *) + +(******************************************************************************) +(* Printing *) +(******************************************************************************) +module Genprint = Genprint +module Pputils = Pputils +module Ppconstr = Ppconstr +module Printer = Printer +(* module Printmod *) +(* module Prettyp *) +module Ppvernac = Ppvernac + +(******************************************************************************) +(* Parsing *) +(******************************************************************************) +module Tok = Tok +module CLexer = CLexer +module Pcoq = Pcoq +module Egramml = Egramml +(* Egramcoq *) + +(******************************************************************************) +(* Tactics *) +(******************************************************************************) +(* module Dnet *) +(* module Dn *) +(* module Btermdn *) +module Tacticals = Tacticals +module Hipattern = Hipattern +module Ind_tables = Ind_tables +(* module Eqschemes *) +module Elimschemes = Elimschemes +module Tactics = Tactics +module Elim = Elim +module Equality = Equality +module Contradiction = Contradiction +module Inv = Inv +module Leminv = Leminv +module Hints = Hints +module Auto = Auto +module Eauto = Eauto +module Class_tactics = Class_tactics +(* module Term_dnet *) +module Eqdecide = Eqdecide +module Autorewrite = Autorewrite + +(******************************************************************************) +(* Vernac *) +(******************************************************************************) +(* module Vernacprop *) +module Lemmas = Lemmas +module Himsg = Himsg +module ExplainErr = ExplainErr +(* module Class *) +module Locality = Locality +module Metasyntax = Metasyntax +(* module Auto_ind_decl *) +module Search = Search +(* module Indschemes *) +module Obligations = Obligations +module Command = Command +module Classes = Classes +(* module Record *) +(* module Assumptions *) +module Vernacinterp = Vernacinterp +module Mltop = Mltop +module Topfmt = Topfmt +module Vernacentries = Vernacentries + +(******************************************************************************) +(* Stm *) +(******************************************************************************) +module Vernac_classifier = Vernac_classifier +module Stm = Stm -module Prelude = - struct - type global_reference = Globnames.global_reference - type metavariable = int - type meta_value_map = (metavariable * Constr.constr) list - type named_context_val = Environ.named_context_val - type conv_pb = Reduction.conv_pb = - | CONV - | CUMUL - type constr = Constr.constr - type types = Constr.types - type evar = Constr.existential_key - type 'constr pexistential = 'constr Constr.pexistential - type env = Environ.env - type evar_map = Evd.evar_map - type rigid = Evd.rigid = - | UnivRigid - | UnivFlexible of bool - type reference = Libnames.reference = - | Qualid of Libnames.qualid Loc.located - | Ident of Names.Id.t Loc.located - end - -(* NOTE: It does not make sense to replace the following "module expression" - simply with "module Proof_type = Proof_type" because - there is only "kernel/entries.mli"; - there is no "kernel/entries.ml" file *) -module Entries = - struct - type mutual_inductive_entry = Entries.mutual_inductive_entry - type inline = int option - type 'a proof_output = Constr.constr Univ.in_universe_context_set * 'a - type 'a const_entry_body = 'a proof_output Future.computation - type 'a definition_entry = 'a Entries.definition_entry = - { const_entry_body : 'a const_entry_body; - const_entry_secctx : Context.Named.t option; - const_entry_feedback : Stateid.t option; - const_entry_type : Term.types option; - const_entry_polymorphic : bool; - const_entry_universes : Univ.universe_context; - const_entry_opaque : bool; - const_entry_inline_code : bool } - type parameter_entry = Entries.parameter_entry - type projection_entry = Entries.projection_entry - type 'a constant_entry = 'a Entries.constant_entry = - | DefinitionEntry of 'a definition_entry - | ParameterEntry of parameter_entry - | ProjectionEntry of projection_entry - end +(******************************************************************************) +(* Highparsing *) +(******************************************************************************) +module G_vernac = G_vernac +module G_proofs = G_proofs diff --git a/API/API.mli b/API/API.mli index 9f13f51fce..a99cd2a9ae 100644 --- a/API/API.mli +++ b/API/API.mli @@ -1,181 +1,83 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -module Prelude : -sig - (* None of the items in this modules are meant to be used by plugin-writers. - This module is here only for "technical reasons" - (it will disappear when we take advantage of mutually-recursive modules) *) - - (* API.Term.constr *) - type constr = Constr.t - - (* API.Term.types *) - type types = Constr.t - - (* API.Evar.t *) - type evar = Evar.t - - (* 'constr API.Term.pexistential *) - type 'constr pexistential = evar * 'constr array - - (* API.Environ.env *) - type env = Environ.env +(* Warning, this file should respect the dependency order established + in Coq. To see such order issue the comand: - (* API.Evar.Map.t *) - type evar_map = Evd.evar_map + ``` + bash -c 'for i in kernel intf library engine pretyping interp proofs parsing printing tactics vernac stm toplevel; do echo -e "\n## $i files" && cat ${i}/${i}.mllib; done && echo -e "\n## highparsing files" && cat parsing/highparsing.mllib' > API/link + ``` - (* API.Globnames.global_reference *) - type global_reference = Globnames.global_reference + Note however that files in intf/ are located manually now as their + conceptual linking order in the Coq codebase is incorrect (but it + works due to these files being implementation-free. - type rigid = Evd.rigid = - | UnivRigid - | UnivFlexible of bool + See below in the file for their concrete position. +*) - type conv_pb = Reduction.conv_pb = - | CONV - | CUMUL - - type named_context_val = Environ.named_context_val - - type metavariable = int - - (* Termops.meta_value_map *) - type meta_value_map = (metavariable * constr) list - - (* API.Libnames.reference *) - type reference = Libnames.reference = - | Qualid of Libnames.qualid Loc.located - | Ident of Names.Id.t Loc.located +(************************************************************************) +(* Modules from config/ *) +(************************************************************************) +module Coq_config : +sig + val exec_extension : string end -module Univ : +(************************************************************************) +(* Modules from kernel/ *) +(************************************************************************) +module Names : sig - module Level : - sig - type t = Univ.Level.t - val set : t - val pr : t -> Pp.std_ppcmds - end - - module Instance : - sig - type t = Univ.Instance.t - val empty : t - val of_array : Level.t array -> t - val to_array : t -> Level.t array - val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds - end - type 'a puniverses = 'a * Instance.t - val out_punivs : 'a puniverses -> 'a - module Constraint : module type of struct include Univ.Constraint end + open Util - type 'a constrained = 'a * Constraint.t - - module UContext : + module Id : sig - type t = Univ.UContext.t - val empty : t - end - - type universe_context = UContext.t - [@@ocaml.deprecated "alias of API.Univ.UContext.t"] - - type abstract_universe_context = Univ.AUContext.t - type cumulativity_info = Univ.CumulativityInfo.t - type abstract_cumulativity_info = Univ.ACumulativityInfo.t + type t + val equal : t -> t -> bool + val compare : t -> t -> int + val hash : t -> int + val is_valid : string -> bool + val of_bytes : bytes -> t + val of_string : string -> t + val of_string_soft : string -> t + val to_string : t -> string + val print : t -> Pp.t - module LSet : module type of struct include Univ.LSet end - module ContextSet : - sig - type t = Univ.ContextSet.t - val empty : t - val of_context : UContext.t -> t - val to_context : t -> UContext.t + module Set : Set.S with type elt = t + module Map : Map.ExtS with type key = t and module Set := Set + module Pred : Predicate.S with type elt = t + module List : List.MonoS with type elt = t + val hcons : t -> t end - type 'a in_universe_context_set = 'a * ContextSet.t - type 'a in_universe_context = 'a * UContext.t - type constraint_type = Univ.constraint_type - - module Universe : + module Name : sig - type t = Univ.Universe.t - val pr : t -> Pp.std_ppcmds - end - - type universe_context_set = ContextSet.t - [@@ocaml.deprecated "alias of API.Names.ContextSet.t"] - - type universe_set = LSet.t - [@@ocaml.deprecated "alias of API.Names.LSet.t"] - - type 'a constraint_function = 'a -> 'a -> Constraint.t -> Constraint.t - type universe_subst = Univ.universe_subst - type universe_level_subst = Univ.universe_level_subst - - val enforce_leq : Universe.t constraint_function - val pr_uni : Universe.t -> Pp.std_ppcmds - val pr_universe_context : (Level.t -> Pp.std_ppcmds) -> UContext.t -> Pp.std_ppcmds - val pr_universe_context_set : (Level.t -> Pp.std_ppcmds) -> ContextSet.t -> Pp.std_ppcmds - val pr_universe_subst : universe_subst -> Pp.std_ppcmds - val pr_universe_level_subst : universe_level_subst -> Pp.std_ppcmds - val pr_constraints : (Level.t -> Pp.std_ppcmds) -> Constraint.t -> Pp.std_ppcmds -end - -module UState : -sig - type t = UState.t - val context : t -> Univ.UContext.t - val context_set : t -> Univ.ContextSet.t - val of_context_set : Univ.ContextSet.t -> t -end - -module Sorts : -sig - type contents = Sorts.contents = Pos | Null - type t = Sorts.t = - | Prop of contents - | Type of Univ.Universe.t - val is_prop : t -> bool - val hash : t -> int - - type family = Sorts.family = InProp | InSet | InType - val family : t -> family -end - -module Names : -sig - module Id : module type of struct include Names.Id end - - module MBId : sig - type t = Names.MBId.t + type t = Anonymous (** anonymous identifier *) + | Name of Id.t (** non-anonymous identifier *) + val mk_name : Id.t -> t + val is_anonymous : t -> bool + val is_name : t -> bool + val compare : t -> t -> int val equal : t -> t -> bool - val to_id : t -> Names.Id.t - val repr : t -> int * Names.Id.t * Names.DirPath.t - val debug_to_string : t -> string + val hash : t -> int + val hcons : t -> t + val print : t -> Pp.t end - type evaluable_global_reference = Names.evaluable_global_reference = - | EvalVarRef of Id.t - | EvalConstRef of Names.Constant.t - - module Name : module type of struct include Names.Name end - type name = Name.t = - | Anonymous + | Anonymous | Name of Id.t [@@ocaml.deprecated "alias of API.Name.t"] module DirPath : sig - type t = Names.DirPath.t + type t val empty : t val make : Id.t list -> t val repr : t -> Id.t list @@ -183,23 +85,31 @@ sig val to_string : t -> string end + module MBId : sig + type t + val equal : t -> t -> bool + val to_id : t -> Id.t + val repr : t -> int * Id.t * DirPath.t + val debug_to_string : t -> string + end + module Label : sig - type t = Names.Label.t + type t val make : string -> t val equal : t -> t -> bool val compare : t -> t -> int - val of_id : Names.Id.t -> t - val to_id : t -> Names.Id.t + val of_id : Id.t -> t + val to_id : t -> Id.t val to_string : t -> string end module ModPath : sig - type t = Names.ModPath.t = - | MPfile of Names.DirPath.t - | MPbound of MBId.t - | MPdot of t * Label.t + type t = + | MPfile of DirPath.t + | MPbound of MBId.t + | MPdot of t * Label.t val compare : t -> t -> int val equal : t -> t -> bool val hash : t -> int @@ -210,7 +120,7 @@ sig module KerName : sig - type t = Names.KerName.t + type t val make : ModPath.t -> DirPath.t -> Label.t -> t val make2 : ModPath.t -> Label.t -> t val modpath : t -> ModPath.t @@ -218,7 +128,7 @@ sig val compare : t -> t -> int val label : t -> Label.t val repr : t -> ModPath.t * DirPath.t * Label.t - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t val to_string : t -> string end @@ -227,40 +137,46 @@ sig module Constant : sig - type t = Names.Constant.t + type t val equal : t -> t -> bool - val make1 : Names.KerName.t -> t - val make2 : Names.ModPath.t -> Label.t -> t - val make3 : Names.ModPath.t -> Names.DirPath.t -> Label.t -> t - val repr3 : t -> Names.ModPath.t * Names.DirPath.t * Label.t - val canonical : t -> Names.KerName.t - val user : t -> Names.KerName.t + val make1 : KerName.t -> t + val make2 : ModPath.t -> Label.t -> t + val make3 : ModPath.t -> DirPath.t -> Label.t -> t + val repr3 : t -> ModPath.t * DirPath.t * Label.t + val canonical : t -> KerName.t + val user : t -> KerName.t val label : t -> Label.t end module MutInd : sig - type t = Names.MutInd.t - val make1 : Names.KerName.t -> t - val make2 : Names.ModPath.t -> Label.t -> t + type t + val make1 : KerName.t -> t + val make2 : ModPath.t -> Label.t -> t val equal : t -> t -> bool - val repr3 : t -> Names.ModPath.t * Names.DirPath.t * Label.t - val canonical : t -> Names.KerName.t - val modpath : t -> Names.ModPath.t + val repr3 : t -> ModPath.t * DirPath.t * Label.t + val canonical : t -> KerName.t + val modpath : t -> ModPath.t val label : t -> Label.t - val user : t -> Names.KerName.t - val print : t -> Pp.std_ppcmds + val user : t -> KerName.t + val print : t -> Pp.t end module Projection : sig - type t = Names.Projection.t + type t val make : Constant.t -> bool -> t val map : (Constant.t -> Constant.t) -> t -> t val constant : t -> Constant.t val equal : t -> t -> bool + val unfolded : t -> bool + val unfold : t -> t end + type evaluable_global_reference = + | EvalVarRef of Id.t + | EvalConstRef of Constant.t + type inductive = MutInd.t * int val eq_ind : inductive -> inductive -> bool @@ -268,31 +184,37 @@ sig val eq_constructor : constructor -> constructor -> bool val constructor_hash : constructor -> int - module MPset : module type of struct include Names.MPset end - module MPmap : module type of struct include Names.MPmap end - module KNset : module type of struct include Names.KNset end - module KNmap : module type of struct include Names.KNmap end - module Cset : module type of struct include Names.Cset end - module Cset_env : module type of struct include Names.Cset_env end - module Cmap : module type of struct include Names.Cmap end - module Cmap_env : module type of struct include Names.Cmap_env end - module Cpred : module type of struct include Names.Cpred end - module Mindset : module type of struct include Names.Mindset end - module Mindmap : module type of struct include Names.Mindmap end - module Mindmap_env : module type of struct include Names.Mindmap_env end - module Indmap : module type of struct include Names.Indmap end - with type key = inductive - module Indmap_env : module type of struct include Names.Indmap_env end - module Constrmap : module type of struct include Names.Constrmap end - module Constrmap_env : module type of struct include Names.Constrmap_env end + module MPset : Set.S with type elt = ModPath.t + module MPmap : Map.ExtS with type key = ModPath.t and module Set := MPset + + module KNset : CSig.SetS with type elt = KerName.t + module KNpred : Predicate.S with type elt = KerName.t + module KNmap : Map.ExtS with type key = KerName.t and module Set := KNset + + module Cpred : Predicate.S with type elt = Constant.t + module Cset : CSig.SetS with type elt = Constant.t + module Cset_env : CSig.SetS with type elt = Constant.t + + module Cmap : Map.ExtS with type key = Constant.t and module Set := Cset + module Cmap_env : Map.ExtS with type key = Constant.t and module Set := Cset_env + + module Mindset : CSig.SetS with type elt = MutInd.t + module Mindmap : Map.ExtS with type key = MutInd.t and module Set := Mindset + module Mindmap_env : CSig.MapS with type key = MutInd.t + + module Indmap : CSig.MapS with type key = inductive + module Constrmap : CSig.MapS with type key = constructor + module Indmap_env : CSig.MapS with type key = inductive + module Constrmap_env : CSig.MapS with type key = constructor type transparent_state = Id.Pred.t * Cpred.t + val empty_transparent_state : transparent_state val full_transparent_state : transparent_state val var_full_transparent_state : transparent_state val cst_full_transparent_state : transparent_state - val pr_kn : KerName.t -> Pp.std_ppcmds + val pr_kn : KerName.t -> Pp.t [@@ocaml.deprecated "alias of API.Names.KerName.print"] val eq_constant : Constant.t -> Constant.t -> bool @@ -305,9 +227,8 @@ sig [@@ocaml.deprecated "alias of API.Names.ModPath.t"] type variable = Id.t - [@@ocaml.deprecated "alias of API.Names.Id.t"] - type 'a tableKey = 'a Names.tableKey = + type 'a tableKey = | ConstKey of 'a | VarKey of Id.t | RelKey of Int.t @@ -378,11 +299,11 @@ sig val make_con : ModPath.t -> DirPath.t -> Label.t -> Constant.t [@@ocaml.deprecated "alias of API.Names.Constant.make3"] - val debug_pr_con : Constant.t -> Pp.std_ppcmds + val debug_pr_con : Constant.t -> Pp.t - val debug_pr_mind : MutInd.t -> Pp.std_ppcmds + val debug_pr_mind : MutInd.t -> Pp.t - val pr_con : Constant.t -> Pp.std_ppcmds + val pr_con : Constant.t -> Pp.t val string_of_con : Constant.t -> string @@ -392,23 +313,297 @@ sig val debug_string_of_con : Constant.t -> string - module Idset : module type of struct include Id.Set end + type identifier = Id.t + module Idset : Set.S with type elt = identifier and type t = Id.Set.t + end -module Context : +module Univ : +sig + + module Level : + sig + type t + val set : t + val pr : t -> Pp.t + end + + type universe_level = Level.t + + module LSet : + sig + include CSig.SetS with type elt = universe_level + val pr : (Level.t -> Pp.t) -> t -> Pp.t + end + + module Universe : + sig + type t + val pr : t -> Pp.t + end + + type universe = Universe.t + + module Instance : + sig + type t + val empty : t + val of_array : Level.t array -> t + val to_array : t -> Level.t array + val pr : (Level.t -> Pp.t) -> t -> Pp.t + end + + type 'a puniverses = 'a * Instance.t + + val out_punivs : 'a puniverses -> 'a + + type constraint_type = Lt | Le | Eq + + type univ_constraint = universe_level * constraint_type * universe_level + + module Constraint : sig + include Set.S with type elt = univ_constraint + end + + type 'a constrained = 'a * Constraint.t + + module UContext : + sig + type t + val empty : t + end + + type universe_context = UContext.t + + module AUContext : + sig + type t + val empty : t + end + + type abstract_universe_context = AUContext.t + + module CumulativityInfo : + sig + type t + end + + type cumulativity_info = CumulativityInfo.t + + module ACumulativityInfo : + sig + type t + end + type abstract_cumulativity_info = ACumulativityInfo.t + + module ContextSet : + sig + type t + val empty : t + val of_context : UContext.t -> t + val to_context : t -> UContext.t + end + + type 'a in_universe_context_set = 'a * ContextSet.t + type 'a in_universe_context = 'a * UContext.t + + type universe_context_set = ContextSet.t + + type universe_set = LSet.t + + type 'a constraint_function = 'a -> 'a -> Constraint.t -> Constraint.t + + module LMap : + sig + include CMap.ExtS with type key = universe_level and module Set := LSet + + val union : 'a t -> 'a t -> 'a t + val diff : 'a t -> 'a t -> 'a t + val subst_union : 'a option t -> 'a option t -> 'a option t + val pr : ('a -> Pp.t) -> 'a t -> Pp.t + end + + type 'a universe_map = 'a LMap.t + type universe_subst = universe universe_map + type universe_level_subst = universe_level universe_map + + val enforce_leq : Universe.t constraint_function + val pr_uni : Universe.t -> Pp.t + val pr_universe_context : (Level.t -> Pp.t) -> UContext.t -> Pp.t + val pr_universe_context_set : (Level.t -> Pp.t) -> ContextSet.t -> Pp.t + val pr_universe_subst : universe_subst -> Pp.t + val pr_universe_level_subst : universe_level_subst -> Pp.t + val pr_constraints : (Level.t -> Pp.t) -> Constraint.t -> Pp.t +end + +module UGraph : +sig + type t + val pr_universes : (Univ.Level.t -> Pp.t) -> t -> Pp.t +end + +module Esubst : +sig + type 'a subs + val subs_id : int -> 'a subs +end + +module Sorts : sig + type contents = Pos | Null + type t = + | Prop of contents + | Type of Univ.Universe.t + val is_prop : t -> bool + val hash : t -> int + + type family = InProp | InSet | InType + val family : t -> family +end + +module Evar : +sig + (** Unique identifier of some {i evar} *) + type t + (** Recover the underlying integer. *) + val repr : t -> int + + val equal : t -> t -> bool + + (** a set of unique identifiers of some {i evars} *) + module Set : Set.S with type elt = t + module Map : CMap.ExtS with type key = t and module Set := Set + +end + +module Constr : +sig + open Names + + type t + + type constr = t + type types = t + + type cast_kind = + | VMcast + | NATIVEcast + | DEFAULTcast + | REVERTcast + + type metavariable = int + + type existential_key = Evar.t + type 'constr pexistential = existential_key * 'constr array + + type 'a puniverses = 'a Univ.puniverses + type pconstant = Constant.t puniverses + type pinductive = inductive puniverses + type pconstructor = constructor puniverses + + type ('constr, 'types) prec_declaration = + Name.t array * 'types array * 'constr array + + type ('constr, 'types) pfixpoint = + (int array * int) * ('constr, 'types) prec_declaration + + type ('constr, 'types) pcofixpoint = + int * ('constr, 'types) prec_declaration + + type case_style = + LetStyle | IfStyle | LetPatternStyle | MatchStyle + | RegularStyle (** infer printing form from number of constructor *) + + type case_printing = + { ind_tags : bool list; (** tell whether letin or lambda in the arity of the inductive type *) + cstr_tags : bool list array; (** tell whether letin or lambda in the signature of each constructor *) + style : case_style } + + type case_info = + { ci_ind : inductive; (* inductive type to which belongs the value that is being matched *) + ci_npar : int; (* number of parameters of the above inductive type *) + ci_cstr_ndecls : int array; (* For each constructor, the corresponding integer determines + the number of values that can be bound in a match-construct. + NOTE: parameters of the inductive type are therefore excluded from the count *) + ci_cstr_nargs : int array; (* for each constructor, the corresponding integers determines + the number of values that can be applied to the constructor, + in addition to the parameters of the related inductive type + NOTE: "lets" are therefore excluded from the count + NOTE: parameters of the inductive type are also excluded from the count *) + ci_pp_info : case_printing (* not interpreted by the kernel *) + } + + type ('constr, 'types, 'sort, 'univs) kind_of_term = + | Rel of int + | Var of Id.t + | Meta of metavariable + | Evar of 'constr pexistential + | Sort of 'sort + | Cast of 'constr * cast_kind * 'types + | Prod of Name.t * 'types * 'types + | Lambda of Name.t * 'types * 'constr + | LetIn of Name.t * 'constr * 'types * 'constr + | App of 'constr * 'constr array + | Const of (Constant.t * 'univs) + | Ind of (inductive * 'univs) + | Construct of (constructor * 'univs) + | Case of case_info * 'constr * 'constr * 'constr array + | Fix of ('constr, 'types) pfixpoint + | CoFix of ('constr, 'types) pcofixpoint + | Proj of Projection.t * 'constr + + val equal : t -> t -> bool + val eq_constr_nounivs : t -> t -> bool + val compare : t -> t -> int + + val hash : t -> int + + val mkRel : int -> t + val mkVar : Id.t -> t + val mkMeta : metavariable -> t + type existential = existential_key * constr array + val mkEvar : existential -> t + val mkSort : Sorts.t -> t + val mkProp : t + val mkSet : t + val mkType : Univ.Universe.t -> t + val mkCast : t * cast_kind * t -> t + val mkProd : Name.t * types * types -> types + val mkLambda : Name.t * types * t -> t + val mkLetIn : Name.t * t * types * t -> t + val mkApp : t * t array -> t + val map_puniverses : ('a -> 'b) -> 'a puniverses -> 'b puniverses + + val mkConst : Constant.t -> t + val mkConstU : pconstant -> t + + val mkProj : (Projection.t * t) -> t + + val mkInd : inductive -> t + val mkIndU : pinductive -> t + + val mkConstruct : constructor -> t + val mkConstructU : pconstructor -> t + val mkConstructUi : pinductive * int -> t + + val mkCase : case_info * t * t * t array -> t + +end + +module Context : +sig module Rel : sig module Declaration : sig (* local declaration *) (* local declaration *) - type ('constr, 'types) pt = ('constr, 'types) Context.Rel.Declaration.pt = + type ('constr, 'types) pt = | LocalAssum of Names.Name.t * 'types (** name, type *) | LocalDef of Names.Name.t * 'constr * 'types (** name, value, type *) - type t = (Prelude.constr, Prelude.types) pt + type t = (Constr.constr, Constr.types) pt (** Return the name bound by a given declaration. *) val get_name : ('c, 't) pt -> Names.Name.t @@ -445,7 +640,7 @@ sig val map_constr : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt (** Perform a given action on all terms in a given declaration. *) - val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit + val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit (** Reduce all terms in a given declaration to a single value. *) val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a @@ -498,11 +693,11 @@ sig module Declaration : sig (** local declaration *) - type ('constr, 'types) pt = ('constr, 'types) Context.Named.Declaration.pt = + type ('constr, 'types) pt = | LocalAssum of Names.Id.t * 'types (** identifier, type *) | LocalDef of Names.Id.t * 'constr * 'types (** identifier, value, type *) - type t = (Prelude.constr, Prelude.types) pt + type t = (Constr.constr, Constr.types) pt (** Return the identifier bound by a given declaration. *) val get_id : ('c, 't) pt -> Names.Id.t @@ -599,12 +794,32 @@ sig end end +module Vars : +sig + type substl = Constr.t list + + val substl : substl -> Constr.t -> Constr.t + + val subst1 : Constr.t -> Constr.t -> Constr.t + + val lift : int -> Constr.t -> Constr.t + + val closed0 : Constr.t -> bool + + val closedn : int -> Constr.t -> bool + + val replace_vars : (Names.Id.t * Constr.t) list -> Constr.t -> Constr.t + + val noccurn : int -> Constr.t -> bool + val subst_var : Names.Id.t -> Constr.t -> Constr.t + val subst_vars : Names.Id.t list -> Constr.t -> Constr.t + val substnl : substl -> int -> Constr.t -> Constr.t +end + module Term : sig - type sorts_family = Sorts.family = InProp | InSet | InType - [@@deprecated "alias of API.Sorts.family"] - type metavariable = Prelude.metavariable + type sorts_family = Sorts.family = InProp | InSet | InType type contents = Sorts.contents = Pos | Null @@ -613,45 +828,55 @@ sig | Type of Univ.Universe.t [@@ocaml.deprecated "alias of API.Sorts.t"] - type constr = Prelude.constr - type types = Prelude.types + type constr = Constr.t + type types = Constr.t + + type metavariable = int + type ('constr, 'types) prec_declaration = Names.Name.t array * 'types array * 'constr array - type 'constr pexistential = 'constr Prelude.pexistential - type cast_kind = Term.cast_kind = + + type 'constr pexistential = 'constr Constr.pexistential + type cast_kind = Constr.cast_kind = | VMcast | NATIVEcast | DEFAULTcast | REVERTcast + type 'a puniverses = 'a Univ.puniverses type pconstant = Names.Constant.t puniverses type pinductive = Names.inductive puniverses type pconstructor = Names.constructor puniverses - type case_style = Term.case_style = - | LetStyle - | IfStyle - | LetPatternStyle - | MatchStyle - | RegularStyle - type case_printing = Term.case_printing = - { ind_tags : bool list; - cstr_tags : bool list array; - style : case_style - } - type case_info = Term.case_info = - { ci_ind : Names.inductive; - ci_npar : int; - ci_cstr_ndecls : int array; - ci_cstr_nargs : int array; - ci_pp_info : case_printing - } + type case_style = Constr.case_style = + | LetStyle + | IfStyle + | LetPatternStyle + | MatchStyle + | RegularStyle + + type case_printing = Constr.case_printing = + { ind_tags : bool list; + cstr_tags : bool list array; + style : case_style + } + + type case_info = Constr.case_info = + { ci_ind : Names.inductive; + ci_npar : int; + ci_cstr_ndecls: int array; + ci_cstr_nargs : int array; + ci_pp_info : case_printing + } + type ('constr, 'types) pfixpoint = (int array * int) * ('constr, 'types) prec_declaration + type ('constr, 'types) pcofixpoint = int * ('constr, 'types) prec_declaration - type ('constr, 'types, 'sort, 'univs) kind_of_term = ('constr, 'types, 'sort, 'univs) Term.kind_of_term = + + type ('constr, 'types, 'sort, 'univs) kind_of_term = ('constr, 'types, 'sort, 'univs) Constr.kind_of_term = | Rel of int | Var of Names.Id.t - | Meta of metavariable + | Meta of Constr.metavariable | Evar of 'constr pexistential | Sort of 'sort | Cast of 'constr * cast_kind * 'types @@ -666,7 +891,7 @@ sig | Fix of ('constr, 'types) pfixpoint | CoFix of ('constr, 'types) pcofixpoint | Proj of Names.Projection.t * 'constr - type existential = Prelude.evar * constr array + type existential = Constr.existential_key * constr array type rec_declaration = Names.Name.t array * constr array * constr array type fixpoint = (int array * int) * rec_declaration type cofixpoint = int * rec_declaration @@ -680,7 +905,7 @@ sig val mkRel : int -> constr val mkVar : Names.Id.t -> constr - val mkMeta : Prelude.metavariable -> constr + val mkMeta : Constr.metavariable -> constr val mkEvar : existential -> constr val mkSort : Sorts.t -> types @@ -760,18 +985,19 @@ sig *) val eq_constr_nounivs : constr -> constr -> bool - type ('constr, 'types) kind_of_type = ('constr, 'types) Term.kind_of_type = - | SortType of Sorts.t - | CastType of 'types * 'types - | ProdType of Names.Name.t * 'types * 'types - | LetInType of Names.Name.t * 'constr * 'types * 'types - | AtomicType of 'constr * 'constr array + type ('constr, 'types) kind_of_type = + | SortType of Sorts.t + | CastType of 'types * 'types + | ProdType of Names.Name.t * 'types * 'types + | LetInType of Names.Name.t * 'constr * 'types * 'types + | AtomicType of 'constr * 'constr array + val kind_of_type : types -> (constr, types) kind_of_type val is_prop_sort : Sorts.t -> bool [@@ocaml.deprecated "alias of API.Sorts.is_prop"] - type existential_key = Prelude.evar + type existential_key = Constr.existential_key val family_of_sort : Sorts.t -> Sorts.family @@ -792,181 +1018,13 @@ sig val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool end -module EConstr : -sig - type t = EConstr.t - type constr = t - type types = t - type unsafe_judgment = EConstr.unsafe_judgment - type named_declaration = (constr, types) Context.Named.Declaration.pt - type named_context = (constr, types) Context.Named.pt - type rel_context = (constr, types) Context.Rel.pt - type rel_declaration = (constr, types) Context.Rel.Declaration.pt - type existential = constr Term.pexistential - module ESorts : - sig - type t = EConstr.ESorts.t - (** Type of sorts up-to universe unification. Essentially a wrapper around - Sorts.t so that normalization is ensured statically. *) - - val make : Sorts.t -> t - (** Turn a sort into an up-to sort. *) - - val kind : Prelude.evar_map -> t -> Sorts.t - (** Returns the view into the current sort. Note that the kind of a variable - may change if the unification state of the evar map changes. *) - - end - - module EInstance : - sig - type t = EConstr.EInstance.t - (** Type of universe instances up-to universe unification. Similar to - {ESorts.t} for {Univ.Instance.t}. *) - - val make : Univ.Instance.t -> t - val kind : Prelude.evar_map -> t -> Univ.Instance.t - val empty : t - val is_empty : t -> bool - end - - val of_constr : Term.constr -> constr - - val kind : Prelude.evar_map -> constr -> (constr, constr, ESorts.t, EInstance.t) Term.kind_of_term - - val mkArrow : constr -> constr -> constr - val mkInd : Names.inductive -> t - val mkProp : constr - val mkProd : Names.Name.t * constr * constr -> constr - val mkRel : int -> constr - val mkSort : Sorts.t -> constr - val mkVar : Names.Id.t -> constr - val mkLambda : Names.Name.t * constr * constr -> constr - val mkLambda_or_LetIn : rel_declaration -> constr -> constr - val mkApp : constr * constr array -> constr - val mkEvar : constr Term.pexistential -> constr - - val mkMeta : Prelude.metavariable -> constr - - val mkConstructU : Names.constructor * EInstance.t -> constr - val mkLetIn : Names.Name.t * constr * constr * constr -> constr - val mkProd_or_LetIn : rel_declaration -> constr -> constr - val mkCast : constr * Term.cast_kind * constr -> constr - val mkNamedLambda : Names.Id.t -> types -> constr -> constr - val mkNamedProd : Names.Id.t -> types -> types -> types - - val isCast : Evd.evar_map -> t -> bool - val isEvar : Prelude.evar_map -> constr -> bool - val isInd : Prelude.evar_map -> constr -> bool - val isRel : Prelude.evar_map -> constr -> bool - val isSort : Prelude.evar_map -> constr -> bool - val isVar : Prelude.evar_map -> constr -> bool - val isConst : Prelude.evar_map -> constr -> bool - val isConstruct : Prelude.evar_map -> constr -> bool - - val destInd : Prelude.evar_map -> constr -> Names.inductive * EInstance.t - val destVar : Prelude.evar_map -> constr -> Names.Id.t - val destEvar : Prelude.evar_map -> constr -> constr Term.pexistential - val destRel : Prelude.evar_map -> constr -> int - val destProd : Prelude.evar_map -> constr -> Names.Name.t * types * types - val destLambda : Prelude.evar_map -> constr -> Names.Name.t * types * constr - val destApp : Prelude.evar_map -> constr -> constr * constr array - val destConst : Prelude.evar_map -> constr -> Names.Constant.t * EInstance.t - val destConstruct : Prelude.evar_map -> constr -> Names.constructor * EInstance.t - val destFix : Evd.evar_map -> t -> (t, t) Term.pfixpoint - val destCast : Evd.evar_map -> t -> t * Term.cast_kind * t - - val mkConstruct : Names.constructor -> constr - - val compose_lam : (Names.Name.t * constr) list -> constr -> constr - - val decompose_lam : Prelude.evar_map -> constr -> (Names.Name.t * constr) list * constr - val decompose_lam_n_assum : Prelude.evar_map -> int -> constr -> rel_context * constr - val decompose_app : Prelude.evar_map -> constr -> constr * constr list - val decompose_prod : Prelude.evar_map -> constr -> (Names.Name.t * constr) list * constr - val decompose_prod_assum : Prelude.evar_map -> constr -> rel_context * constr - - val applist : constr * constr list -> constr - - val to_constr : Prelude.evar_map -> constr -> Constr.t - - val push_rel : rel_declaration -> Prelude.env -> Prelude.env - - module Unsafe : - sig - val to_constr : constr -> Term.constr - - val to_rel_decl : (constr, types) Context.Rel.Declaration.pt -> (Prelude.constr, Prelude.types) Context.Rel.Declaration.pt - - (** Physical identity. Does not care for defined evars. *) - - val to_named_decl : (constr, types) Context.Named.Declaration.pt -> (Prelude.constr, Prelude.types) Context.Named.Declaration.pt - - val to_instance : EInstance.t -> Univ.Instance.t - end - - module Vars : - sig - val substnl : t list -> int -> t -> t - val noccurn : Prelude.evar_map -> int -> constr -> bool - val closed0 : Prelude.evar_map -> constr -> bool - val subst1 : constr -> constr -> constr - val substl : constr list -> constr -> constr - val lift : int -> constr -> constr - val liftn : int -> int -> t -> t - val subst_var : Names.Id.t -> t -> t - val subst_vars : Names.Id.t list -> t -> t - end - - val fresh_global : - ?loc:Loc.t -> ?rigid:Prelude.rigid -> ?names:Univ.Instance.t -> Environ.env -> - Evd.evar_map -> Prelude.global_reference -> Evd.evar_map * t - -val of_named_decl : (Term.constr, Term.types) Context.Named.Declaration.pt -> (constr, types) Context.Named.Declaration.pt - val of_rel_decl : (Term.constr, Term.types) Context.Rel.Declaration.pt -> (constr, types) Context.Rel.Declaration.pt - val kind_of_type : Prelude.evar_map -> constr -> (constr, constr) Term.kind_of_type - val to_lambda : Prelude.evar_map -> int -> constr -> constr - val it_mkLambda_or_LetIn : constr -> rel_context -> constr - val push_rel_context : rel_context -> Prelude.env -> Prelude.env - val eq_constr : Prelude.evar_map -> constr -> constr -> bool - val iter_with_binders : Prelude.evar_map -> ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit - val fold : Prelude.evar_map -> ('a -> constr -> 'a) -> 'a -> constr -> 'a - val existential_type : Prelude.evar_map -> existential -> types - val iter : Prelude.evar_map -> (constr -> unit) -> constr -> unit - val eq_constr_universes : Prelude.evar_map -> constr -> constr -> Universes.universe_constraints option - val eq_constr_nounivs : Prelude.evar_map -> constr -> constr -> bool - val compare_constr : Evd.evar_map -> (constr -> constr -> bool) -> constr -> constr -> bool - val isApp : Prelude.evar_map -> constr -> bool - val it_mkProd_or_LetIn : constr -> rel_context -> constr - val push_named : named_declaration -> Prelude.env -> Prelude.env - val destCase : Prelude.evar_map -> constr -> Term.case_info * constr * constr * constr array - val decompose_lam_assum : Prelude.evar_map -> constr -> rel_context * constr - val mkConst : Names.Constant.t -> constr - val mkCase : Term.case_info * constr * constr * constr array -> constr - val named_context : Prelude.env -> named_context - val val_of_named_context : named_context -> Prelude.named_context_val - val mkFix : (t, t) Term.pfixpoint -> t - val decompose_prod_n_assum : Evd.evar_map -> int -> t -> rel_context * t - val isMeta : Evd.evar_map -> t -> bool - - val destMeta : Evd.evar_map -> t -> Term.metavariable - - val map_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> t) -> 'a -> t -> t - val mkNamedLetIn : Names.Id.t -> constr -> types -> constr -> constr - val map : Evd.evar_map -> (t -> t) -> t -> t - val mkConstU : Names.Constant.t * EInstance.t -> t - val isProd : Evd.evar_map -> t -> bool - val mkConstructUi : (Names.inductive * EInstance.t) * int -> t - val isLambda : Evd.evar_map -> t -> bool -end - module Mod_subst : sig - type substitution = Mod_subst.substitution - type 'a substituted = 'a Mod_subst.substituted - type delta_resolver = Mod_subst.delta_resolver + type delta_resolver + type substitution + type 'a substituted - val force_constr : Term.constr substituted -> Term.constr + val force_constr : Constr.t substituted -> Constr.t val empty_delta_resolver : delta_resolver val constant_of_delta_kn : delta_resolver -> Names.KerName.t -> Names.Constant.t @@ -974,21 +1032,94 @@ sig val subst_kn : substitution -> Names.KerName.t -> Names.KerName.t val subst_evaluable_reference : substitution -> Names.evaluable_global_reference -> Names.evaluable_global_reference - val subst_mps : substitution -> Term.constr -> Term.constr + val subst_mps : substitution -> Constr.t -> Constr.t val subst_constant : substitution -> Names.Constant.t -> Names.Constant.t val subst_ind : substitution -> Names.inductive -> Names.inductive - val debug_pr_subst : substitution -> Pp.std_ppcmds - val debug_pr_delta : delta_resolver -> Pp.std_ppcmds + val debug_pr_subst : substitution -> Pp.t + val debug_pr_delta : delta_resolver -> Pp.t +end + +module Opaqueproof : +sig + type opaquetab + type opaque + val empty_opaquetab : opaquetab + val force_proof : opaquetab -> opaque -> Constr.t +end + +module Cbytecodes : +sig + type tag = int + type reloc_table = (tag * int) array +end + +module Cemitcodes : +sig + type to_patch_substituted +end + +module Decl_kinds : +sig + type polymorphic = bool + type cumulative_inductive_flag = bool + type recursivity_kind = + | Finite + | CoFinite + | BiFinite + + type locality = + | Discharge + | Local + | Global + + type definition_object_kind = + | Definition + | Coercion + | SubClass + | CanonicalStructure + | Example + | Fixpoint + | CoFixpoint + | Scheme + | StructureComponent + | IdentityCoercion + | Instance + | Method + type theorem_kind = + | Theorem + | Lemma + | Fact + | Remark + | Property + | Proposition + | Corollary + type goal_object_kind = + | DefinitionBody of definition_object_kind + | Proof of theorem_kind + type goal_kind = locality * polymorphic * goal_object_kind + type assumption_object_kind = + | Definitional + | Logical + | Conjectural + type logical_kind = + | IsAssumption of assumption_object_kind + | IsDefinition of definition_object_kind + | IsProof of theorem_kind + type binding_kind = + | Explicit + | Implicit + type private_flag = bool + type definition_kind = locality * polymorphic * definition_object_kind end module Retroknowledge : sig - type action = Retroknowledge.action - type nat_field = Retroknowledge.nat_field = + type action + type nat_field = | NatType | NatPlus | NatTimes - type n_field = Retroknowledge.n_field = + type n_field = | NPositive | NType | NTwice @@ -997,7 +1128,7 @@ sig | NPhiInv | NPlus | NTimes - type int31_field = Retroknowledge.int31_field = + type int31_field = | Int31Bits | Int31Type | Int31Constructor @@ -1023,63 +1154,85 @@ sig | Int31Lor | Int31Land | Int31Lxor - type field = Retroknowledge.field = + type field = | KInt31 of string * int31_field end +module Conv_oracle : +sig + type level +end + module Declarations : sig - type recarg = Declarations.recarg = + + open Names + + type recarg = | Norec | Mrec of Names.inductive | Imbr of Names.inductive type wf_paths = recarg Rtree.t - type inline = Declarations.inline - type constant_def = Declarations.constant_def = + type inline = int option + type constant_def = | Undef of inline - | Def of Term.constr Mod_subst.substituted + | Def of Constr.t Mod_subst.substituted | OpaqueDef of Opaqueproof.opaque - type template_arity = Declarations.template_arity = { + type template_arity = { template_param_levels : Univ.Level.t option list; template_level : Univ.Universe.t; } - type ('a, 'b) declaration_arity = ('a, 'b) Declarations.declaration_arity = + type ('a, 'b) declaration_arity = | RegularArity of 'a | TemplateArity of 'b - type constant_type = (Prelude.types, Context.Rel.t * template_arity) declaration_arity - type constant_universes = Declarations.constant_universes - type projection_body = Declarations.projection_body = { + type constant_universes = + | Monomorphic_const of Univ.universe_context + | Polymorphic_const of Univ.abstract_universe_context + + type projection_body = { proj_ind : Names.MutInd.t; proj_npars : int; proj_arg : int; - proj_type : Term.types; - proj_eta : Term.constr * Term.types; - proj_body : Term.constr; + proj_type : Constr.types; + proj_eta : Constr.t * Constr.types; + proj_body : Constr.t; } - type typing_flags = Declarations.typing_flags - type constant_body = Declarations.constant_body = { + type typing_flags = { + check_guarded : bool; + check_universes : bool; + } + + type constant_body = { const_hyps : Context.Named.t; const_body : constant_def; - const_type : constant_type; + const_type : Term.types; const_body_code : Cemitcodes.to_patch_substituted option; const_universes : constant_universes; const_proj : projection_body option; const_inline_code : bool; const_typing_flags : typing_flags; } - type one_inductive_body = Declarations.one_inductive_body = { + + type regular_inductive_arity = { + mind_user_arity : Constr.types; + mind_sort : Sorts.t; + } + + type inductive_arity = (regular_inductive_arity, template_arity) declaration_arity + + type one_inductive_body = { mind_typename : Names.Id.t; mind_arity_ctxt : Context.Rel.t; - mind_arity : Declarations.inductive_arity; + mind_arity : inductive_arity; mind_consnames : Names.Id.t array; - mind_user_lc : Term.types array; + mind_user_lc : Constr.types array; mind_nrealargs : int; mind_nrealdecls : int; mind_kelim : Sorts.family list; - mind_nf_lc : Term.types array; + mind_nf_lc : Constr.types array; mind_consnrealargs : int array; mind_consnrealdecls : int array; mind_recargs : wf_paths; @@ -1087,42 +1240,47 @@ sig mind_nb_args : int; mind_reloc_tbl : Cbytecodes.reloc_table; } - type ('ty,'a) functorize = ('ty,'a) Declarations.functorize = + + type ('ty,'a) functorize = | NoFunctor of 'a | MoreFunctor of Names.MBId.t * 'ty * ('ty,'a) functorize - type with_declaration = Declarations.with_declaration = + + type with_declaration = | WithMod of Names.Id.t list * Names.ModPath.t - | WithDef of Names.Id.t list * Term.constr Univ.in_universe_context - type module_alg_expr = Declarations.module_alg_expr = + | WithDef of Names.Id.t list * Constr.t Univ.in_universe_context + + type module_alg_expr = | MEident of Names.ModPath.t | MEapply of module_alg_expr * Names.ModPath.t | MEwith of module_alg_expr * with_declaration - type abstract_inductive_universes = Declarations.abstract_inductive_universes = - | Monomorphic_ind of Univ.UContext.t - | Polymorphic_ind of Univ.abstract_universe_context - | Cumulative_ind of Univ.abstract_cumulativity_info + type abstract_inductive_universes = + | Monomorphic_ind of Univ.universe_context + | Polymorphic_ind of Univ.abstract_universe_context + | Cumulative_ind of Univ.abstract_cumulativity_info - type mutual_inductive_body = Declarations.mutual_inductive_body = { + type record_body = (Id.t * Constant.t array * projection_body array) option + + type mutual_inductive_body = { mind_packets : one_inductive_body array; - mind_record : Declarations.record_body option; + mind_record : record_body option; mind_finite : Decl_kinds.recursivity_kind; mind_ntypes : int; mind_hyps : Context.Named.t; mind_nparams : int; mind_nparams_rec : int; mind_params_ctxt : Context.Rel.t; - mind_universes : Declarations.abstract_inductive_universes; + mind_universes : abstract_inductive_universes; mind_private : bool option; - mind_typing_flags : Declarations.typing_flags; + mind_typing_flags : typing_flags; } and module_expression = (module_type_body,module_alg_expr) functorize - and module_implementation = Declarations.module_implementation = + and module_implementation = | Abstract | Algebraic of module_expression | Struct of module_signature | FullStruct - and module_body = Declarations.module_body = + and module_body = { mod_mp : Names.ModPath.t; mod_expr : module_implementation; mod_type : module_signature; @@ -1134,28 +1292,99 @@ sig and module_signature = (module_type_body,structure_body) functorize and module_type_body = module_body and structure_body = (Names.Label.t * structure_field_body) list - and structure_field_body = Declarations.structure_field_body = + and structure_field_body = | SFBconst of constant_body | SFBmind of mutual_inductive_body | SFBmodule of module_body | SFBmodtype of module_type_body end -module Univops : sig - val universes_of_constr : Term.constr -> Univ.LSet.t - val restrict_universe_context : Univ.ContextSet.t -> Univ.LSet.t -> Univ.ContextSet.t +module Declareops : +sig + val constant_has_body : Declarations.constant_body -> bool + val is_opaque : Declarations.constant_body -> bool + val eq_recarg : Declarations.recarg -> Declarations.recarg -> bool +end + +module Entries : +sig + + open Names + open Constr + + type local_entry = + | LocalDefEntry of constr + | LocalAssumEntry of constr + + type inductive_universes = + | Monomorphic_ind_entry of Univ.universe_context + | Polymorphic_ind_entry of Univ.universe_context + | Cumulative_ind_entry of Univ.cumulativity_info + + type one_inductive_entry = { + mind_entry_typename : Id.t; + mind_entry_arity : constr; + mind_entry_template : bool; (* Use template polymorphism *) + mind_entry_consnames : Id.t list; + mind_entry_lc : constr list } + + type mutual_inductive_entry = { + mind_entry_record : (Names.Id.t option) option; + (** Some (Some id): primitive record with id the binder name of the record + in projections. + Some None: non-primitive record *) + mind_entry_finite : Decl_kinds.recursivity_kind; + mind_entry_params : (Id.t * local_entry) list; + mind_entry_inds : one_inductive_entry list; + mind_entry_universes : inductive_universes; + (* universe constraints and the constraints for subtyping of + inductive types in the block. *) + mind_entry_private : bool option; + } + + type inline = int option + type 'a proof_output = Constr.t Univ.in_universe_context_set * 'a + type 'a const_entry_body = 'a proof_output Future.computation + type constant_universes_entry = + | Monomorphic_const_entry of Univ.universe_context + | Polymorphic_const_entry of Univ.universe_context + type 'a definition_entry = + { const_entry_body : 'a const_entry_body; + (* List of section variables *) + const_entry_secctx : Context.Named.t option; + (* State id on which the completion of type checking is reported *) + const_entry_feedback : Stateid.t option; + const_entry_type : Constr.types option; + const_entry_universes : constant_universes_entry; + const_entry_opaque : bool; + const_entry_inline_code : bool } + type parameter_entry = Context.Named.t option * bool * Constr.types Univ.in_universe_context * inline + + type projection_entry = { + proj_entry_ind : MutInd.t; + proj_entry_arg : int } + + type 'a constant_entry = + | DefinitionEntry of 'a definition_entry + | ParameterEntry of parameter_entry + | ProjectionEntry of projection_entry + type module_struct_entry = Declarations.module_alg_expr + type module_params_entry = + (Names.MBId.t * module_struct_entry) list + type module_type_entry = module_params_entry * module_struct_entry end module Environ : sig - type env = Prelude.env - type named_context_val = Prelude.named_context_val - type ('constr, 'types) punsafe_judgment = ('constr, 'types) Environ.punsafe_judgment = + type env + type named_context_val + + type ('constr, 'types) punsafe_judgment = { uj_val : 'constr; uj_type : 'types } - type 'types punsafe_type_judgment = 'types Environ.punsafe_type_judgment = { + type 'types punsafe_type_judgment = { utj_val : 'types; utj_type : Sorts.t } @@ -1167,7 +1396,7 @@ sig val push_rec_types : Term.rec_declaration -> env -> env val lookup_rel : int -> env -> Context.Rel.Declaration.t val lookup_named : Names.Id.t -> env -> Context.Named.Declaration.t - val lookup_named_val : Names.Id.t -> Environ.named_context_val -> Context.Named.Declaration.t + val lookup_named_val : Names.Id.t -> named_context_val -> Context.Named.Declaration.t val lookup_constant : Names.Constant.t -> env -> Declarations.constant_body val opaque_tables : env -> Opaqueproof.opaquetab val is_projection : Names.Constant.t -> env -> bool @@ -1179,63 +1408,170 @@ sig val push_named_context_val : Context.Named.Declaration.t -> named_context_val -> named_context_val val reset_with_named_context : named_context_val -> env -> env val rel_context : env -> Context.Rel.t - val constant_value_in : env -> Names.Constant.t Univ.puniverses -> Term.constr - val named_type : Names.Id.t -> env -> Term.types - val constant_opt_value_in : env -> Names.Constant.t Univ.puniverses -> Term.constr option + val constant_value_in : env -> Names.Constant.t Univ.puniverses -> Constr.t + val named_type : Names.Id.t -> env -> Constr.types + val constant_opt_value_in : env -> Names.Constant.t Univ.puniverses -> Constr.t option val fold_named_context_reverse : ('a -> Context.Named.Declaration.t -> 'a) -> init:'a -> env -> 'a - val evaluable_named : Names.Id.t -> Environ.env -> bool + val evaluable_named : Names.Id.t -> env -> bool val push_context_set : ?strict:bool -> Univ.ContextSet.t -> env -> env end -module UGraph : +module CClosure : sig - type t = UGraph.t - val pr_universes : (Univ.Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds + + type table_key = Names.Constant.t Univ.puniverses Names.tableKey + + type fconstr + + type fterm = + | FRel of int + | FAtom of Constr.t (** Metas and Sorts *) + | FCast of fconstr * Constr.cast_kind * fconstr + | FFlex of table_key + | FInd of Names.inductive Univ.puniverses + | FConstruct of Names.constructor Univ.puniverses + | FApp of fconstr * fconstr array + | FProj of Names.Projection.t * fconstr + | FFix of Term.fixpoint * fconstr Esubst.subs + | FCoFix of Term.cofixpoint * fconstr Esubst.subs + | FCaseT of Term.case_info * Constr.t * fconstr * Constr.t array * fconstr Esubst.subs (* predicate and branches are closures *) + | FLambda of int * (Names.Name.t * Constr.t) list * Constr.t * fconstr Esubst.subs + | FProd of Names.Name.t * fconstr * fconstr + | FLetIn of Names.Name.t * fconstr * fconstr * Constr.t * fconstr Esubst.subs + | FEvar of Term.existential * fconstr Esubst.subs + | FLIFT of int * fconstr + | FCLOS of Constr.t * fconstr Esubst.subs + | FLOCKED + + module RedFlags : sig + type reds + type red_kind + val mkflags : red_kind list -> reds + val fBETA : red_kind + val fCOFIX : red_kind + val fCONST : Names.Constant.t -> red_kind + val fFIX : red_kind + val fMATCH : red_kind + val fZETA : red_kind + val red_add_transparent : reds -> Names.transparent_state -> reds + end + + type 'a infos_cache + type 'a infos = { + i_flags : RedFlags.reds; + i_cache : 'a infos_cache } + + type clos_infos = fconstr infos + + val mk_clos : fconstr Esubst.subs -> Constr.t -> fconstr + val mk_atom : Constr.t -> fconstr + val mk_clos_deep : + (fconstr Esubst.subs -> Constr.t -> fconstr) -> + fconstr Esubst.subs -> Constr.t -> fconstr + val mk_red : fterm -> fconstr + val all : RedFlags.reds + val beta : RedFlags.reds + val betaiota : RedFlags.reds + val betaiotazeta : RedFlags.reds + + val create_clos_infos : ?evars:(Term.existential -> Constr.t option) -> RedFlags.reds -> Environ.env -> clos_infos + + val whd_val : clos_infos -> fconstr -> Constr.t + + val inject : Constr.t -> fconstr + + val kl : clos_infos -> fconstr -> Constr.t + val term_of_fconstr : fconstr -> Constr.t end module Reduction : sig exception NotConvertible - type conv_pb = Prelude.conv_pb = + type conv_pb = | CONV | CUMUL - val whd_all : Environ.env -> Term.constr -> Term.constr + val whd_all : Environ.env -> Constr.t -> Constr.t - val whd_betaiotazeta : Environ.env -> Term.constr -> Term.constr + val whd_betaiotazeta : Environ.env -> Constr.t -> Constr.t val is_arity : Environ.env -> Term.types -> bool val dest_prod : Environ.env -> Term.types -> Context.Rel.t * Term.types - type 'a extended_conversion_function = + type 'a extended_conversion_function = ?l2r:bool -> ?reds:Names.transparent_state -> Environ.env -> - ?evars:((Term.existential->Term.constr option) * UGraph.t) -> + ?evars:((Term.existential->Constr.t option) * UGraph.t) -> 'a -> 'a -> unit - val conv : Term.constr extended_conversion_function + val conv : Constr.t extended_conversion_function end -module Vars : +module Type_errors : sig - type substl = Term.constr list - val substl : substl -> Term.constr -> Term.constr + open Names + open Term + open Environ + + type 'constr pguard_error = + (** Fixpoints *) + | NotEnoughAbstractionInFixBody + | RecursionNotOnInductiveType of 'constr + | RecursionOnIllegalTerm of int * (env * 'constr) * int list * int list + | NotEnoughArgumentsForFixCall of int + (** CoFixpoints *) + | CodomainNotInductiveType of 'constr + | NestedRecursiveOccurrences + | UnguardedRecursiveCall of 'constr + | RecCallInTypeOfAbstraction of 'constr + | RecCallInNonRecArgOfConstructor of 'constr + | RecCallInTypeOfDef of 'constr + | RecCallInCaseFun of 'constr + | RecCallInCaseArg of 'constr + | RecCallInCasePred of 'constr + | NotGuardedForm of 'constr + | ReturnPredicateNotCoInductive of 'constr + + type arity_error = + | NonInformativeToInformative + | StrongEliminationOnNonSmallType + | WrongArity + + type ('constr, 'types) ptype_error = + | UnboundRel of int + | UnboundVar of variable + | NotAType of ('constr, 'types) punsafe_judgment + | BadAssumption of ('constr, 'types) punsafe_judgment + | ReferenceVariables of identifier * 'constr + | ElimArity of pinductive * sorts_family list * 'constr * ('constr, 'types) punsafe_judgment + * (sorts_family * sorts_family * arity_error) option + | CaseNotInductive of ('constr, 'types) punsafe_judgment + | WrongCaseInfo of pinductive * case_info + | NumberBranches of ('constr, 'types) punsafe_judgment * int + | IllFormedBranch of 'constr * pconstructor * 'constr * 'constr + | Generalization of (Name.t * 'types) * ('constr, 'types) punsafe_judgment + | ActualType of ('constr, 'types) punsafe_judgment * 'types + | CantApplyBadType of + (int * 'constr * 'constr) * ('constr, 'types) punsafe_judgment * ('constr, 'types) punsafe_judgment array + | CantApplyNonFunctional of ('constr, 'types) punsafe_judgment * ('constr, 'types) punsafe_judgment array + | IllFormedRecBody of 'constr pguard_error * Name.t array * int * env * ('constr, 'types) punsafe_judgment array + | IllTypedRecBody of + int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array + | UnsatisfiedConstraints of Univ.Constraint.t + + type type_error = (constr, types) ptype_error - val subst1 : Term.constr -> Term.constr -> Term.constr - - val lift : int -> Term.constr -> Term.constr - - val closed0 : Term.constr -> bool - - val closedn : int -> Term.constr -> bool - - val replace_vars : (Names.Id.t * Term.constr) list -> Term.constr -> Term.constr + exception TypeError of Environ.env * type_error +end - val noccurn : int -> Term.constr -> bool - val subst_var : Names.Id.t -> Term.constr -> Term.constr - val subst_vars : Names.Id.t list -> Term.constr -> Term.constr - val substnl : substl -> int -> Term.constr -> Term.constr +module Modops : +sig + val destr_nofunctor : ('ty,'a) Declarations.functorize -> 'a + val add_structure : + Names.ModPath.t -> Declarations.structure_body -> Mod_subst.delta_resolver -> + Environ.env -> Environ.env + val add_module_type : Names.ModPath.t -> Declarations.module_type_body -> Environ.env -> Environ.env end module Inductive : @@ -1244,154 +1580,615 @@ sig val type_of_inductive : Environ.env -> mind_specif Univ.puniverses -> Term.types exception SingletonInductiveBecomesProp of Names.Id.t val lookup_mind_specif : Environ.env -> Names.inductive -> mind_specif - val find_inductive : Environ.env -> Term.types -> Term.pinductive * Term.constr list + val find_inductive : Environ.env -> Term.types -> Term.pinductive * Constr.t list end module Typeops : sig val infer_type : Environ.env -> Term.types -> Environ.unsafe_type_judgment - val type_of_constant_type : Environ.env -> Declarations.constant_type -> Term.types val type_of_constant_in : Environ.env -> Term.pconstant -> Term.types end -module Opaqueproof : +module Mod_typing : sig - type opaquetab = Opaqueproof.opaquetab - type opaque = Opaqueproof.opaque - val empty_opaquetab : opaquetab - val force_proof : opaquetab -> opaque -> Term.constr + type 'alg translation = + Declarations.module_signature * 'alg * Mod_subst.delta_resolver * Univ.ContextSet.t + val translate_modtype : + Environ.env -> Names.ModPath.t -> Entries.inline -> + Entries.module_type_entry -> Declarations.module_type_body + val translate_mse : + Environ.env -> Names.ModPath.t option -> Entries.inline -> Declarations.module_alg_expr -> + Declarations.module_alg_expr translation end -module Modops : +module Safe_typing : sig - val destr_nofunctor : ('ty,'a) Declarations.functorize -> 'a - val add_structure : - Names.ModPath.t -> Declarations.structure_body -> Mod_subst.delta_resolver -> - Environ.env -> Environ.env - val add_module_type : Names.ModPath.t -> Declarations.module_type_body -> Environ.env -> Environ.env + type private_constants + val mk_pure_proof : Constr.t -> private_constants Entries.proof_output end -module Entries : +(************************************************************************) +(* End of modules from kernel/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from intf/ *) +(************************************************************************) + +module Misctypes : sig - type mutual_inductive_entry = Entries.mutual_inductive_entry - type inline = int option - type 'a proof_output = Term.constr Univ.in_universe_context_set * 'a - type 'a const_entry_body = 'a proof_output Future.computation - type 'a definition_entry = 'a Entries.definition_entry = - { const_entry_body : 'a const_entry_body; - (* List of section variables *) - const_entry_secctx : Context.Named.t option; - (* State id on which the completion of type checking is reported *) - const_entry_feedback : Stateid.t option; - const_entry_type : Term.types option; - const_entry_polymorphic : bool; - const_entry_universes : Univ.UContext.t; - const_entry_opaque : bool; - const_entry_inline_code : bool } - type parameter_entry = Context.Named.t option * bool * Term.types Univ.in_universe_context * inline - type projection_entry = Entries.projection_entry - type 'a constant_entry = 'a Entries.constant_entry = - | DefinitionEntry of 'a definition_entry - | ParameterEntry of parameter_entry - | ProjectionEntry of projection_entry + type evars_flag = bool + type clear_flag = bool option + type advanced_flag = bool + type rec_flag = bool + + type 'a or_by_notation = + | AN of 'a + | ByNotation of (string * string option) Loc.located + + type 'a or_var = + | ArgArg of 'a + | ArgVar of Names.Id.t Loc.located + + type 'a and_short_name = 'a * Names.Id.t Loc.located option + + type 'a glob_sort_gen = + | GProp (** representation of [Prop] literal *) + | GSet (** representation of [Set] literal *) + | GType of 'a (** representation of [Type] literal *) + + type level_info = Names.Name.t Loc.located option + type glob_level = level_info glob_sort_gen + + type sort_info = Names.Name.t Loc.located list + type glob_sort = sort_info glob_sort_gen + + type case_style = Term.case_style = + | LetStyle + | IfStyle + | LetPatternStyle + | MatchStyle + | RegularStyle (** infer printing form from number of constructor *) + + type 'a cast_type = + | CastConv of 'a + | CastVM of 'a + | CastCoerce + | CastNative of 'a + + type 'constr intro_pattern_expr = + | IntroForthcoming of bool + | IntroNaming of intro_pattern_naming_expr + | IntroAction of 'constr intro_pattern_action_expr + and intro_pattern_naming_expr = + | IntroIdentifier of Names.Id.t + | IntroFresh of Names.Id.t + | IntroAnonymous + and 'constr intro_pattern_action_expr = + | IntroWildcard + | IntroOrAndPattern of 'constr or_and_intro_pattern_expr + | IntroInjection of ('constr intro_pattern_expr) Loc.located list + | IntroApplyOn of 'constr Loc.located * 'constr intro_pattern_expr Loc.located + | IntroRewrite of bool + and 'constr or_and_intro_pattern_expr = + | IntroOrPattern of ('constr intro_pattern_expr) Loc.located list list + | IntroAndPattern of ('constr intro_pattern_expr) Loc.located list + + type quantified_hypothesis = + | AnonHyp of int + | NamedHyp of Names.Id.t + + type 'a explicit_bindings = (quantified_hypothesis * 'a) Loc.located list + + type 'a bindings = + | ImplicitBindings of 'a list + | ExplicitBindings of 'a explicit_bindings + | NoBindings + + type 'a with_bindings = 'a * 'a bindings + + type 'a core_destruction_arg = + | ElimOnConstr of 'a + | ElimOnIdent of Names.Id.t Loc.located + | ElimOnAnonHyp of int + + type inversion_kind = + | SimpleInversion + | FullInversion + | FullInversionClear + + type multi = + | Precisely of int + | UpTo of int + | RepeatStar + | RepeatPlus + type 'id move_location = + | MoveAfter of 'id + | MoveBefore of 'id + | MoveFirst + | MoveLast + + type 'a destruction_arg = clear_flag * 'a core_destruction_arg + end -module Mod_typing : +module Locus : sig - type 'alg translation = - Declarations.module_signature * 'alg * Mod_subst.delta_resolver * Univ.ContextSet.t - val translate_mse : - Environ.env -> Names.ModPath.t option -> Entries.inline -> Declarations.module_alg_expr -> - Declarations.module_alg_expr translation + type 'a occurrences_gen = + | AllOccurrences + | AllOccurrencesBut of 'a list (** non-empty *) + | NoOccurrences + | OnlyOccurrences of 'a list (** non-empty *) + type occurrences = int occurrences_gen + type occurrences_expr = (int Misctypes.or_var) occurrences_gen + type 'a with_occurrences = occurrences_expr * 'a + type hyp_location_flag = + InHyp | InHypTypeOnly | InHypValueOnly + type 'a hyp_location_expr = 'a with_occurrences * hyp_location_flag + type 'id clause_expr = + { onhyps : 'id hyp_location_expr list option; + concl_occs : occurrences_expr } + type clause = Names.Id.t clause_expr + type hyp_location = Names.Id.t * hyp_location_flag + type goal_location = hyp_location option end -module Esubst : +(************************************************************************) +(* End Modules from intf/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from library/ *) +(************************************************************************) + +module Univops : sig - type 'a subs = 'a Esubst.subs - val subs_id : int -> 'a subs + val universes_of_constr : Term.constr -> Univ.universe_set + val restrict_universe_context : Univ.universe_context_set -> Univ.universe_set -> Univ.universe_context_set end -module CClosure : +module Nameops : sig - type fconstr = CClosure.fconstr - type clos_infos = CClosure.clos_infos - type table_key = Names.Constant.t Univ.puniverses Names.tableKey - type fterm = CClosure.fterm = - | FRel of int - | FAtom of Term.constr (** Metas and Sorts *) - | FCast of fconstr * Term.cast_kind * fconstr - | FFlex of table_key - | FInd of Names.inductive Univ.puniverses - | FConstruct of Names.constructor Univ.puniverses - | FApp of fconstr * fconstr array - | FProj of Names.Projection.t * fconstr - | FFix of Term.fixpoint * fconstr Esubst.subs - | FCoFix of Term.cofixpoint * fconstr Esubst.subs - | FCaseT of Term.case_info * Term.constr * fconstr * Term.constr array * fconstr Esubst.subs (* predicate and branches are closures *) - | FLambda of int * (Names.Name.t * Term.constr) list * Term.constr * fconstr Esubst.subs - | FProd of Names.Name.t * fconstr * fconstr - | FLetIn of Names.Name.t * fconstr * fconstr * Term.constr * fconstr Esubst.subs - | FEvar of Term.existential * fconstr Esubst.subs - | FLIFT of int * fconstr - | FCLOS of Term.constr * fconstr Esubst.subs - | FLOCKED - module RedFlags : sig - type reds = CClosure.RedFlags.reds - type red_kind = CClosure.RedFlags.red_kind - val mkflags : red_kind list -> reds - val fBETA : red_kind - val fCOFIX : red_kind - val fCONST : Names.Constant.t -> CClosure.RedFlags.red_kind - val fFIX : red_kind - val fMATCH : red_kind - val fZETA : red_kind - val red_add_transparent : reds -> Names.transparent_state -> reds + val atompart_of_id : Names.Id.t -> string + + val pr_id : Names.Id.t -> Pp.t + [@@ocaml.deprecated "alias of API.Names.Id.print"] + + val pr_name : Names.Name.t -> Pp.t + [@@ocaml.deprecated "alias of API.Names.Name.print"] + + val name_fold : (Names.Id.t -> 'a -> 'a) -> Names.Name.t -> 'a -> 'a + val name_app : (Names.Id.t -> Names.Id.t) -> Names.Name.t -> Names.Name.t + val add_suffix : Names.Id.t -> string -> Names.Id.t + val increment_subscript : Names.Id.t -> Names.Id.t + val make_ident : string -> int option -> Names.Id.t + val out_name : Names.Name.t -> Names.Id.t + val pr_lab : Names.Label.t -> Pp.t + module Name : + sig + include module type of struct include Names.Name end + val get_id : t -> Names.Id.t + val fold_right : (Names.Id.t -> 'a -> 'a) -> t -> 'a -> 'a end - val mk_clos : fconstr Esubst.subs -> Term.constr -> fconstr - val mk_atom : Term.constr -> fconstr - val mk_clos_deep : - (fconstr Esubst.subs -> Term.constr -> fconstr) -> - fconstr Esubst.subs -> Term.constr -> fconstr - val mk_red : fterm -> fconstr - val all : RedFlags.reds - val beta : RedFlags.reds - val betaiota : RedFlags.reds - val betaiotazeta : RedFlags.reds +end + +module Libnames : +sig + + open Util + open Names + + type full_path + val pr_path : full_path -> Pp.t + val make_path : Names.DirPath.t -> Names.Id.t -> full_path + val eq_full_path : full_path -> full_path -> bool + val dirpath : full_path -> Names.DirPath.t + val path_of_string : string -> full_path + + type qualid + val make_qualid : Names.DirPath.t -> Names.Id.t -> qualid + val qualid_eq : qualid -> qualid -> bool + val repr_qualid : qualid -> Names.DirPath.t * Names.Id.t + val pr_qualid : qualid -> Pp.t + val string_of_qualid : qualid -> string + val qualid_of_string : string -> qualid + val qualid_of_path : full_path -> qualid + val qualid_of_dirpath : Names.DirPath.t -> qualid + val qualid_of_ident : Names.Id.t -> qualid - val create_clos_infos : ?evars:(Term.existential -> Term.constr option) -> RedFlags.reds -> Environ.env -> clos_infos + type reference = + | Qualid of qualid Loc.located + | Ident of Names.Id.t Loc.located + val loc_of_reference : reference -> Loc.t option + val qualid_of_reference : reference -> qualid Loc.located + val pr_reference : reference -> Pp.t - val whd_val : clos_infos -> fconstr -> Term.constr + val is_dirpath_prefix_of : Names.DirPath.t -> Names.DirPath.t -> bool + val split_dirpath : Names.DirPath.t -> Names.DirPath.t * Names.Id.t + val dirpath_of_string : string -> Names.DirPath.t + val pr_dirpath : Names.DirPath.t -> Pp.t - val inject : Term.constr -> fconstr + val string_of_path : full_path -> string + val basename : full_path -> Names.Id.t - val kl : clos_infos -> fconstr -> Term.constr - val term_of_fconstr : fconstr -> Term.constr + type object_name = full_path * Names.KerName.t + type object_prefix = Names.DirPath.t * (Names.ModPath.t * Names.DirPath.t) + + module Dirset : Set.S with type elt = DirPath.t + module Dirmap : Map.ExtS with type key = DirPath.t and module Set := Dirset + module Spmap : CSig.MapS with type key = full_path end -module Type_errors : +module Globnames : sig - type type_error = Type_errors.type_error - exception TypeError of Environ.env * type_error + + open Util + + type global_reference = + | VarRef of Names.Id.t + | ConstRef of Names.Constant.t + | IndRef of Names.inductive + | ConstructRef of Names.constructor + + type extended_global_reference = + | TrueGlobal of global_reference + | SynDef of Names.KerName.t + + (* Long term: change implementation so that only 1 kind of order is needed. + * Today: _env ones are fine grained, which one to pick depends. Eg. + * - conversion rule are implemented by the non_env ones + * - pretty printing (of user provided names/aliases) are implemented by + * the _env ones + *) + module Refset : CSig.SetS with type elt = global_reference + module Refmap : Map.ExtS + with type key = global_reference and module Set := Refset + + module Refset_env : CSig.SetS with type elt = global_reference + module Refmap_env : Map.ExtS + with type key = global_reference and module Set := Refset_env + + module RefOrdered : + sig + type t = global_reference + val compare : t -> t -> int + end + + val pop_global_reference : global_reference -> global_reference + val eq_gr : global_reference -> global_reference -> bool + val destIndRef : global_reference -> Names.inductive + + val encode_mind : Names.DirPath.t -> Names.Id.t -> Names.MutInd.t + val encode_con : Names.DirPath.t -> Names.Id.t -> Names.Constant.t + + val global_of_constr : Constr.t -> global_reference + + val subst_global : Mod_subst.substitution -> global_reference -> global_reference * Constr.t + val destConstructRef : global_reference -> Names.constructor + + val reference_of_constr : Constr.t -> global_reference + [@@ocaml.deprecated "alias of API.Globnames.global_of_constr"] + + val is_global : global_reference -> Constr.t -> bool end -module Evar : +module Libobject : sig - (** Unique identifier of some {i evar} *) - type t = Prelude.evar + type obj + type 'a substitutivity = + | Dispose + | Substitute of 'a + | Keep of 'a + | Anticipate of 'a - (** Recover the underlying integer. *) - val repr : t -> int + type 'a object_declaration = { + object_name : string; + cache_function : Libnames.object_name * 'a -> unit; + load_function : int -> Libnames.object_name * 'a -> unit; + open_function : int -> Libnames.object_name * 'a -> unit; + classify_function : 'a -> 'a substitutivity; + subst_function : Mod_subst.substitution * 'a -> 'a; + discharge_function : Libnames.object_name * 'a -> 'a option; + rebuild_function : 'a -> 'a + } + val declare_object : 'a object_declaration -> ('a -> obj) + val default_object : string -> 'a object_declaration + val object_tag : obj -> string +end - val equal : t -> t -> bool +module Summary : +sig - (** a set of unique identifiers of some {i evars} *) - module Set : module type of struct include Evar.Set end + type frozen + type marshallable + + type 'a summary_declaration = + { freeze_function : marshallable -> 'a; + unfreeze_function : 'a -> unit; + init_function : unit -> unit; } + + val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref + val declare_summary : string -> 'a summary_declaration -> unit + module Local : + sig + type 'a local_ref + val ref : ?freeze:('a -> 'a) -> name:string -> 'a -> 'a local_ref + val (:=) : 'a local_ref -> 'a -> unit + val (!) : 'a local_ref -> 'a + end +end + +module Nametab : +sig + exception GlobalizationError of Libnames.qualid + + type ltac_constant = Names.KerName.t + + val global : Libnames.reference -> Globnames.global_reference + val global_of_path : Libnames.full_path -> Globnames.global_reference + val shortest_qualid_of_global : Names.Id.Set.t -> Globnames.global_reference -> Libnames.qualid + val path_of_global : Globnames.global_reference -> Libnames.full_path + val locate_extended : Libnames.qualid -> Globnames.extended_global_reference + val full_name_module : Libnames.qualid -> Names.DirPath.t + val locate_tactic : Libnames.qualid -> Names.KerName.t + val pr_global_env : Names.Id.Set.t -> Globnames.global_reference -> Pp.t + val shortest_qualid_of_tactic : Names.KerName.t -> Libnames.qualid + val basename_of_global : Globnames.global_reference -> Names.Id.t + + type visibility = + | Until of int + | Exactly of int + + val push_tactic : visibility -> Libnames.full_path -> Names.KerName.t -> unit + val error_global_not_found : ?loc:Loc.t -> Libnames.qualid -> 'a + val shortest_qualid_of_module : Names.ModPath.t -> Libnames.qualid + val dirpath_of_module : Names.ModPath.t -> Names.DirPath.t + val locate_module : Libnames.qualid -> Names.ModPath.t + val dirpath_of_global : Globnames.global_reference -> Names.DirPath.t + val locate : Libnames.qualid -> Globnames.global_reference + val locate_constant : Libnames.qualid -> Names.Constant.t +end + +module Global : +sig + val env : unit -> Environ.env + val lookup_mind : Names.MutInd.t -> Declarations.mutual_inductive_body + val lookup_constant : Names.Constant.t -> Declarations.constant_body + val lookup_module : Names.ModPath.t -> Declarations.module_body + val lookup_modtype : Names.ModPath.t -> Declarations.module_type_body + val lookup_inductive : Names.inductive -> Declarations.mutual_inductive_body * Declarations.one_inductive_body + val constant_of_delta_kn : Names.KerName.t -> Names.Constant.t + val register : + Retroknowledge.field -> Constr.t -> Constr.t -> unit + val env_of_context : Environ.named_context_val -> Environ.env + val is_polymorphic : Globnames.global_reference -> bool + + val constr_of_global_in_context : Environ.env -> + Globnames.global_reference -> Constr.types * Univ.AUContext.t + + val type_of_global_in_context : Environ.env -> + Globnames.global_reference -> Constr.types * Univ.AUContext.t + + val current_dirpath : unit -> Names.DirPath.t + val body_of_constant_body : Declarations.constant_body -> (Constr.t * Univ.AUContext.t) option + val body_of_constant : Names.Constant.t -> (Constr.t * Univ.AUContext.t) option + val add_constraints : Univ.Constraint.t -> unit +end + +module Lib : sig + type is_type = bool + type export = bool option + type node = + | Leaf of Libobject.obj (* FIX: horrible hack (wrt. Enrico) *) + | CompilingLibrary of Libnames.object_prefix + | OpenedModule of is_type * export * Libnames.object_prefix * Summary.frozen + | ClosedModule of library_segment + | OpenedSection of Libnames.object_prefix * Summary.frozen + | ClosedSection of library_segment + + and library_segment = (Libnames.object_name * node) list + + val current_mp : unit -> Names.ModPath.t + val is_modtype : unit -> bool + val is_module : unit -> bool + val sections_are_opened : unit -> bool + val add_anonymous_leaf : ?cache_first:bool -> Libobject.obj -> unit + val contents : unit -> library_segment + val cwd : unit -> Names.DirPath.t + val add_leaf : Names.Id.t -> Libobject.obj -> Libnames.object_name + val make_kn : Names.Id.t -> Names.KerName.t + val make_path : Names.Id.t -> Libnames.full_path + val discharge_con : Names.Constant.t -> Names.Constant.t + val discharge_inductive : Names.inductive -> Names.inductive +end + +module Declaremods : +sig + + val append_end_library_hook : (unit -> unit) -> unit + +end + +module Library : +sig + val library_is_loaded : Names.DirPath.t -> bool + val loaded_libraries : unit -> Names.DirPath.t list +end + +module States : +sig + val with_state_protection_on_exception : ('a -> 'b) -> 'a -> 'b + val with_state_protection : ('a -> 'b) -> 'a -> 'b +end + +module Kindops : +sig + val logical_kind_of_goal_kind : Decl_kinds.goal_object_kind -> Decl_kinds.logical_kind +end + +module Goptions : +sig + type option_name = string list + type 'a option_sig = + { + optdepr : bool; + optname : string; + optkey : option_name; + optread : unit -> 'a; + optwrite : 'a -> unit + } + + type 'a write_function = 'a -> unit + + val declare_bool_option : ?preprocess:(bool -> bool) -> + bool option_sig -> bool write_function + val declare_int_option : ?preprocess:(int option -> int option) -> + int option option_sig -> int option write_function + val declare_string_option: ?preprocess:(string -> string) -> + string option_sig -> string write_function + val set_bool_option_value : option_name -> bool -> unit +end + +module Keys : +sig + type key + val constr_key : ('a -> ('a, 't, 'u, 'i) Constr.kind_of_term) -> 'a -> key option + val declare_equiv_keys : key -> key -> unit + val pr_keys : (Globnames.global_reference -> Pp.t) -> Pp.t +end + +module Coqlib : +sig + + type coq_eq_data = { eq : Globnames.global_reference; + ind : Globnames.global_reference; + refl : Globnames.global_reference; + sym : Globnames.global_reference; + trans: Globnames.global_reference; + congr: Globnames.global_reference; + } + + type coq_sigma_data = { + proj1 : Globnames.global_reference; + proj2 : Globnames.global_reference; + elim : Globnames.global_reference; + intro : Globnames.global_reference; + typ : Globnames.global_reference } + val gen_reference : string -> string list -> string -> Globnames.global_reference + val find_reference : string -> string list -> string -> Globnames.global_reference + val check_required_library : string list -> unit + val logic_module_name : string list + val glob_true : Globnames.global_reference + val glob_false : Globnames.global_reference + val glob_O : Globnames.global_reference + val glob_S : Globnames.global_reference + val nat_path : Libnames.full_path + val datatypes_module_name : string list + val glob_eq : Globnames.global_reference + val build_coq_eq_sym : Globnames.global_reference Util.delayed + val build_coq_False : Globnames.global_reference Util.delayed + val build_coq_not : Globnames.global_reference Util.delayed + val build_coq_eq : Globnames.global_reference Util.delayed + val build_coq_eq_data : coq_eq_data Util.delayed + val path_of_O : Names.constructor + val path_of_S : Names.constructor + val build_prod : coq_sigma_data Util.delayed + val build_coq_True : Globnames.global_reference Util.delayed + val coq_iff_ref : Globnames.global_reference lazy_t + val build_coq_iff_left_proj : Globnames.global_reference Util.delayed + val build_coq_iff_right_proj : Globnames.global_reference Util.delayed + val init_modules : string list list + val build_coq_eq_refl : Globnames.global_reference Util.delayed + val arith_modules : string list list + val zarith_base_modules : string list list + val gen_reference_in_modules : string -> string list list-> string -> Globnames.global_reference + val jmeq_module_name : string list + val coq_eq_ref : Globnames.global_reference lazy_t + val coq_not_ref : Globnames.global_reference lazy_t + val coq_or_ref : Globnames.global_reference lazy_t + val build_coq_and : Globnames.global_reference Util.delayed + val build_coq_I : Globnames.global_reference Util.delayed + val coq_reference : string -> string list -> string -> Globnames.global_reference +end + +(************************************************************************) +(* End of modules from library/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from engine/ *) +(************************************************************************) + +module Universes : +sig + type universe_binders + type universe_opt_subst + val fresh_inductive_instance : Environ.env -> Names.inductive -> Term.pinductive Univ.in_universe_context_set + val new_Type : Names.DirPath.t -> Term.types + val type_of_global : Globnames.global_reference -> Term.types Univ.in_universe_context_set + val constr_of_global : Globnames.global_reference -> Constr.t + val new_univ_level : Names.DirPath.t -> Univ.Level.t + val new_sort_in_family : Sorts.family -> Sorts.t + val pr_with_global_universes : Univ.Level.t -> Pp.t + val pr_universe_opt_subst : universe_opt_subst -> Pp.t + type universe_constraint + + module Constraints : + sig + type t + val pr : t -> Pp.t + end + + type universe_constraints = Constraints.t +end + +module UState : +sig + type t + val context : t -> Univ.UContext.t + val context_set : t -> Univ.ContextSet.t + val of_context_set : Univ.ContextSet.t -> t + + type rigid = + | UnivRigid + | UnivFlexible of bool + +end + +(* XXX: Moved from intf *) +module Evar_kinds : +sig + type obligation_definition_status = + | Define of bool + | Expand + + type matching_var_kind = + | FirstOrderPatVar of Names.Id.t + | SecondOrderPatVar of Names.Id.t + + type t = + | ImplicitArg of Globnames.global_reference * (int * Names.Id.t option) + * bool (** Force inference *) + | BinderType of Names.Name.t + | NamedHole of Names.Id.t (* coming from some ?[id] syntax *) + | QuestionMark of obligation_definition_status * Names.Name.t + | CasesType of bool (* true = a subterm of the type *) + | InternalHole + | TomatchTypeParameter of Names.inductive * int + | GoalEvar + | ImpossibleCase + | MatchingVar of matching_var_kind + | VarInstance of Names.Id.t + | SubEvar of Constr.existential_key end module Evd : sig + + type evar = Constr.existential_key + val string_of_existential : Evar.t -> string - type evar_constraint = Prelude.conv_pb * Environ.env * Term.constr * Term.constr + type evar_constraint = Reduction.conv_pb * Environ.env * Constr.t * Constr.t (* --------------------------------- *) @@ -1399,37 +2196,37 @@ sig module Store : sig - type t = Evd.Store.t + type t val empty : t end module Filter : sig - type t = Evd.Filter.t + type t val repr : t -> bool list option end (** This value defines the refinement of a given {i evar} *) - type evar_body = Evd.evar_body = + type evar_body = | Evar_empty (** given {i evar} was not yet refined *) - | Evar_defined of Term.constr (** given {i var} was refined to the indicated term *) + | Evar_defined of Constr.t (** given {i var} was refined to the indicated term *) (** all the information we have concerning some {i evar} *) - type evar_info = Evd.evar_info = + type evar_info = { - evar_concl : Term.constr; + evar_concl : Constr.t; evar_hyps : Environ.named_context_val; evar_body : evar_body; evar_filter : Filter.t; evar_source : Evar_kinds.t Loc.located; - evar_candidates : Term.constr list option; (* if not None, list of allowed instances *) + evar_candidates : Constr.t list option; (* if not None, list of allowed instances *) evar_extra : Store.t } - val evar_concl : evar_info -> Term.constr + val evar_concl : evar_info -> Constr.t val evar_body : evar_info -> evar_body val evar_context : evar_info -> Context.Named.t - val instantiate_evar_array : evar_info -> Term.constr -> Term.constr array -> Term.constr + val instantiate_evar_array : evar_info -> Constr.t -> Constr.t array -> Constr.t val evar_filtered_env : evar_info -> Environ.env val evar_hyps : evar_info -> Environ.named_context_val @@ -1437,39 +2234,50 @@ sig (* evar map *) - type evar_map = Prelude.evar_map - type open_constr = evar_map * Term.constr + type evar_map + type open_constr = evar_map * Constr.t + + open Util + + module Metaset : Set.S with type elt = Constr.metavariable - type rigid = Prelude.rigid = + type rigid = UState.rigid = | UnivRigid - | UnivFlexible of bool + | UnivFlexible of bool - - type 'a freelisted = 'a Evd.freelisted = { + type 'a freelisted = { rebus : 'a; - freemetas : Evd.Metaset.t + freemetas : Metaset.t } - type instance_status = Evd.instance_status - type clbinding = Evd.clbinding = - | Cltyp of Names.Name.t * Term.constr freelisted - | Clval of Names.Name.t * (Term.constr freelisted * instance_status) * Term.constr freelisted + + type instance_constraint = IsSuperType | IsSubType | Conv + + type instance_typing_status = + CoerceToType | TypeNotProcessed | TypeProcessed + + type instance_status = instance_constraint * instance_typing_status + + type clbinding = + | Cltyp of Names.Name.t * Constr.t freelisted + | Clval of Names.Name.t * (Constr.t freelisted * instance_status) * Constr.t freelisted + val empty : evar_map val from_env : Environ.env -> evar_map val find : evar_map -> Evar.t -> evar_info - val find_undefined : evar_map -> Prelude.evar -> evar_info + val find_undefined : evar_map -> evar -> evar_info val is_defined : evar_map -> Evar.t -> bool val mem : evar_map -> Evar.t -> bool val add : evar_map -> Evar.t -> evar_info -> evar_map val evar_universe_context : evar_map -> UState.t val set_universe_context : evar_map -> UState.t -> evar_map val universes : evar_map -> UGraph.t - val define : Evar.t -> Term.constr -> evar_map -> evar_map + val define : Evar.t -> Constr.t -> evar_map -> evar_map val fold : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a val evar_key : Names.Id.t -> evar_map -> Evar.t val create_evar_defs : evar_map -> evar_map - val meta_declare : Prelude.metavariable -> Term.types -> ?name:Names.Name.t -> evar_map -> evar_map + val meta_declare : Constr.metavariable -> Term.types -> ?name:Names.Name.t -> evar_map -> evar_map val clear_metas : evar_map -> evar_map @@ -1478,24 +2286,24 @@ sig val remove : evar_map -> Evar.t -> evar_map val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> Environ.env -> - evar_map -> Prelude.global_reference -> evar_map * Term.constr + evar_map -> Globnames.global_reference -> evar_map * Constr.t val evar_filtered_context : evar_info -> Context.Named.t val fresh_inductive_instance : ?loc:Loc.t -> Environ.env -> evar_map -> Names.inductive -> evar_map * Term.pinductive val fold_undefined : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a val universe_context_set : evar_map -> Univ.ContextSet.t - val evar_ident : Prelude.evar -> evar_map -> Names.Id.t option + val evar_ident : evar -> evar_map -> Names.Id.t option val extract_all_conv_pbs : evar_map -> evar_map * evar_constraint list val universe_context : ?names:(Names.Id.t Loc.located) list -> evar_map -> (Names.Id.t * Univ.Level.t) list * Univ.UContext.t val nf_constraints : evar_map -> evar_map val from_ctx : UState.t -> evar_map - val meta_list : evar_map -> (Prelude.metavariable * clbinding) list + val meta_list : evar_map -> (Constr.metavariable * clbinding) list - val meta_defined : evar_map -> Prelude.metavariable -> bool + val meta_defined : evar_map -> Constr.metavariable -> bool - val meta_name : evar_map -> Prelude.metavariable -> Names.Name.t + val meta_name : evar_map -> Constr.metavariable -> Names.Name.t module MonadR : sig @@ -1505,7 +2313,7 @@ sig end end - type 'a sigma = 'a Evd.sigma = { + type 'a sigma = { it : 'a ; sigma : evar_map } @@ -1522,14 +2330,11 @@ sig val union_evar_universe_context : UState.t -> UState.t -> UState.t val merge_universe_context : evar_map -> UState.t -> evar_map - type unsolvability_explanation = Evd.unsolvability_explanation = - | SeveralInstancesFound of int - - module Metaset : module type of struct include Evd.Metaset end - with type elt = Prelude.metavariable + type unsolvability_explanation = + | SeveralInstancesFound of int (** Return {i ids} of all {i evars} that occur in a given term. *) - val evars_of_term : Term.constr -> Evar.Set.t + val evars_of_term : Constr.t -> Evar.Set.t val evar_universe_context_of : Univ.ContextSet.t -> UState.t [@@ocaml.deprecated "alias of API.UState.of_context_set"] @@ -1540,14 +2345,379 @@ sig type evar_universe_context = UState.t [@@ocaml.deprecated "alias of API.UState.t"] - val existential_opt_value : evar_map -> Term.existential -> Term.constr option - val existential_value : evar_map -> Term.existential -> Term.constr + val existential_opt_value : evar_map -> Term.existential -> Constr.t option + val existential_value : evar_map -> Term.existential -> Constr.t exception NotInstantiatedEvar val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:rigid -> Environ.env -> evar_map -> Sorts.family -> evar_map * Sorts.t end +(* XXX: moved from intf *) +module Constrexpr : +sig + + type binder_kind = + | Default of Decl_kinds.binding_kind + | Generalized of Decl_kinds.binding_kind * Decl_kinds.binding_kind * bool + + type explicitation = + | ExplByPos of int * Names.Id.t option + | ExplByName of Names.Id.t + type sign = bool + type raw_natural_number = string + type prim_token = + | Numeral of raw_natural_number * sign + | String of string + + type notation = string + type instance_expr = Misctypes.glob_level list + type proj_flag = int option + type abstraction_kind = + | AbsLambda + | AbsPi + + type cases_pattern_expr_r = + | CPatAlias of cases_pattern_expr * Names.Id.t + | CPatCstr of Libnames.reference + * cases_pattern_expr list option * cases_pattern_expr list + (** [CPatCstr (_, c, Some l1, l2)] represents (@c l1) l2 *) + | CPatAtom of Libnames.reference option + | CPatOr of cases_pattern_expr list + | CPatNotation of notation * cases_pattern_notation_substitution + * cases_pattern_expr list + | CPatPrim of prim_token + | CPatRecord of (Libnames.reference * cases_pattern_expr) list + | CPatDelimiters of string * cases_pattern_expr + | CPatCast of cases_pattern_expr * constr_expr + and cases_pattern_expr = cases_pattern_expr_r CAst.t + + and cases_pattern_notation_substitution = + cases_pattern_expr list * cases_pattern_expr list list + + and constr_expr_r = + | CRef of Libnames.reference * instance_expr option + | CFix of Names.Id.t Loc.located * fix_expr list + | CCoFix of Names.Id.t Loc.located * cofix_expr list + | CProdN of binder_expr list * constr_expr + | CLambdaN of binder_expr list * constr_expr + | CLetIn of Names.Name.t Loc.located * constr_expr * constr_expr option * constr_expr + | CAppExpl of (proj_flag * Libnames.reference * instance_expr option) * constr_expr list + | CApp of (proj_flag * constr_expr) * + (constr_expr * explicitation Loc.located option) list + | CRecord of (Libnames.reference * constr_expr) list + | CCases of Term.case_style + * constr_expr option + * case_expr list + * branch_expr list + | CLetTuple of Names.Name.t Loc.located list * (Names.Name.t Loc.located option * constr_expr option) * + constr_expr * constr_expr + | CIf of constr_expr * (Names.Name.t Loc.located option * constr_expr option) + * constr_expr * constr_expr + | CHole of Evar_kinds.t option * Misctypes.intro_pattern_naming_expr * Genarg.raw_generic_argument option + | CPatVar of Names.Id.t + | CEvar of Names.Id.t * (Names.Id.t * constr_expr) list + | CSort of Misctypes.glob_sort + | CCast of constr_expr * constr_expr Misctypes.cast_type + | CNotation of notation * constr_notation_substitution + | CGeneralization of Decl_kinds.binding_kind * abstraction_kind option * constr_expr + | CPrim of prim_token + | CDelimiters of string * constr_expr + and constr_expr = constr_expr_r CAst.t + + and case_expr = constr_expr * Names.Name.t Loc.located option * cases_pattern_expr option + + and branch_expr = + (cases_pattern_expr list Loc.located list * constr_expr) Loc.located + + and binder_expr = + Names.Name.t Loc.located list * binder_kind * constr_expr + + and fix_expr = + Names.Id.t Loc.located * (Names.Id.t Loc.located option * recursion_order_expr) * + local_binder_expr list * constr_expr * constr_expr + + and cofix_expr = + Names.Id.t Loc.located * local_binder_expr list * constr_expr * constr_expr + + and recursion_order_expr = + | CStructRec + | CWfRec of constr_expr + | CMeasureRec of constr_expr * constr_expr option + + and local_binder_expr = + | CLocalAssum of Names.Name.t Loc.located list * binder_kind * constr_expr + | CLocalDef of Names.Name.t Loc.located * constr_expr * constr_expr option + | CLocalPattern of (cases_pattern_expr * constr_expr option) Loc.located + + and constr_notation_substitution = + constr_expr list * + constr_expr list list * + local_binder_expr list list + + type typeclass_constraint = (Names.Name.t Loc.located * Names.Id.t Loc.located list option) * Decl_kinds.binding_kind * constr_expr + type constr_pattern_expr = constr_expr +end + +module Genredexpr : +sig + + (** The parsing produces initially a list of [red_atom] *) + type 'a red_atom = + | FBeta + | FMatch + | FFix + | FCofix + | FZeta + | FConst of 'a list + | FDeltaBut of 'a list + + (** This list of atoms is immediately converted to a [glob_red_flag] *) + type 'a glob_red_flag = { + rBeta : bool; + rMatch : bool; + rFix : bool; + rCofix : bool; + rZeta : bool; + rDelta : bool; (** true = delta all but rConst; false = delta only on rConst*) + rConst : 'a list + } + + (** Generic kinds of reductions *) + type ('a,'b,'c) red_expr_gen = + | Red of bool + | Hnf + | Simpl of 'b glob_red_flag*('b,'c) Util.union Locus.with_occurrences option + | Cbv of 'b glob_red_flag + | Cbn of 'b glob_red_flag + | Lazy of 'b glob_red_flag + | Unfold of 'b Locus.with_occurrences list + | Fold of 'a list + | Pattern of 'a Locus.with_occurrences list + | ExtraRedExpr of string + | CbvVm of ('b,'c) Util.union Locus.with_occurrences option + | CbvNative of ('b,'c) Util.union Locus.with_occurrences option + + type ('a,'b,'c) may_eval = + | ConstrTerm of 'a + | ConstrEval of ('a,'b,'c) red_expr_gen * 'a + | ConstrContext of Names.Id.t Loc.located * 'a + | ConstrTypeOf of 'a + + type r_trm = Constrexpr.constr_expr + type r_pat = Constrexpr.constr_pattern_expr + type r_cst = Libnames.reference Misctypes.or_by_notation + type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen +end + +(* XXX: end of moved from intf *) + +module EConstr : +sig + type t + type constr = t + type types = t + type unsafe_judgment = (constr, types) Environ.punsafe_judgment + type named_declaration = (constr, types) Context.Named.Declaration.pt + type named_context = (constr, types) Context.Named.pt + type rel_context = (constr, types) Context.Rel.pt + type rel_declaration = (constr, types) Context.Rel.Declaration.pt + type existential = constr Constr.pexistential + module ESorts : + sig + type t + (** Type of sorts up-to universe unification. Essentially a wrapper around + Sorts.t so that normalization is ensured statically. *) + + val make : Sorts.t -> t + (** Turn a sort into an up-to sort. *) + + val kind : Evd.evar_map -> t -> Sorts.t + (** Returns the view into the current sort. Note that the kind of a variable + may change if the unification state of the evar map changes. *) + + end + + module EInstance : + sig + type t + (** Type of universe instances up-to universe unification. Similar to + {ESorts.t} for {Univ.Instance.t}. *) + + val make : Univ.Instance.t -> t + val kind : Evd.evar_map -> t -> Univ.Instance.t + val empty : t + val is_empty : t -> bool + end + + val of_constr : Constr.t -> constr + + val kind : Evd.evar_map -> constr -> (constr, constr, ESorts.t, EInstance.t) Constr.kind_of_term + + val mkArrow : constr -> constr -> constr + val mkInd : Names.inductive -> t + val mkProp : constr + val mkProd : Names.Name.t * constr * constr -> constr + val mkRel : int -> constr + val mkSort : Sorts.t -> constr + val mkVar : Names.Id.t -> constr + val mkLambda : Names.Name.t * constr * constr -> constr + val mkLambda_or_LetIn : rel_declaration -> constr -> constr + val mkApp : constr * constr array -> constr + val mkEvar : constr Constr.pexistential -> constr + + val mkMeta : Constr.metavariable -> constr + + val mkConstructU : Names.constructor * EInstance.t -> constr + val mkLetIn : Names.Name.t * constr * constr * constr -> constr + val mkProd_or_LetIn : rel_declaration -> constr -> constr + val mkCast : constr * Constr.cast_kind * constr -> constr + val mkNamedLambda : Names.Id.t -> types -> constr -> constr + val mkNamedProd : Names.Id.t -> types -> types -> types + + val isCast : Evd.evar_map -> t -> bool + val isEvar : Evd.evar_map -> constr -> bool + val isInd : Evd.evar_map -> constr -> bool + val isRel : Evd.evar_map -> constr -> bool + val isSort : Evd.evar_map -> constr -> bool + val isVar : Evd.evar_map -> constr -> bool + val isConst : Evd.evar_map -> constr -> bool + val isConstruct : Evd.evar_map -> constr -> bool + + val destInd : Evd.evar_map -> constr -> Names.inductive * EInstance.t + val destVar : Evd.evar_map -> constr -> Names.Id.t + val destEvar : Evd.evar_map -> constr -> constr Constr.pexistential + val destRel : Evd.evar_map -> constr -> int + val destProd : Evd.evar_map -> constr -> Names.Name.t * types * types + val destLambda : Evd.evar_map -> constr -> Names.Name.t * types * constr + val destApp : Evd.evar_map -> constr -> constr * constr array + val destConst : Evd.evar_map -> constr -> Names.Constant.t * EInstance.t + val destConstruct : Evd.evar_map -> constr -> Names.constructor * EInstance.t + val destFix : Evd.evar_map -> t -> (t, t) Constr.pfixpoint + val destCast : Evd.evar_map -> t -> t * Constr.cast_kind * t + + val mkConstruct : Names.constructor -> constr + + val compose_lam : (Names.Name.t * constr) list -> constr -> constr + + val decompose_lam : Evd.evar_map -> constr -> (Names.Name.t * constr) list * constr + val decompose_lam_n_assum : Evd.evar_map -> int -> constr -> rel_context * constr + val decompose_app : Evd.evar_map -> constr -> constr * constr list + val decompose_prod : Evd.evar_map -> constr -> (Names.Name.t * constr) list * constr + val decompose_prod_assum : Evd.evar_map -> constr -> rel_context * constr + + val applist : constr * constr list -> constr + + val to_constr : Evd.evar_map -> constr -> Constr.t + + val push_rel : rel_declaration -> Environ.env -> Environ.env + + module Unsafe : + sig + val to_constr : constr -> Constr.t + + val to_rel_decl : (constr, types) Context.Rel.Declaration.pt -> (Constr.constr, Constr.types) Context.Rel.Declaration.pt + + (** Physical identity. Does not care for defined evars. *) + + val to_named_decl : (constr, types) Context.Named.Declaration.pt -> (Constr.constr, Constr.types) Context.Named.Declaration.pt + + val to_instance : EInstance.t -> Univ.Instance.t + end + + module Vars : + sig + val substnl : t list -> int -> t -> t + val noccurn : Evd.evar_map -> int -> constr -> bool + val closed0 : Evd.evar_map -> constr -> bool + val subst1 : constr -> constr -> constr + val substl : constr list -> constr -> constr + val lift : int -> constr -> constr + val liftn : int -> int -> t -> t + val subst_var : Names.Id.t -> t -> t + val subst_vars : Names.Id.t list -> t -> t + end + + val fresh_global : + ?loc:Loc.t -> ?rigid:UState.rigid -> ?names:Univ.Instance.t -> Environ.env -> + Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * t + + val of_named_decl : (Constr.t, Constr.types) Context.Named.Declaration.pt -> (constr, types) Context.Named.Declaration.pt + val of_rel_decl : (Constr.t, Constr.types) Context.Rel.Declaration.pt -> (constr, types) Context.Rel.Declaration.pt + val kind_of_type : Evd.evar_map -> constr -> (constr, constr) Term.kind_of_type + val to_lambda : Evd.evar_map -> int -> constr -> constr + val it_mkLambda_or_LetIn : constr -> rel_context -> constr + val push_rel_context : rel_context -> Environ.env -> Environ.env + val eq_constr : Evd.evar_map -> constr -> constr -> bool + val iter_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit + val fold : Evd.evar_map -> ('a -> constr -> 'a) -> 'a -> constr -> 'a + val existential_type : Evd.evar_map -> existential -> types + val iter : Evd.evar_map -> (constr -> unit) -> constr -> unit + val eq_constr_universes : Evd.evar_map -> constr -> constr -> Universes.universe_constraints option + val eq_constr_nounivs : Evd.evar_map -> constr -> constr -> bool + val compare_constr : Evd.evar_map -> (constr -> constr -> bool) -> constr -> constr -> bool + val isApp : Evd.evar_map -> constr -> bool + val it_mkProd_or_LetIn : constr -> rel_context -> constr + val push_named : named_declaration -> Environ.env -> Environ.env + val destCase : Evd.evar_map -> constr -> Constr.case_info * constr * constr * constr array + val decompose_lam_assum : Evd.evar_map -> constr -> rel_context * constr + val mkConst : Names.Constant.t -> constr + val mkCase : Constr.case_info * constr * constr * constr array -> constr + val named_context : Environ.env -> named_context + val val_of_named_context : named_context -> Environ.named_context_val + val mkFix : (t, t) Constr.pfixpoint -> t + val decompose_prod_n_assum : Evd.evar_map -> int -> t -> rel_context * t + val isMeta : Evd.evar_map -> t -> bool + + val destMeta : Evd.evar_map -> t -> Constr.metavariable + + val map_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> t) -> 'a -> t -> t + val mkNamedLetIn : Names.Id.t -> constr -> types -> constr -> constr + val map : Evd.evar_map -> (t -> t) -> t -> t + val mkConstU : Names.Constant.t * EInstance.t -> t + val isProd : Evd.evar_map -> t -> bool + val mkConstructUi : (Names.inductive * EInstance.t) * int -> t + val isLambda : Evd.evar_map -> t -> bool +end + +(* XXX: Located manually from intf *) +module Pattern : +sig + + type case_info_pattern = + { cip_style : Misctypes.case_style; + cip_ind : Names.inductive option; + cip_ind_tags : bool list option; (** indicates LetIn/Lambda in arity *) + cip_extensible : bool (** does this match end with _ => _ ? *) } + + type constr_pattern = + | PRef of Globnames.global_reference + | PVar of Names.Id.t + | PEvar of Evar.t * constr_pattern array + | PRel of int + | PApp of constr_pattern * constr_pattern array + | PSoApp of Names.Id.t * constr_pattern list + | PProj of Names.Projection.t * constr_pattern + | PLambda of Names.Name.t * constr_pattern * constr_pattern + | PProd of Names.Name.t * constr_pattern * constr_pattern + | PLetIn of Names.Name.t * constr_pattern * constr_pattern option * constr_pattern + | PSort of Misctypes.glob_sort + | PMeta of Names.Id.t option + | PIf of constr_pattern * constr_pattern * constr_pattern + | PCase of case_info_pattern * constr_pattern * constr_pattern * + (int * bool list * constr_pattern) list (** index of constructor, nb of args *) + | PFix of Term.fixpoint + | PCoFix of Term.cofixpoint + + type constr_under_binders = Names.Id.t list * EConstr.constr + + (** Types of substitutions with or w/o bound variables *) + + type patvar_map = EConstr.constr Names.Id.Map.t + type extended_patvar_map = constr_under_binders Names.Id.Map.t + +end + module Namegen : sig (** *) @@ -1579,78 +2749,168 @@ sig Evd.evar_map -> Names.Id.t list -> Names.Name.t list -> EConstr.types -> EConstr.types end -module Safe_typing : +module Termops : sig - type private_constants = Safe_typing.private_constants - val mk_pure_proof : Term.constr -> Safe_typing.private_constants Entries.proof_output + val it_mkLambda_or_LetIn : Constr.t -> Context.Rel.t -> Constr.t + val local_occur_var : Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool + val occur_var : Environ.env -> Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool + val pr_evar_info : Evd.evar_info -> Pp.t + + val print_constr : EConstr.constr -> Pp.t + + (** [dependent m t] tests whether [m] is a subterm of [t] *) + val dependent : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + + (** [pop c] returns a copy of [c] with decremented De Bruijn indexes *) + val pop : EConstr.constr -> EConstr.constr + + (** Does a given term contain an existential variable? *) + val occur_existential : Evd.evar_map -> EConstr.constr -> bool + + (** [map_constr_with_binders_left_to_right g f acc c] maps [f updated_acc] on all the immediate subterms of [c]. + {ul {- if a given immediate subterm of [c] is not below a binder, then [updated_acc] is the same as [acc].} + {- if a given immediate subterm of [c] is below a binder [b], then [updated_acc] is computed as [g b acc].}} *) + val map_constr_with_binders_left_to_right : + Evd.evar_map -> (EConstr.rel_declaration -> 'a -> 'a) -> ('a -> EConstr.constr -> EConstr.constr) -> 'a -> EConstr.constr -> EConstr.constr + + (** Remove the outer-most {!Term.kind_of_term.Cast} from a given term. *) + val strip_outer_cast : Evd.evar_map -> EConstr.constr -> EConstr.constr + + (** [nb_lam] ⟦[fun (x1:t1)...(xn:tn) => c]⟧ where [c] is not an abstraction gives [n]. + Casts are ignored. *) + val nb_lam : Evd.evar_map -> EConstr.constr -> int + + (** [push_rel_assum env_assumtion env] adds a given {i env assumption} to the {i env context} of a given {i environment}. *) + val push_rel_assum : Names.Name.t * EConstr.types -> Environ.env -> Environ.env + + (** [push_rels_assum env_assumptions env] adds given {i env assumptions} to the {i env context} of a given {i environment}. *) + val push_rels_assum : (Names.Name.t * Term.types) list -> Environ.env -> Environ.env + + type meta_value_map = (Constr.metavariable * Constr.t) list + + val last_arg : Evd.evar_map -> EConstr.constr -> EConstr.constr + val assums_of_rel_context : ('c, 't) Context.Rel.pt -> (Names.Name.t * 't) list + val prod_applist : Evd.evar_map -> EConstr.constr -> EConstr.constr list -> EConstr.constr + val nb_prod : Evd.evar_map -> EConstr.constr -> int + val is_section_variable : Names.Id.t -> bool + val ids_of_rel_context : ('c, 't) Context.Rel.pt -> Names.Id.t list + val subst_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr + val global_vars_set_of_decl : Environ.env -> Evd.evar_map -> EConstr.named_declaration -> Names.Id.Set.t + val vars_of_env: Environ.env -> Names.Id.Set.t + val ids_of_named_context : ('c, 't) Context.Named.pt -> Names.Id.t list + val ids_of_context : Environ.env -> Names.Id.t list + val global_of_constr : Evd.evar_map -> EConstr.constr -> Globnames.global_reference * EConstr.EInstance.t + val print_named_context : Environ.env -> Pp.t + val print_constr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t + val clear_named_body : Names.Id.t -> Environ.env -> Environ.env + val is_Prop : Evd.evar_map -> EConstr.constr -> bool + val is_global : Evd.evar_map -> Globnames.global_reference -> EConstr.constr -> bool + + val eq_constr : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + + val occur_var_in_decl : + Environ.env -> Evd.evar_map -> + Names.Id.t -> EConstr.named_declaration -> bool + + val subst_meta : meta_value_map -> Constr.t -> Constr.t + + val free_rels : Evd.evar_map -> EConstr.constr -> Int.Set.t + + val occur_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + [@@ocaml.deprecated "alias of API.Termops.dependent"] + + val replace_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr -> EConstr.constr + val map_named_decl : ('a -> 'b) -> ('a, 'a) Context.Named.Declaration.pt -> ('b, 'b) Context.Named.Declaration.pt + val map_rel_decl : ('a -> 'b) -> ('a, 'a) Context.Rel.Declaration.pt -> ('b, 'b) Context.Rel.Declaration.pt + val pr_metaset : Evd.Metaset.t -> Pp.t + val pr_evar_map : ?with_univs:bool -> int option -> Evd.evar_map -> Pp.t + val pr_evar_universe_context : UState.t -> Pp.t end module Proofview_monad : sig - type lazy_msg = unit -> Pp.std_ppcmds + type lazy_msg = unit -> Pp.t module Info : sig - type tree = Proofview_monad.Info.tree + type tree end end -(* All items in the Goal modules are deprecated. *) -module Goal : +module Evarutil : sig - type goal = Evar.t - - val pr_goal : goal -> Pp.std_ppcmds - - module V82 : - sig - val new_goal_with : Evd.evar_map -> goal -> Context.Named.t -> goal Evd.sigma + val e_new_global : Evd.evar_map ref -> Globnames.global_reference -> EConstr.constr - val nf_hyps : Evd.evar_map -> goal -> Environ.named_context_val + val nf_evars_and_universes : Evd.evar_map -> Evd.evar_map * (Constr.t -> Constr.t) + val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr + val nf_evar_info : Evd.evar_map -> Evd.evar_info -> Evd.evar_info - val env : Evd.evar_map -> goal -> Environ.env + val mk_new_meta : unit -> EConstr.constr - val concl : Evd.evar_map -> goal -> EConstr.constr + (** [new_meta] is a generator of unique meta variables *) + val new_meta : unit -> Constr.metavariable - val mk_goal : Evd.evar_map -> - Environ.named_context_val -> - EConstr.constr -> - Evd.Store.t -> - goal * EConstr.constr * Evd.evar_map + val new_Type : ?rigid:Evd.rigid -> Environ.env -> Evd.evar_map -> Evd.evar_map * EConstr.constr + val new_global : Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * EConstr.constr - val extra : Evd.evar_map -> goal -> Evd.Store.t + val new_evar : + Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> + ?candidates:EConstr.constr list -> ?store:Evd.Store.t -> + ?naming:Misctypes.intro_pattern_naming_expr -> + ?principal:bool -> EConstr.types -> Evd.evar_map * EConstr.constr - val partial_solution_to : Evd.evar_map -> goal -> goal -> EConstr.constr -> Evd.evar_map + val new_evar_instance : + Environ.named_context_val -> Evd.evar_map -> EConstr.types -> + ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> ?candidates:EConstr.constr list -> + ?store:Evd.Store.t -> ?naming:Misctypes.intro_pattern_naming_expr -> + ?principal:bool -> + EConstr.constr list -> Evd.evar_map * EConstr.constr - val partial_solution : Evd.evar_map -> goal -> EConstr.constr -> Evd.evar_map + val clear_hyps_in_evi : Environ.env -> Evd.evar_map ref -> Environ.named_context_val -> + EConstr.types -> Names.Id.Set.t -> Environ.named_context_val * EConstr.types - val hyps : Evd.evar_map -> goal -> Environ.named_context_val + type clear_dependency_error = + | OccurHypInSimpleClause of Names.Id.t option + | EvarTypingBreak of Constr.existential - val abstract_type : Evd.evar_map -> goal -> EConstr.types - end + exception ClearDependencyError of Names.Id.t * clear_dependency_error + val undefined_evars_of_term : Evd.evar_map -> EConstr.constr -> Evar.Set.t + val e_new_evar : + Environ.env -> Evd.evar_map ref -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> + ?candidates:EConstr.constr list -> ?store:Evd.Store.t -> + ?naming:Misctypes.intro_pattern_naming_expr -> + ?principal:bool -> EConstr.types -> EConstr.constr + val new_type_evar : + Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> + ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> Evd.rigid -> + Evd.evar_map * (EConstr.constr * Sorts.t) + val nf_evars_universes : Evd.evar_map -> Constr.t -> Constr.t + val safe_evar_value : Evd.evar_map -> Term.existential -> Constr.t option + val evd_comb1 : (Evd.evar_map -> 'b -> Evd.evar_map * 'a) -> Evd.evar_map ref -> 'b -> 'a end module Proofview : sig - type proofview = Proofview.proofview - type entry = Proofview.entry - type +'a tactic = 'a Proofview.tactic - type telescope = Proofview.telescope = + type proofview + type entry + type +'a tactic + type telescope = | TNil of Evd.evar_map | TCons of Environ.env * Evd.evar_map * EConstr.types * (Evd.evar_map -> EConstr.constr -> telescope) + module NonLogical : sig - type +'a t = 'a Proofview.NonLogical.t + type +'a t val make : (unit -> 'a) -> 'a t val return : 'a -> 'a t val ( >> ) : unit t -> 'a t -> 'a t val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t val print_char : char -> unit t - val print_debug : Pp.std_ppcmds -> unit t - val print_warning : Pp.std_ppcmds -> unit t - val print_notice : Pp.std_ppcmds -> unit t - val print_info : Pp.std_ppcmds -> unit t + val print_debug : Pp.t -> unit t + val print_warning : Pp.t -> unit t + val print_notice : Pp.t -> unit t + val print_info : Pp.t -> unit t val run : 'a t -> 'a - type 'a ref = 'a Proofview.NonLogical.ref + type 'a ref val ref : 'a -> 'a ref t val ( := ) : 'a ref -> 'a -> unit t val ( ! ) : 'a ref -> 'a t @@ -1658,7 +2918,7 @@ sig val catch : 'a t -> (Exninfo.iexn -> 'a t) -> 'a t val read_line : string t end - val proofview : proofview -> Goal.goal list * Evd.evar_map + val proofview : proofview -> Evd.evar list * Evd.evar_map val cycle : int -> unit tactic val swap : int -> int -> unit tactic val revgoals : unit tactic @@ -1685,25 +2945,25 @@ sig val shelve_unifiable : unit tactic val apply : Environ.env -> 'a tactic -> proofview -> 'a * proofview - * (bool*Goal.goal list*Goal.goal list) + * (bool * Evd.evar list * Evd.evar list) * Proofview_monad.Info.tree val numgoals : int tactic - val with_shelf : 'a tactic -> (Goal.goal list * 'a) tactic + val with_shelf : 'a tactic -> (Evd.evar list * 'a) tactic module Unsafe : sig val tclEVARS : Evd.evar_map -> unit tactic - val tclGETGOALS : Goal.goal list tactic + val tclGETGOALS : Evd.evar list tactic - val tclSETGOALS : Goal.goal list -> unit tactic + val tclSETGOALS : Evd.evar list -> unit tactic - val tclNEWGOALS : Goal.goal list -> unit tactic + val tclNEWGOALS : Evd.evar list -> unit tactic end module Goal : sig - type 'a t = 'a Proofview.Goal.t + type 'a t val enter : ([ `LZ ] t -> unit tactic) -> unit tactic val hyps : 'a t -> EConstr.named_context val nf_enter : ([ `NF ] t -> unit tactic) -> unit tactic @@ -1744,7 +3004,7 @@ end module Ftactic : sig - type +'a focus = 'a Ftactic.focus + type +'a focus type +'a t = 'a focus Proofview.tactic val return : 'a -> 'a t val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic @@ -1766,67 +3026,19 @@ sig end end -module Evarutil : -sig - val e_new_global : Evd.evar_map ref -> Globnames.global_reference -> EConstr.constr - - val nf_evars_and_universes : Evd.evar_map -> Evd.evar_map * (Term.constr -> Term.constr) - val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr - val nf_evar_info : Evd.evar_map -> Evd.evar_info -> Evd.evar_info - - val mk_new_meta : unit -> EConstr.constr - - (** [new_meta] is a generator of unique meta variables *) - val new_meta : unit -> Prelude.metavariable - - val new_Type : ?rigid:Evd.rigid -> Environ.env -> Evd.evar_map -> Evd.evar_map * EConstr.constr - val new_global : Evd.evar_map -> Prelude.global_reference -> Evd.evar_map * EConstr.constr - - val new_evar : - Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> - ?candidates:EConstr.constr list -> ?store:Evd.Store.t -> - ?naming:Misctypes.intro_pattern_naming_expr -> - ?principal:bool -> EConstr.types -> Evd.evar_map * EConstr.constr - - val new_evar_instance : - Environ.named_context_val -> Evd.evar_map -> EConstr.types -> - ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> ?candidates:EConstr.constr list -> - ?store:Evd.Store.t -> ?naming:Misctypes.intro_pattern_naming_expr -> - ?principal:bool -> - EConstr.constr list -> Evd.evar_map * EConstr.constr - - val clear_hyps_in_evi : Environ.env -> Evd.evar_map ref -> Environ.named_context_val -> - EConstr.types -> Names.Id.Set.t -> Environ.named_context_val * EConstr.types - - exception ClearDependencyError of Names.Id.t * Evarutil.clear_dependency_error - val undefined_evars_of_term : Evd.evar_map -> EConstr.constr -> Evar.Set.t - val e_new_evar : - Environ.env -> Evd.evar_map ref -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> - ?candidates:EConstr.constr list -> ?store:Evd.Store.t -> - ?naming:Misctypes.intro_pattern_naming_expr -> - ?principal:bool -> EConstr.types -> EConstr.constr - val new_type_evar : - Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> - ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> Evd.rigid -> - Evd.evar_map * (EConstr.constr * Sorts.t) - val nf_evars_universes : Evd.evar_map -> Term.constr -> Term.constr - val safe_evar_value : Evd.evar_map -> Term.existential -> Term.constr option - val evd_comb1 : (Evd.evar_map -> 'b -> Evd.evar_map * 'a) -> Evd.evar_map ref -> 'b -> 'a -end - module Geninterp : sig module Val : sig - type 'a typ = 'a Geninterp.Val.typ - type t = Geninterp.Val.t = Dyn : 'a typ * 'a -> t - type 'a tag = 'a Geninterp.Val.tag = + type 'a typ + type t = Dyn : 'a typ * 'a -> t + type 'a tag = | Base : 'a typ -> 'a tag | List : 'a tag -> 'a list tag | Opt : 'a tag -> 'a option tag | Pair : 'a tag * 'b tag -> ('a * 'b) tag val create : string -> 'a typ - val pr : 'a typ -> Pp.std_ppcmds + val pr : 'a typ -> Pp.t val eq : 'a typ -> 'b typ -> ('a, 'b) CSig.eq option val typ_list : t list typ val typ_opt : t option typ @@ -1836,8 +3048,8 @@ sig end module TacStore : sig - type t = Geninterp.TacStore.t - type 'a field = 'a Geninterp.TacStore.field + type t + type 'a field val empty : t val field : unit -> 'a field val get : t -> 'a field -> 'a option @@ -1845,9 +3057,10 @@ sig val remove : t -> 'a field -> t val merge : t -> t -> t end - type interp_sign = Geninterp.interp_sign = - {lfun : Val.t Names.Id.Map.t; - extra : TacStore.t } + type interp_sign = { + lfun : Val.t Names.Id.Map.t; + extra : TacStore.t + } type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t val register_interp0 : ('raw, 'glb, 'top) Genarg.genarg_type -> ('glb, Val.t) interp_fun -> unit @@ -1856,443 +3069,582 @@ sig val interp : ('raw, 'glb, 'top) Genarg.genarg_type -> ('glb, Val.t) interp_fun end -module Globnames : +(* XXX: Located manually from intf *) +module Glob_term : sig - type global_reference = Globnames.global_reference = - | VarRef of Names.Id.t - | ConstRef of Names.Constant.t - | IndRef of Names.inductive - | ConstructRef of Names.constructor + type cases_pattern_r = + | PatVar of Names.Name.t + | PatCstr of Names.constructor * cases_pattern list * Names.Name.t + and cases_pattern = cases_pattern_r CAst.t + type existential_name = Names.Id.t + type glob_constr_r = + | GRef of Globnames.global_reference * Misctypes.glob_level list option + (** An identifier that represents a reference to an object defined + either in the (global) environment or in the (local) context. *) + | GVar of Names.Id.t + (** An identifier that cannot be regarded as "GRef". + Bound variables are typically represented this way. *) + | GEvar of existential_name * (Names.Id.t * glob_constr) list + | GPatVar of Evar_kinds.matching_var_kind + | GApp of glob_constr * glob_constr list + | GLambda of Names.Name.t * Decl_kinds.binding_kind * glob_constr * glob_constr + | GProd of Names.Name.t * Decl_kinds.binding_kind * glob_constr * glob_constr + | GLetIn of Names.Name.t * glob_constr * glob_constr option * glob_constr + | GCases of Term.case_style * glob_constr option * tomatch_tuples * cases_clauses + | GLetTuple of Names.Name.t list * (Names.Name.t * glob_constr option) * glob_constr * glob_constr + | GIf of glob_constr * (Names.Name.t * glob_constr option) * glob_constr * glob_constr + | GRec of fix_kind * Names.Id.t array * glob_decl list array * + glob_constr array * glob_constr array + | GSort of Misctypes.glob_sort + | GHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option + | GCast of glob_constr * glob_constr Misctypes.cast_type - type extended_global_reference = Globnames.extended_global_reference = - | TrueGlobal of global_reference - | SynDef of Names.KerName.t + and glob_constr = glob_constr_r CAst.t - (* Long term: change implementation so that only 1 kind of order is needed. - * Today: _env ones are fine grained, which one to pick depends. Eg. - * - conversion rule are implemented by the non_env ones - * - pretty printing (of user provided names/aliases) are implemented by - * the _env ones - *) - module Refset : module type of struct include Globnames.Refset end - module Refmap : module type of struct include Globnames.Refmap end - module Refset_env : module type of struct include Globnames.Refset_env end - module Refmap_env : module type of struct include Globnames.Refmap_env end - module RefOrdered : - sig - type t = global_reference - val compare : t -> t -> int - end + and glob_decl = Names.Name.t * Decl_kinds.binding_kind * glob_constr option * glob_constr - val pop_global_reference : global_reference -> global_reference - val eq_gr : global_reference -> global_reference -> bool - val destIndRef : global_reference -> Names.inductive + and fix_recursion_order = + | GStructRec + | GWfRec of glob_constr + | GMeasureRec of glob_constr * glob_constr option - val encode_mind : Names.DirPath.t -> Names.Id.t -> Names.MutInd.t - val encode_con : Names.DirPath.t -> Names.Id.t -> Names.Constant.t + and fix_kind = + | GFix of ((int option * fix_recursion_order) array * int) + | GCoFix of int - val global_of_constr : Term.constr -> global_reference + and predicate_pattern = + Names.Name.t * (Names.inductive * Names.Name.t list) Loc.located option - val subst_global : Mod_subst.substitution -> global_reference -> global_reference * Term.constr - val destConstructRef : Globnames.global_reference -> Names.constructor + and tomatch_tuple = (glob_constr * predicate_pattern) - val reference_of_constr : Term.constr -> global_reference - [@@ocaml.deprecated "alias of API.Globnames.global_of_constr"] + and tomatch_tuples = tomatch_tuple list + + and cases_clause = (Names.Id.t list * cases_pattern list * glob_constr) Loc.located + and cases_clauses = cases_clause list + + (** A globalised term together with a closure representing the value + of its free variables. Intended for use when these variables are taken + from the Ltac environment. *) + + type closure = { + idents : Names.Id.t Names.Id.Map.t; + typed : Pattern.constr_under_binders Names.Id.Map.t ; + untyped: closed_glob_constr Names.Id.Map.t } + and closed_glob_constr = { + closure: closure; + term: glob_constr } + + (** Ltac variable maps *) + type var_map = Pattern.constr_under_binders Names.Id.Map.t + type uconstr_var_map = closed_glob_constr Names.Id.Map.t + type unbound_ltac_var_map = Geninterp.Val.t Names.Id.Map.t + + type ltac_var_map = { + ltac_constrs : var_map; + (** Ltac variables bound to constrs *) + ltac_uconstrs : uconstr_var_map; + (** Ltac variables bound to untyped constrs *) + ltac_idents: Names.Id.t Names.Id.Map.t; + (** Ltac variables bound to identifiers *) + ltac_genargs : unbound_ltac_var_map; + (** Ltac variables bound to other kinds of arguments *) + } - val is_global : global_reference -> Term.constr -> bool end -module Evar_kinds : +module Notation_term : sig - type obligation_definition_status = Evar_kinds.obligation_definition_status = - | Define of bool - | Expand + type scope_name = string + type notation_var_instance_type = + | NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList + type tmp_scope_name = scope_name - type matching_var_kind = Evar_kinds.matching_var_kind = - | FirstOrderPatVar of Names.Id.t - | SecondOrderPatVar of Names.Id.t + type subscopes = tmp_scope_name option * scope_name list + type notation_constr = + | NRef of Globnames.global_reference + | NVar of Names.Id.t + | NApp of notation_constr * notation_constr list + | NHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option + | NList of Names.Id.t * Names.Id.t * notation_constr * notation_constr * bool + | NLambda of Names.Name.t * notation_constr * notation_constr + | NProd of Names.Name.t * notation_constr * notation_constr + | NBinderList of Names.Id.t * Names.Id.t * notation_constr * notation_constr + | NLetIn of Names.Name.t * notation_constr * notation_constr option * notation_constr + | NCases of Term.case_style * notation_constr option * + (notation_constr * (Names.Name.t * (Names.inductive * Names.Name.t list) option)) list * + (Glob_term.cases_pattern list * notation_constr) list + | NLetTuple of Names.Name.t list * (Names.Name.t * notation_constr option) * + notation_constr * notation_constr + | NIf of notation_constr * (Names.Name.t * notation_constr option) * + notation_constr * notation_constr + | NRec of Glob_term.fix_kind * Names.Id.t array * + (Names.Name.t * notation_constr option * notation_constr) list array * + notation_constr array * notation_constr array + | NSort of Misctypes.glob_sort + | NCast of notation_constr * notation_constr Misctypes.cast_type + type interpretation = (Names.Id.t * (subscopes * notation_var_instance_type)) list * + notation_constr +end - type t = Evar_kinds.t = - | ImplicitArg of Globnames.global_reference * (int * Names.Id.t option) - * bool (** Force inference *) - | BinderType of Names.Name.t - | NamedHole of Names.Id.t (* coming from some ?[id] syntax *) - | QuestionMark of obligation_definition_status * Names.Name.t - | CasesType of bool (* true = a subterm of the type *) - | InternalHole - | TomatchTypeParameter of Names.inductive * int - | GoalEvar - | ImpossibleCase - | MatchingVar of matching_var_kind - | VarInstance of Names.Id.t - | SubEvar of Prelude.evar +module Tactypes : +sig + type glob_constr_and_expr = Glob_term.glob_constr * Constrexpr.constr_expr option + type glob_constr_pattern_and_expr = Names.Id.Set.t * glob_constr_and_expr * Pattern.constr_pattern + type 'a delayed_open = Environ.env -> Evd.evar_map -> Evd.evar_map * 'a + type delayed_open_constr = EConstr.constr delayed_open + type delayed_open_constr_with_bindings = EConstr.constr Misctypes.with_bindings delayed_open + type intro_pattern = delayed_open_constr Misctypes.intro_pattern_expr Loc.located + type intro_patterns = delayed_open_constr Misctypes.intro_pattern_expr Loc.located list + type intro_pattern_naming = Misctypes.intro_pattern_naming_expr Loc.located + type or_and_intro_pattern = delayed_open_constr Misctypes.or_and_intro_pattern_expr Loc.located end -module Decl_kinds : +(* XXX: end of moved from intf *) + +(************************************************************************) +(* End of modules from engine/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from pretyping/ *) +(************************************************************************) + +module Locusops : sig - type polymorphic = bool - type cumulative_inductive_flag = bool - type recursivity_kind = Decl_kinds.recursivity_kind = - | Finite - | CoFinite - | BiFinite - type locality = Decl_kinds.locality = - | Discharge - | Local - | Global - type definition_object_kind = Decl_kinds.definition_object_kind = - | Definition - | Coercion - | SubClass - | CanonicalStructure - | Example - | Fixpoint - | CoFixpoint - | Scheme - | StructureComponent - | IdentityCoercion - | Instance - | Method - type theorem_kind = Decl_kinds.theorem_kind = - | Theorem - | Lemma - | Fact - | Remark - | Property - | Proposition - | Corollary - type goal_object_kind = Decl_kinds.goal_object_kind = - | DefinitionBody of definition_object_kind - | Proof of theorem_kind - type goal_kind = locality * polymorphic * goal_object_kind - type assumption_object_kind = Decl_kinds.assumption_object_kind = - | Definitional - | Logical - | Conjectural - type logical_kind = Decl_kinds.logical_kind = - | IsAssumption of assumption_object_kind - | IsDefinition of definition_object_kind - | IsProof of theorem_kind - type binding_kind = Decl_kinds.binding_kind = - | Explicit - | Implicit - type private_flag = bool - type definition_kind = locality * polymorphic * definition_object_kind + val clause_with_generic_occurrences : 'a Locus.clause_expr -> bool + val nowhere : 'a Locus.clause_expr + val allHypsAndConcl : 'a Locus.clause_expr + val is_nowhere : 'a Locus.clause_expr -> bool + val occurrences_map : + ('a list -> 'b list) -> 'a Locus.occurrences_gen -> 'b Locus.occurrences_gen + val convert_occs : Locus.occurrences -> bool * int list + val onConcl : 'a Locus.clause_expr + val onHyp : 'a -> 'a Locus.clause_expr end -module Misctypes : +module Pretype_errors : sig - type evars_flag = bool - type clear_flag = bool option - type advanced_flag = bool - type rec_flag = bool + type unification_error + type subterm_unification_error + + type type_error = (EConstr.t, EConstr.types) Type_errors.ptype_error + + type pretype_error = + | CantFindCaseType of EConstr.constr + | ActualTypeNotCoercible of EConstr.unsafe_judgment * EConstr.types * unification_error + | UnifOccurCheck of Evar.t * EConstr.constr + | UnsolvableImplicit of Evar.t * Evd.unsolvability_explanation option + | CannotUnify of EConstr.constr * EConstr.constr * unification_error option + | CannotUnifyLocal of EConstr.constr * EConstr.constr * EConstr.constr + | CannotUnifyBindingType of EConstr.constr * EConstr.constr + | CannotGeneralize of EConstr.constr + | NoOccurrenceFound of EConstr.constr * Names.Id.t option + | CannotFindWellTypedAbstraction of EConstr.constr * EConstr.constr list * (Environ.env * type_error) option + | WrongAbstractionType of Names.Name.t * EConstr.constr * EConstr.types * EConstr.types + | AbstractionOverMeta of Names.Name.t * Names.Name.t + | NonLinearUnification of Names.Name.t * EConstr.constr + | VarNotFound of Names.Id.t + | UnexpectedType of EConstr.constr * EConstr.constr + | NotProduct of EConstr.constr + | TypingError of type_error + | CannotUnifyOccurrences of subterm_unification_error + | UnsatisfiableConstraints of + (Evar.t * Evar_kinds.t) option * Evar.Set.t option - type 'a or_by_notation = 'a Misctypes.or_by_notation = - | AN of 'a - | ByNotation of (string * string option) Loc.located - type 'a or_var = 'a Misctypes.or_var = - | ArgArg of 'a - | ArgVar of Names.Id.t Loc.located - type 'a and_short_name = 'a * Names.Id.t Loc.located option - type glob_level = Misctypes.glob_level - type 'a glob_sort_gen = 'a Misctypes.glob_sort_gen = - | GProp - | GSet - | GType of 'a - type sort_info = Names.Name.t Loc.located list - type glob_sort = sort_info glob_sort_gen - type 'a cast_type = 'a Misctypes.cast_type = - | CastConv of 'a - | CastVM of 'a - | CastCoerce - | CastNative of 'a - type 'constr intro_pattern_expr = 'constr Misctypes.intro_pattern_expr = - | IntroForthcoming of bool - | IntroNaming of intro_pattern_naming_expr - | IntroAction of 'constr intro_pattern_action_expr - and intro_pattern_naming_expr = Misctypes.intro_pattern_naming_expr = - | IntroIdentifier of Names.Id.t - | IntroFresh of Names.Id.t - | IntroAnonymous - and 'constr intro_pattern_action_expr = 'constr Misctypes.intro_pattern_action_expr = - | IntroWildcard - | IntroOrAndPattern of 'constr or_and_intro_pattern_expr - | IntroInjection of ('constr intro_pattern_expr) Loc.located list - | IntroApplyOn of 'constr Loc.located * 'constr intro_pattern_expr Loc.located - | IntroRewrite of bool - and 'constr or_and_intro_pattern_expr = 'constr Misctypes.or_and_intro_pattern_expr = - | IntroOrPattern of ('constr intro_pattern_expr) Loc.located list list - | IntroAndPattern of ('constr intro_pattern_expr) Loc.located list - type quantified_hypothesis = Misctypes.quantified_hypothesis = - | AnonHyp of int - | NamedHyp of Names.Id.t - type 'a explicit_bindings = (quantified_hypothesis * 'a) Loc.located list - type 'a bindings = 'a Misctypes.bindings = - | ImplicitBindings of 'a list - | ExplicitBindings of 'a explicit_bindings - | NoBindings - type 'a with_bindings = 'a * 'a bindings - type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg = - | ElimOnConstr of 'a - | ElimOnIdent of Names.Id.t Loc.located - | ElimOnAnonHyp of int - type inversion_kind = Misctypes.inversion_kind = - | SimpleInversion - | FullInversion - | FullInversionClear - type multi = Misctypes.multi = - | Precisely of int - | UpTo of int - | RepeatStar - | RepeatPlus - type 'id move_location = 'id Misctypes.move_location = - | MoveAfter of 'id - | MoveBefore of 'id - | MoveFirst - | MoveLast - type 'a destruction_arg = clear_flag * 'a core_destruction_arg + exception PretypeError of Environ.env * Evd.evar_map * pretype_error + val error_var_not_found : ?loc:Loc.t -> Names.Id.t -> 'b + val precatchable_exception : exn -> bool end -module Pattern : +module Reductionops : sig - type case_info_pattern = Pattern.case_info_pattern - type constr_pattern = Pattern.constr_pattern = - | PRef of Globnames.global_reference - | PVar of Names.Id.t - | PEvar of Evar.t * constr_pattern array - | PRel of int - | PApp of constr_pattern * constr_pattern array - | PSoApp of Names.Id.t * constr_pattern list - | PProj of Names.Projection.t * constr_pattern - | PLambda of Names.Name.t * constr_pattern * constr_pattern - | PProd of Names.Name.t * constr_pattern * constr_pattern - | PLetIn of Names.Name.t * constr_pattern * constr_pattern option * constr_pattern - | PSort of Misctypes.glob_sort - | PMeta of Names.Id.t option - | PIf of constr_pattern * constr_pattern * constr_pattern - | PCase of case_info_pattern * constr_pattern * constr_pattern * - (int * bool list * constr_pattern) list (** index of constructor, nb of args *) - | PFix of Term.fixpoint - | PCoFix of Term.cofixpoint - type constr_under_binders = Names.Id.t list * EConstr.constr - type extended_patvar_map = constr_under_binders Names.Id.Map.t - type patvar_map = EConstr.constr Names.Id.Map.t + type local_reduction_function = Evd.evar_map -> EConstr.constr -> EConstr.constr + + type reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr + + type local_stack_reduction_function = + Evd.evar_map -> EConstr.constr -> EConstr.constr * EConstr.constr list + + type e_reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.constr + type state + + val clos_whd_flags : CClosure.RedFlags.reds -> reduction_function + val nf_beta : local_reduction_function + val nf_betaiota : local_reduction_function + val splay_prod : Environ.env -> Evd.evar_map -> EConstr.constr -> + (Names.Name.t * EConstr.constr) list * EConstr.constr + val splay_prod_n : Environ.env -> Evd.evar_map -> int -> EConstr.constr -> EConstr.rel_context * EConstr.constr + val whd_all : reduction_function + val whd_beta : local_reduction_function + + val whd_betaiotazeta : local_reduction_function + + val whd_betaiota_stack : local_stack_reduction_function + + val clos_norm_flags : CClosure.RedFlags.reds -> reduction_function + val is_conv : ?reds:Names.transparent_state -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + val beta_applist : Evd.evar_map -> EConstr.constr * EConstr.constr list -> EConstr.constr + val sort_of_arity : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.ESorts.t + val is_conv_leq : ?reds:Names.transparent_state -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + val whd_betaiota : local_reduction_function + val is_arity : Environ.env -> Evd.evar_map -> EConstr.constr -> bool + val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr + val nf_meta : Evd.evar_map -> EConstr.constr -> EConstr.constr + val hnf_prod_appvect : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr array -> EConstr.constr + val pr_state : state -> Pp.t + module Stack : + sig + type 'a t + val pr : ('a -> Pp.t) -> 'a t -> Pp.t + end + module Cst_stack : + sig + type t + val pr : t -> Pp.t + end end -module Constrexpr : +module Inductiveops : sig - type binder_kind = Constrexpr.binder_kind = - | Default of Decl_kinds.binding_kind - | Generalized of Decl_kinds.binding_kind * Decl_kinds.binding_kind * bool - type explicitation = Constrexpr.explicitation = - | ExplByPos of int * Names.Id.t option - | ExplByName of Names.Id.t - type sign = bool - type raw_natural_number = string - type prim_token = Constrexpr.prim_token = - | Numeral of raw_natural_number * sign - | String of string - type notation = string - type instance_expr = Misctypes.glob_level list - type proj_flag = int option - type abstraction_kind = Constrexpr.abstraction_kind = - | AbsLambda - | AbsPi - type cases_pattern_expr_r = Constrexpr.cases_pattern_expr_r = - | CPatAlias of cases_pattern_expr * Names.Id.t - | CPatCstr of Prelude.reference - * cases_pattern_expr list option * cases_pattern_expr list - (** [CPatCstr (_, c, Some l1, l2)] represents (@c l1) l2 *) - | CPatAtom of Prelude.reference option - | CPatOr of cases_pattern_expr list - | CPatNotation of notation * cases_pattern_notation_substitution - * cases_pattern_expr list - | CPatPrim of prim_token - | CPatRecord of (Prelude.reference * cases_pattern_expr) list - | CPatDelimiters of string * cases_pattern_expr - | CPatCast of cases_pattern_expr * constr_expr - and cases_pattern_expr = cases_pattern_expr_r CAst.t + type inductive_family + type inductive_type = + | IndType of inductive_family * EConstr.constr list + type constructor_summary = + { + cs_cstr : Term.pconstructor; + cs_params : Constr.t list; + cs_nargs : int; + cs_args : Context.Rel.t; + cs_concl_realargs : Constr.t array; + } - and cases_pattern_notation_substitution = - cases_pattern_expr list * cases_pattern_expr list list + val arities_of_constructors : Environ.env -> Term.pinductive -> Term.types array + val constructors_nrealargs_env : Environ.env -> Names.inductive -> int array + val constructor_nallargs_env : Environ.env -> Names.constructor -> int - and constr_expr_r = Constrexpr.constr_expr_r = - | CRef of Prelude.reference * instance_expr option - | CFix of Names.Id.t Loc.located * fix_expr list - | CCoFix of Names.Id.t Loc.located * cofix_expr list - | CProdN of binder_expr list * constr_expr - | CLambdaN of binder_expr list * constr_expr - | CLetIn of Names.Name.t Loc.located * constr_expr * constr_expr option * constr_expr - | CAppExpl of (proj_flag * Prelude.reference * instance_expr option) * constr_expr list - | CApp of (proj_flag * constr_expr) * - (constr_expr * explicitation Loc.located option) list - | CRecord of (Prelude.reference * constr_expr) list - | CCases of Term.case_style - * constr_expr option - * case_expr list - * branch_expr list - | CLetTuple of Names.Name.t Loc.located list * (Names.Name.t Loc.located option * constr_expr option) * - constr_expr * constr_expr - | CIf of constr_expr * (Names.Name.t Loc.located option * constr_expr option) - * constr_expr * constr_expr - | CHole of Evar_kinds.t option * Misctypes.intro_pattern_naming_expr * Genarg.raw_generic_argument option - | CPatVar of Names.Id.t - | CEvar of Glob_term.existential_name * (Names.Id.t * constr_expr) list - | CSort of Misctypes.glob_sort - | CCast of constr_expr * constr_expr Misctypes.cast_type - | CNotation of notation * constr_notation_substitution - | CGeneralization of Decl_kinds.binding_kind * abstraction_kind option * constr_expr - | CPrim of prim_token - | CDelimiters of string * constr_expr - and constr_expr = constr_expr_r CAst.t + val inductive_nparams : Names.inductive -> int - and case_expr = constr_expr * Names.Name.t Loc.located option * cases_pattern_expr option + val inductive_nparamdecls : Names.inductive -> int - and branch_expr = - (cases_pattern_expr list Loc.located list * constr_expr) Loc.located + val type_of_constructors : Environ.env -> Term.pinductive -> Term.types array + val find_mrectype : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.constr list + val mis_is_recursive : + Names.inductive * Declarations.mutual_inductive_body * Declarations.one_inductive_body -> bool + val nconstructors : Names.inductive -> int + val find_rectype : Environ.env -> Evd.evar_map -> EConstr.types -> inductive_type + val get_constructors : Environ.env -> inductive_family -> constructor_summary array + val dest_ind_family : inductive_family -> Names.inductive Term.puniverses * Constr.t list + val find_inductive : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * Constr.t list + val type_of_inductive : Environ.env -> Term.pinductive -> Term.types +end - and binder_expr = - Names.Name.t Loc.located list * binder_kind * constr_expr +module Impargs : +sig + type implicit_status + type implicit_side_condition + type implicits_list = implicit_side_condition * implicit_status list + type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool) + type manual_implicits = manual_explicitation list + val is_status_implicit : implicit_status -> bool + val name_of_implicit : implicit_status -> Names.Id.t + val implicits_of_global : Globnames.global_reference -> implicits_list list + val declare_manual_implicits : bool -> Globnames.global_reference -> ?enriching:bool -> + manual_implicits list -> unit + val is_implicit_args : unit -> bool + val is_strict_implicit_args : unit -> bool + val is_contextual_implicit_args : unit -> bool + val make_implicit_args : bool -> unit + val make_strict_implicit_args : bool -> unit + val make_contextual_implicit_args : bool -> unit +end - and fix_expr = - Names.Id.t Loc.located * (Names.Id.t Loc.located option * recursion_order_expr) * - local_binder_expr list * constr_expr * constr_expr +module Retyping : (* reconstruct the type of a term knowing that it was already typechecked *) +sig + val get_type_of : ?polyprop:bool -> ?lax:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types + val get_sort_family_of : ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.family + val expand_projection : Environ.env -> Evd.evar_map -> Names.Projection.t -> EConstr.constr -> EConstr.constr list -> EConstr.constr + val get_sort_of : + ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.t +end - and cofix_expr = - Names.Id.t Loc.located * local_binder_expr list * constr_expr * constr_expr +module Find_subterm : +sig + val error_invalid_occurrence : int list -> 'a +end - and recursion_order_expr = Constrexpr.recursion_order_expr = - | CStructRec - | CWfRec of constr_expr - | CMeasureRec of constr_expr * constr_expr option +module Evarsolve : +sig + val refresh_universes : + ?status:Evd.rigid -> ?onlyalg:bool -> ?refreshset:bool -> bool option -> + Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.types +end - and local_binder_expr = Constrexpr.local_binder_expr = - | CLocalAssum of Names.Name.t Loc.located list * binder_kind * constr_expr - | CLocalDef of Names.Name.t Loc.located * constr_expr * constr_expr option - | CLocalPattern of (cases_pattern_expr * constr_expr option) Loc.located +module Recordops : +sig - and constr_notation_substitution = - constr_expr list * - constr_expr list list * - local_binder_expr list list + type cs_pattern = + | Const_cs of Globnames.global_reference + | Prod_cs + | Sort_cs of Sorts.family + | Default_cs - type typeclass_constraint = (Names.Name.t Loc.located * Names.Id.t Loc.located list option) * Decl_kinds.binding_kind * constr_expr - type constr_pattern_expr = constr_expr + type obj_typ = { + o_DEF : Constr.t; + o_CTX : Univ.AUContext.t; + o_INJ : int option; (** position of trivial argument *) + o_TABS : Constr.t list; (** ordered *) + o_TPARAMS : Constr.t list; (** ordered *) + o_NPARAMS : int; + o_TCOMPS : Constr.t list } + + val lookup_projections : Names.inductive -> Names.Constant.t option list + val lookup_canonical_conversion : (Globnames.global_reference * cs_pattern) -> Constr.t * obj_typ + val find_projection_nparams : Globnames.global_reference -> int end -module Goptions : +module Evarconv : sig - type option_name = string list - type 'a option_sig = 'a Goptions.option_sig = - { - optdepr : bool; - optname : string; - optkey : option_name; - optread : unit -> 'a; - optwrite : 'a -> unit - } - type 'a write_function = 'a Goptions.write_function - val declare_bool_option : ?preprocess:(bool -> bool) -> - bool option_sig -> bool write_function - val declare_int_option : ?preprocess:(int option -> int option) -> - int option option_sig -> int option write_function - val declare_string_option: ?preprocess:(string -> string) -> - string option_sig -> string write_function - val set_bool_option_value : option_name -> bool -> unit + val e_conv : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr -> bool + val the_conv_x : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map + val the_conv_x_leq : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map + val solve_unif_constraints_with_heuristics : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map -> Evd.evar_map end -module Locus : +module Typing : sig - type 'a occurrences_gen = 'a Locus.occurrences_gen = - | AllOccurrences - | AllOccurrencesBut of 'a list (** non-empty *) - | NoOccurrences - | OnlyOccurrences of 'a list (** non-empty *) - type occurrences = int occurrences_gen - type occurrences_expr = (int Misctypes.or_var) occurrences_gen - type 'a with_occurrences = occurrences_expr * 'a - type hyp_location_flag = Locus.hyp_location_flag = - InHyp | InHypTypeOnly | InHypValueOnly - type 'a hyp_location_expr = 'a with_occurrences * hyp_location_flag - type 'id clause_expr = 'id Locus.clause_expr = - { onhyps : 'id hyp_location_expr list option; - concl_occs : occurrences_expr } - type clause = Names.Id.t clause_expr - type hyp_location = Names.Id.t * hyp_location_flag - type goal_location = hyp_location option + val e_sort_of : Environ.env -> Evd.evar_map ref -> EConstr.types -> Sorts.t + + val type_of : ?refresh:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.types + val e_solve_evars : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr + + val unsafe_type_of : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types + + val e_check : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types -> unit + + val e_type_of : ?refresh:bool -> Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types end -module Genredexpr : +module Miscops : sig + val map_red_expr_gen : ('a -> 'd) -> ('b -> 'e) -> ('c -> 'f) -> + ('a,'b,'c) Genredexpr.red_expr_gen -> ('d,'e,'f) Genredexpr.red_expr_gen + val map_cast_type : ('a -> 'b) -> 'a Misctypes.cast_type -> 'b Misctypes.cast_type +end - (** The parsing produces initially a list of [red_atom] *) +module Glob_ops : +sig + val map_glob_constr_left_to_right : (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr + val loc_of_glob_constr : Glob_term.glob_constr -> Loc.t option + val glob_constr_eq : Glob_term.glob_constr -> Glob_term.glob_constr -> bool + val bound_glob_vars : Glob_term.glob_constr -> Names.Id.Set.t - type 'a red_atom = 'a Genredexpr.red_atom = - | FBeta - | FMatch - | FFix - | FCofix - | FZeta - | FConst of 'a list - | FDeltaBut of 'a list + (** Conversion from glob_constr to cases pattern, if possible - (** This list of atoms is immediately converted to a [glob_red_flag] *) + Take the current alias as parameter, + @raise Not_found if translation is impossible *) + val cases_pattern_of_glob_constr : Names.Name.t -> Glob_term.glob_constr -> Glob_term.cases_pattern + val map_glob_constr : + (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr - type 'a glob_red_flag = 'a Genredexpr.glob_red_flag = { - rBeta : bool; - rMatch : bool; - rFix : bool; - rCofix : bool; - rZeta : bool; - rDelta : bool; (** true = delta all but rConst; false = delta only on rConst*) - rConst : 'a list - } + val empty_lvar : Glob_term.ltac_var_map - (** Generic kinds of reductions *) +end - type ('a,'b,'c) red_expr_gen = ('a,'b,'c) Genredexpr.red_expr_gen = - | Red of bool - | Hnf - | Simpl of 'b glob_red_flag*('b,'c) Util.union Locus.with_occurrences option - | Cbv of 'b glob_red_flag - | Cbn of 'b glob_red_flag - | Lazy of 'b glob_red_flag - | Unfold of 'b Locus.with_occurrences list - | Fold of 'a list - | Pattern of 'a Locus.with_occurrences list - | ExtraRedExpr of string - | CbvVm of ('b,'c) Util.union Locus.with_occurrences option - | CbvNative of ('b,'c) Util.union Locus.with_occurrences option +module Redops : +sig + val all_flags : 'a Genredexpr.glob_red_flag + val make_red_flag : 'a Genredexpr.red_atom list -> 'a Genredexpr.glob_red_flag +end - type ('a,'b,'c) may_eval = ('a,'b,'c) Genredexpr.may_eval = - | ConstrTerm of 'a - | ConstrEval of ('a,'b,'c) red_expr_gen * 'a - | ConstrContext of Names.Id.t Loc.located * 'a - | ConstrTypeOf of 'a +module Patternops : +sig + val pattern_of_glob_constr : Glob_term.glob_constr -> Names.Id.t list * Pattern.constr_pattern + val subst_pattern : Mod_subst.substitution -> Pattern.constr_pattern -> Pattern.constr_pattern + val pattern_of_constr : Environ.env -> Evd.evar_map -> Constr.t -> Pattern.constr_pattern + val instantiate_pattern : Environ.env -> + Evd.evar_map -> Pattern.extended_patvar_map -> + Pattern.constr_pattern -> Pattern.constr_pattern +end - type r_trm = Constrexpr.constr_expr - type r_pat = Constrexpr.constr_pattern_expr - type r_cst = Prelude.reference Misctypes.or_by_notation - type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen +module Constr_matching : +sig + val special_meta : Constr.metavariable + + type binding_bound_vars = Names.Id.Set.t + type bound_ident_map = Names.Id.t Names.Id.Map.t + val is_matching : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> bool + val extended_matches : + Environ.env -> Evd.evar_map -> binding_bound_vars * Pattern.constr_pattern -> + EConstr.constr -> bound_ident_map * Pattern.extended_patvar_map + exception PatternMatchingFailure + type matching_result = + { m_sub : bound_ident_map * Pattern.patvar_map; + m_ctx : EConstr.constr } + val match_subterm_gen : Environ.env -> Evd.evar_map -> + bool -> + binding_bound_vars * Pattern.constr_pattern -> EConstr.constr -> + matching_result IStream.t + val matches : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> Pattern.patvar_map +end + +module Tacred : +sig + val try_red_product : Reductionops.reduction_function + val simpl : Reductionops.reduction_function + val unfoldn : + (Locus.occurrences * Names.evaluable_global_reference) list -> Reductionops.reduction_function + val hnf_constr : Reductionops.reduction_function + val red_product : Reductionops.reduction_function + val is_evaluable : Environ.env -> Names.evaluable_global_reference -> bool + val evaluable_of_global_reference : + Environ.env -> Globnames.global_reference -> Names.evaluable_global_reference + val error_not_evaluable : Globnames.global_reference -> 'a + val reduce_to_quantified_ref : + Environ.env -> Evd.evar_map -> Globnames.global_reference -> EConstr.types -> EConstr.types + val pattern_occs : (Locus.occurrences * EConstr.constr) list -> Reductionops.e_reduction_function + val cbv_norm_flags : CClosure.RedFlags.reds -> Reductionops.reduction_function +end + +(* XXX: Located manually from intf *) +module Tok : +sig + + type t = + | KEYWORD of string + | PATTERNIDENT of string + | IDENT of string + | FIELD of string + | INT of string + | STRING of string + | LEFTQMARK + | BULLET of string + | EOI + +end + +module CLexer : +sig + val add_keyword : string -> unit + val remove_keyword : string -> unit + val is_keyword : string -> bool + val keywords : unit -> CString.Set.t + + type keyword_state + val set_keyword_state : keyword_state -> unit + val get_keyword_state : unit -> keyword_state + + val check_ident : string -> unit + val terminal : string -> Tok.t + + include Grammar.GLexerType with type te = Tok.t end +module Extend : +sig + + type gram_assoc = NonA | RightA | LeftA + + type gram_position = + | First + | Last + | Before of string + | After of string + | Level of string + + type production_level = + | NextLevel + | NumLevel of int + + type 'a entry = 'a Grammar.GMake(CLexer).Entry.e + + type 'a user_symbol = + | Ulist1 of 'a user_symbol + | Ulist1sep of 'a user_symbol * string + | Ulist0 of 'a user_symbol + | Ulist0sep of 'a user_symbol * string + | Uopt of 'a user_symbol + | Uentry of 'a + | Uentryl of 'a * int + + type ('self, 'a) symbol = + | Atoken : Tok.t -> ('self, string) symbol + | Alist1 : ('self, 'a) symbol -> ('self, 'a list) symbol + | Alist1sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol + | Alist0 : ('self, 'a) symbol -> ('self, 'a list) symbol + | Alist0sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol + | Aopt : ('self, 'a) symbol -> ('self, 'a option) symbol + | Aself : ('self, 'self) symbol + | Anext : ('self, 'self) symbol + | Aentry : 'a entry -> ('self, 'a) symbol + | Aentryl : 'a entry * int -> ('self, 'a) symbol + | Arules : 'a rules list -> ('self, 'a) symbol + + and ('self, _, 'r) rule = + | Stop : ('self, 'r, 'r) rule + | Next : ('self, 'a, 'r) rule * ('self, 'b) symbol -> ('self, 'b -> 'a, 'r) rule + + and ('a, 'r) norec_rule = { norec_rule : 's. ('s, 'a, 'r) rule } + + and 'a rules = + | Rules : ('act, Loc.t -> 'a) norec_rule * 'act -> 'a rules + + type ('lev,'pos) constr_entry_key_gen = + | ETName | ETReference | ETBigint + | ETBinder of bool + | ETConstr of ('lev * 'pos) + | ETPattern + | ETOther of string * string + | ETConstrList of ('lev * 'pos) * Tok.t list + | ETBinderList of bool * Tok.t list + + type side = Left | Right + + type production_position = + | BorderProd of side * gram_assoc option + | InternalProd + + type constr_prod_entry_key = + (production_level,production_position) constr_entry_key_gen + + type simple_constr_prod_entry_key = + (production_level,unit) constr_entry_key_gen + + type 'a production_rule = + | Rule : ('a, 'act, Loc.t -> 'a) rule * 'act -> 'a production_rule + + type 'a single_extend_statment = + string option * + (** Level *) + gram_assoc option * + (** Associativity *) + 'a production_rule list + (** Symbol list with the interpretation function *) + + type 'a extend_statment = + gram_position option * + 'a single_extend_statment list +end + +(* XXX: Located manually from intf *) module Vernacexpr : sig + open Misctypes + open Constrexpr + open Libnames + type instance_flag = bool option type coercion_flag = bool type inductive_flag = Decl_kinds.recursivity_kind type lname = Names.Name.t Loc.located type lident = Names.Id.t Loc.located - type opacity_flag = Vernacexpr.opacity_flag = + type opacity_flag = | Opaque of lident list option | Transparent type locality_flag = bool - type inductive_kind = Vernacexpr.inductive_kind = + type inductive_kind = | Inductive_kw | CoInductive | Variant | Record | Structure | Class of bool - type 'a hint_info_gen = 'a Vernacexpr.hint_info_gen = - { hint_priority : int option; - hint_pattern : 'a option } - type vernac_type = Vernacexpr.vernac_type = + + type vernac_type = | VtStartProof of vernac_start | VtSideff of vernac_sideff_type | VtQed of vernac_qed_type @@ -2301,94 +3653,142 @@ sig | VtQuery of vernac_part_of_script * Feedback.route_id | VtStm of vernac_control * vernac_part_of_script | VtUnknown - and vernac_qed_type = Vernacexpr.vernac_qed_type = - | VtKeep - | VtKeepAsAxiom - | VtDrop + and vernac_qed_type = + | VtKeep + | VtKeepAsAxiom + | VtDrop and vernac_start = string * opacity_guarantee * Names.Id.t list and vernac_sideff_type = Names.Id.t list and vernac_part_of_script = bool - and vernac_control = Vernacexpr.vernac_control = - | VtWait - | VtJoinDocument - | VtBack of Stateid.t - and opacity_guarantee = Vernacexpr.opacity_guarantee = - | GuaranteesOpacity - | Doesn'tGuaranteeOpacity - and proof_step = Vernacexpr.proof_step = { - parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ]; - proof_block_detection : proof_block_name option - } + and vernac_control = + | VtWait + | VtJoinDocument + | VtBack of Stateid.t + and opacity_guarantee = + | GuaranteesOpacity + | Doesn'tGuaranteeOpacity + and proof_step = { + parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ]; + proof_block_detection : proof_block_name option + } and solving_tac = bool and anon_abstracting_tac = bool and proof_block_name = string - type vernac_when = Vernacexpr.vernac_when = - | VtNow - | VtLater + + type vernac_when = + | VtNow + | VtLater + type verbose_flag = bool type obsolete_locality = bool - type lstring = Vernacexpr.lstring + type lstring type 'a with_coercion = coercion_flag * 'a type scope_name = string type decl_notation = lstring * Constrexpr.constr_expr * scope_name option type constructor_expr = (lident * Constrexpr.constr_expr) with_coercion type 'a with_notation = 'a * decl_notation list - type local_decl_expr = Vernacexpr.local_decl_expr = + + type local_decl_expr = | AssumExpr of lname * Constrexpr.constr_expr | DefExpr of lname * Constrexpr.constr_expr * Constrexpr.constr_expr option + type 'a with_priority = 'a * int option type 'a with_instance = instance_flag * 'a - type constructor_list_or_record_decl_expr = Vernacexpr.constructor_list_or_record_decl_expr = + type constructor_list_or_record_decl_expr = | Constructors of constructor_expr list | RecordDecl of lident option * local_decl_expr with_instance with_priority with_notation list + type plident = lident * lident list option + type inductive_expr = plident with_coercion * Constrexpr.local_binder_expr list * Constrexpr.constr_expr option * inductive_kind * constructor_list_or_record_decl_expr - type syntax_modifier = Vernacexpr.syntax_modifier - type class_rawexpr = Vernacexpr.class_rawexpr - type definition_expr = Vernacexpr.definition_expr - type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen - type proof_expr = Vernacexpr.proof_expr - type proof_end = Vernacexpr.proof_end = + type syntax_modifier = + | SetItemLevel of string list * Extend.production_level + | SetLevel of int + | SetAssoc of Extend.gram_assoc + | SetEntryType of string * Extend.simple_constr_prod_entry_key + | SetOnlyParsing + | SetOnlyPrinting + | SetCompatVersion of Flags.compat_version + | SetFormat of string * string Loc.located + + type class_rawexpr = FunClass | SortClass | RefClass of reference or_by_notation + + type definition_expr = + | ProveBody of local_binder_expr list * constr_expr + | DefineBody of local_binder_expr list * Genredexpr.raw_red_expr option * constr_expr + * constr_expr option + type proof_expr = + plident option * (local_binder_expr list * constr_expr) + + type proof_end = | Admitted | Proved of opacity_flag * lident option - type inline = Vernacexpr.inline + type fixpoint_expr = plident * (Names.Id.t Loc.located option * Constrexpr.recursion_order_expr) * Constrexpr.local_binder_expr list * Constrexpr.constr_expr * Constrexpr.constr_expr option - type cofixpoint_expr = Vernacexpr.cofixpoint_expr - type scheme = Vernacexpr.scheme - type section_subset_expr = Vernacexpr.section_subset_expr - type module_binder = Vernacexpr.module_binder - type vernac_argument_status = Vernacexpr.vernac_argument_status - type vernac_implicit_status = Vernacexpr.vernac_implicit_status - type module_ast_inl = Vernacexpr.module_ast_inl - type 'a module_signature = 'a Vernacexpr.module_signature + + type cofixpoint_expr + + type scheme + + type section_subset_expr + + type module_binder + + type vernac_argument_status + type vernac_implicit_status + type module_ast_inl type extend_name = string * int - type simple_binder = Vernacexpr.simple_binder - type option_value = Vernacexpr.option_value - type showable = Vernacexpr.showable - type bullet = Vernacexpr.bullet - type stm_vernac = Vernacexpr.stm_vernac - type comment = Vernacexpr.comment - type register_kind = Vernacexpr.register_kind - type locatable = Vernacexpr.locatable - type search_restriction = Vernacexpr.search_restriction - type searchable = Vernacexpr.searchable - type printable = Vernacexpr.printable - type option_ref_value = Vernacexpr.option_ref_value - type onlyparsing_flag = Vernacexpr.onlyparsing_flag - type reference_or_constr = Vernacexpr.reference_or_constr - type hint_mode = Vernacexpr.hint_mode - type hints_expr = Vernacexpr.hints_expr = + type simple_binder + type option_value + type showable + type bullet + type stm_vernac + type comment + type register_kind + type locatable + type search_restriction + type searchable + type printable + type option_ref_value + type onlyparsing_flag + type reference_or_constr + + type hint_mode + + type 'a hint_info_gen = + { hint_priority : int option; + hint_pattern : 'a option } + + type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen + + type hints_expr = | HintsResolve of (hint_info_expr * bool * reference_or_constr) list | HintsImmediate of reference_or_constr list - | HintsUnfold of Prelude.reference list - | HintsTransparency of Prelude.reference list * bool - | HintsMode of Prelude.reference * hint_mode list - | HintsConstructors of Prelude.reference list + | HintsUnfold of Libnames.reference list + | HintsTransparency of Libnames.reference list * bool + | HintsMode of Libnames.reference * hint_mode list + | HintsConstructors of Libnames.reference list | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument - type vernac_expr = Vernacexpr.vernac_expr = + + type 'a module_signature = + | Enforce of 'a (** ... : T *) + | Check of 'a list (** ... <: T1 <: T2, possibly empty *) + + type inline = + | NoInline + | DefaultInline + | InlineAt of int + + type cumulative_inductive_parsing_flag = + | GlobalCumulativity + | GlobalNonCumulativity + | LocalCumulativity + | LocalNonCumulativity + + type vernac_expr = | VernacLoad of verbose_flag * string | VernacTime of vernac_expr Loc.located | VernacRedirect of string * vernac_expr Loc.located @@ -2412,7 +3812,7 @@ sig | VernacExactProof of Constrexpr.constr_expr | VernacAssumption of (Decl_kinds.locality option * Decl_kinds.assumption_object_kind) * inline * (plident list * Constrexpr.constr_expr) with_coercion list - | VernacInductive of Decl_kinds.cumulative_inductive_flag * Decl_kinds.private_flag * inductive_flag * (inductive_expr * decl_notation list) list + | VernacInductive of cumulative_inductive_parsing_flag * Decl_kinds.private_flag * inductive_flag * (inductive_expr * decl_notation list) list | VernacFixpoint of Decl_kinds.locality option * (fixpoint_expr * decl_notation list) list | VernacCoFixpoint of @@ -2424,10 +3824,10 @@ sig | VernacBeginSection of lident | VernacEndSegment of lident | VernacRequire of - Prelude.reference option * bool option * Prelude.reference list - | VernacImport of bool * Prelude.reference list - | VernacCanonical of Prelude.reference Misctypes.or_by_notation - | VernacCoercion of obsolete_locality * Prelude.reference Misctypes.or_by_notation * + Libnames.reference option * bool option * Libnames.reference list + | VernacImport of bool * Libnames.reference list + | VernacCanonical of Libnames.reference Misctypes.or_by_notation + | VernacCoercion of obsolete_locality * Libnames.reference Misctypes.or_by_notation * class_rawexpr * class_rawexpr | VernacIdentityCoercion of obsolete_locality * lident * class_rawexpr * class_rawexpr @@ -2437,11 +3837,11 @@ sig Constrexpr.local_binder_expr list * Constrexpr.typeclass_constraint * (bool * Constrexpr.constr_expr) option * - hint_info_expr + hint_info_expr | VernacContext of Constrexpr.local_binder_expr list | VernacDeclareInstances of - (Prelude.reference * hint_info_expr) list - | VernacDeclareClass of Prelude.reference + (Libnames.reference * hint_info_expr) list + | VernacDeclareClass of Libnames.reference | VernacDeclareModule of bool option * lident * module_binder list * module_ast_inl | VernacDefineModule of bool option * lident * module_binder list * @@ -2462,26 +3862,26 @@ sig | VernacBack of int | VernacBackTo of int | VernacCreateHintDb of string * bool - | VernacRemoveHints of string list * Prelude.reference list + | VernacRemoveHints of string list * Libnames.reference list | VernacHints of obsolete_locality * string list * hints_expr | VernacSyntacticDefinition of Names.Id.t Loc.located * (Names.Id.t list * Constrexpr.constr_expr) * obsolete_locality * onlyparsing_flag - | VernacDeclareImplicits of Prelude.reference Misctypes.or_by_notation * + | VernacDeclareImplicits of Libnames.reference Misctypes.or_by_notation * (Constrexpr.explicitation * bool * bool) list list - | VernacArguments of Prelude.reference Misctypes.or_by_notation * + | VernacArguments of Libnames.reference Misctypes.or_by_notation * vernac_argument_status list * (Names.Name.t * vernac_implicit_status) list list * int option * [ `ReductionDontExposeCase | `ReductionNeverUnfold | `Rename | `ExtraScopes | `Assert | `ClearImplicits | `ClearScopes | `DefaultImplicits ] list - | VernacArgumentsScope of Prelude.reference Misctypes.or_by_notation * + | VernacArgumentsScope of Libnames.reference Misctypes.or_by_notation * scope_name option list | VernacReserve of simple_binder list | VernacGeneralizable of (lident list) option - | VernacSetOpacity of (Conv_oracle.level * Prelude.reference Misctypes.or_by_notation list) + | VernacSetOpacity of (Conv_oracle.level * Libnames.reference Misctypes.or_by_notation list) | VernacSetStrategy of - (Conv_oracle.level * Prelude.reference Misctypes.or_by_notation list) list + (Conv_oracle.level * Libnames.reference Misctypes.or_by_notation list) list | VernacUnsetOption of Goptions.option_name | VernacSetOption of Goptions.option_name * option_value | VernacSetAppendOption of Goptions.option_name * string @@ -2520,7 +3920,7 @@ sig | VernacProgram of vernac_expr | VernacPolymorphic of bool * vernac_expr | VernacLocal of bool * vernac_expr - and goal_selector = Vernacexpr.goal_selector = + and goal_selector = | SelectNth of int | SelectList of (int * int) list | SelectId of Names.Id.t @@ -2530,444 +3930,82 @@ sig plident * Constrexpr.local_binder_expr list * Constrexpr.constr_expr option * constructor_expr list end -module Glob_term : -sig - type cases_pattern_r = Glob_term.cases_pattern_r = - | PatVar of Names.Name.t - | PatCstr of Names.constructor * cases_pattern list * Names.Name.t - and cases_pattern = cases_pattern_r CAst.t - type existential_name = Names.Id.t - type glob_constr_r = Glob_term.glob_constr_r = - | GRef of Globnames.global_reference * Misctypes.glob_level list option - (** An identifier that represents a reference to an object defined - either in the (global) environment or in the (local) context. *) - | GVar of Names.Id.t - (** An identifier that cannot be regarded as "GRef". - Bound variables are typically represented this way. *) - | GEvar of existential_name * (Names.Id.t * glob_constr) list - | GPatVar of Evar_kinds.matching_var_kind - | GApp of glob_constr * glob_constr list - | GLambda of Names.Name.t * Decl_kinds.binding_kind * glob_constr * glob_constr - | GProd of Names.Name.t * Decl_kinds.binding_kind * glob_constr * glob_constr - | GLetIn of Names.Name.t * glob_constr * glob_constr option * glob_constr - | GCases of Term.case_style * glob_constr option * tomatch_tuples * cases_clauses - | GLetTuple of Names.Name.t list * (Names.Name.t * glob_constr option) * glob_constr * glob_constr - | GIf of glob_constr * (Names.Name.t * glob_constr option) * glob_constr * glob_constr - | GRec of fix_kind * Names.Id.t array * glob_decl list array * - glob_constr array * glob_constr array - | GSort of Misctypes.glob_sort - | GHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option - | GCast of glob_constr * glob_constr Misctypes.cast_type - - and glob_constr = glob_constr_r CAst.t - - and glob_decl = Names.Name.t * Decl_kinds.binding_kind * glob_constr option * glob_constr - - and fix_recursion_order = Glob_term.fix_recursion_order = - | GStructRec - | GWfRec of glob_constr - | GMeasureRec of glob_constr * glob_constr option - - and fix_kind = Glob_term.fix_kind = - | GFix of ((int option * fix_recursion_order) array * int) - | GCoFix of int - - and predicate_pattern = - Names.Name.t * (Names.inductive * Names.Name.t list) Loc.located option - - and tomatch_tuple = (glob_constr * predicate_pattern) - - and tomatch_tuples = tomatch_tuple list - - and cases_clause = (Names.Id.t list * cases_pattern list * glob_constr) Loc.located - and cases_clauses = cases_clause list +(* XXX: end manual intf move *) - type closure = Glob_term.closure = - { idents:Names.Id.t Names.Id.Map.t; - typed: Pattern.constr_under_binders Names.Id.Map.t ; - untyped:closed_glob_constr Names.Id.Map.t } - and closed_glob_constr = Glob_term.closed_glob_constr = { - closure: closure; - term: glob_constr } - - type var_map = Pattern.constr_under_binders Names.Id.Map.t - type uconstr_var_map = Glob_term.closed_glob_constr Names.Id.Map.t - type unbound_ltac_var_map = Geninterp.Val.t Names.Id.Map.t - type ltac_var_map = Glob_term.ltac_var_map = { - ltac_constrs : var_map; - (** Ltac variables bound to constrs *) - ltac_uconstrs : uconstr_var_map; - (** Ltac variables bound to untyped constrs *) - ltac_idents: Names.Id.t Names.Id.Map.t; - (** Ltac variables bound to identifiers *) - ltac_genargs : unbound_ltac_var_map; - (** Ltac variables bound to other kinds of arguments *) - } -end - -module Libnames : -sig - type full_path = Libnames.full_path - val pr_path : Libnames.full_path -> Pp.std_ppcmds - val make_path : Names.DirPath.t -> Names.Id.t -> full_path - val eq_full_path : full_path -> full_path -> bool - val dirpath : full_path -> Names.DirPath.t - val path_of_string : string -> full_path - - type qualid = Libnames.qualid - val make_qualid : Names.DirPath.t -> Names.Id.t -> qualid - val qualid_eq : qualid -> qualid -> bool - val repr_qualid : qualid -> Names.DirPath.t * Names.Id.t - val pr_qualid : qualid -> Pp.std_ppcmds - val string_of_qualid : qualid -> string - val qualid_of_string : string -> qualid - val qualid_of_path : full_path -> qualid - val qualid_of_dirpath : Names.DirPath.t -> qualid - val qualid_of_ident : Names.Id.t -> qualid - - type reference = Prelude.reference = - | Qualid of Libnames.qualid Loc.located - | Ident of Names.Id.t Loc.located - val loc_of_reference : reference -> Loc.t option - val qualid_of_reference : reference -> qualid Loc.located - val pr_reference : reference -> Pp.std_ppcmds - - val is_dirpath_prefix_of : Names.DirPath.t -> Names.DirPath.t -> bool - val split_dirpath : Names.DirPath.t -> Names.DirPath.t * Names.Id.t - val dirpath_of_string : string -> Names.DirPath.t - val pr_dirpath : Names.DirPath.t -> Pp.std_ppcmds - - val string_of_path : full_path -> string - val basename : full_path -> Names.Id.t - - type object_name = Libnames.full_path * Names.KerName.t - type object_prefix = Names.DirPath.t * (Names.ModPath.t * Names.DirPath.t) - - module Dirset : module type of struct include Libnames.Dirset end - module Dirmap : module type of struct include Libnames.Dirmap end - module Spmap : module type of struct include Libnames.Spmap end -end - -module Libobject : -sig - type obj = Libobject.obj - type 'a substitutivity = 'a Libobject.substitutivity = - | Dispose - | Substitute of 'a - | Keep of 'a - | Anticipate of 'a - type 'a object_declaration = 'a Libobject.object_declaration = - { - object_name : string; - cache_function : Libnames.object_name * 'a -> unit; - load_function : int -> Libnames.object_name * 'a -> unit; - open_function : int -> Libnames.object_name * 'a -> unit; - classify_function : 'a -> 'a substitutivity; - subst_function : Mod_subst.substitution * 'a -> 'a; - discharge_function : Libnames.object_name * 'a -> 'a option; - rebuild_function : 'a -> 'a - } - val declare_object : 'a object_declaration -> ('a -> obj) - val default_object : string -> 'a object_declaration - val object_tag : obj -> string -end - -module Universes : -sig - type universe_binders = Universes.universe_binders - type universe_opt_subst = Universes.universe_opt_subst - val fresh_inductive_instance : Environ.env -> Names.inductive -> Term.pinductive Univ.in_universe_context_set - val new_Type : Names.DirPath.t -> Term.types - val type_of_global : Globnames.global_reference -> Term.types Univ.in_universe_context_set - val unsafe_type_of_global : Globnames.global_reference -> Term.types - val constr_of_global : Prelude.global_reference -> Term.constr - val new_univ_level : Names.DirPath.t -> Univ.Level.t - val unsafe_constr_of_global : Globnames.global_reference -> Term.constr Univ.in_universe_context - val new_sort_in_family : Sorts.family -> Sorts.t - val pr_with_global_universes : Univ.Level.t -> Pp.std_ppcmds - val pr_universe_opt_subst : universe_opt_subst -> Pp.std_ppcmds - type universe_constraint = Universes.universe_constraint - module Constraints : - sig - type t = Universes.Constraints.t - val pr : t -> Pp.std_ppcmds - end -end - -module Global : -sig - val env : unit -> Environ.env - val lookup_mind : Names.MutInd.t -> Declarations.mutual_inductive_body - val lookup_constant : Names.Constant.t -> Declarations.constant_body - val lookup_module : Names.ModPath.t -> Declarations.module_body - val lookup_modtype : Names.ModPath.t -> Declarations.module_type_body - val lookup_inductive : Names.inductive -> Declarations.mutual_inductive_body * Declarations.one_inductive_body - val constant_of_delta_kn : Names.KerName.t -> Names.Constant.t - val register : - Retroknowledge.field -> Term.constr -> Term.constr -> unit - val env_of_context : Environ.named_context_val -> Environ.env - val is_polymorphic : Globnames.global_reference -> bool - - val type_of_global_unsafe : Globnames.global_reference -> Term.types - - val current_dirpath : unit -> Names.DirPath.t - val body_of_constant_body : Declarations.constant_body -> Term.constr option - val body_of_constant : Names.Constant.t -> Term.constr option - val add_constraints : Univ.Constraint.t -> unit -end - -module Lib : sig - type is_type = bool - type export = bool option - type node = Lib.node = - | Leaf of Libobject.obj (* FIX: horrible hack (wrt. Enrico) *) - | CompilingLibrary of Libnames.object_prefix - | OpenedModule of is_type * export * Libnames.object_prefix * Summary.frozen - | ClosedModule of library_segment - | OpenedSection of Libnames.object_prefix * Summary.frozen - | ClosedSection of library_segment - - and library_segment = (Libnames.object_name * node) list - - val current_mp : unit -> Names.ModPath.t - val is_modtype : unit -> bool - val is_module : unit -> bool - val sections_are_opened : unit -> bool - val add_anonymous_leaf : ?cache_first:bool -> Libobject.obj -> unit - val contents : unit -> library_segment - val cwd : unit -> Names.DirPath.t - val add_leaf : Names.Id.t -> Libobject.obj -> Libnames.object_name - val make_kn : Names.Id.t -> Names.KerName.t - val make_path : Names.Id.t -> Libnames.full_path - val discharge_con : Names.Constant.t -> Names.Constant.t - val discharge_inductive : Names.inductive -> Names.inductive -end - -module Library : -sig - val library_is_loaded : Names.DirPath.t -> bool - val loaded_libraries : unit -> Names.DirPath.t list -end - -module Summary : -sig - type marshallable = Summary.marshallable - type 'a summary_declaration = 'a Summary.summary_declaration = - { freeze_function : marshallable -> 'a; - unfreeze_function : 'a -> unit; - init_function : unit -> unit; } - val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref - val declare_summary : string -> 'a summary_declaration -> unit - module Local : - sig - type 'a local_ref = 'a Summary.Local.local_ref - val ref : ?freeze:('a -> 'a) -> name:string -> 'a -> 'a local_ref - val (:=) : 'a local_ref -> 'a -> unit - val (!) : 'a local_ref -> 'a - end -end - -module Declare : -sig - type internal_flag = Declare.internal_flag = - | UserAutomaticRequest - | InternalTacticRequest - | UserIndividualRequest - type constant_declaration = Safe_typing.private_constants Entries.constant_entry * Decl_kinds.logical_kind - type section_variable_entry = Declare.section_variable_entry = - | SectionLocalDef of Safe_typing.private_constants Entries.definition_entry - | SectionLocalAssum of Term.types Univ.in_universe_context_set * Decl_kinds.polymorphic * bool - type variable_declaration = Names.DirPath.t * section_variable_entry * Decl_kinds.logical_kind - val declare_constant : - ?internal:internal_flag -> ?local:bool -> Names.Id.t -> ?export_seff:bool -> constant_declaration -> Names.Constant.t - val declare_universe_context : Decl_kinds.polymorphic -> Univ.ContextSet.t -> unit - val declare_definition : - ?internal:internal_flag -> ?opaque:bool -> ?kind:Decl_kinds.definition_object_kind -> - ?local:bool -> ?poly:Decl_kinds.polymorphic -> Names.Id.t -> ?types:Term.constr -> - Term.constr Univ.in_universe_context_set -> Names.Constant.t - val definition_entry : ?fix_exn:Future.fix_exn -> - ?opaque:bool -> ?inline:bool -> ?types:Term.types -> - ?poly:Decl_kinds.polymorphic -> ?univs:Univ.UContext.t -> - ?eff:Safe_typing.private_constants -> Term.constr -> Safe_typing.private_constants Entries.definition_entry - val definition_message : Names.Id.t -> unit - val declare_variable : Names.Id.t -> variable_declaration -> Libnames.object_name -end - -module Reductionops : -sig - type local_reduction_function = Evd.evar_map -> EConstr.constr -> EConstr.constr - - type reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr - - type local_stack_reduction_function = - Evd.evar_map -> EConstr.constr -> EConstr.constr * EConstr.constr list - - type e_reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.constr - type state = Reductionops.state - - val clos_whd_flags : CClosure.RedFlags.reds -> reduction_function - val nf_beta : local_reduction_function - val nf_betaiota : local_reduction_function - val splay_prod : Environ.env -> Evd.evar_map -> EConstr.constr -> - (Names.Name.t * EConstr.constr) list * EConstr.constr - val splay_prod_n : Environ.env -> Evd.evar_map -> int -> EConstr.constr -> EConstr.rel_context * EConstr.constr - val whd_all : reduction_function - val whd_beta : local_reduction_function - - val whd_betaiotazeta : local_reduction_function - - val whd_betaiota_stack : local_stack_reduction_function - - val clos_norm_flags : CClosure.RedFlags.reds -> reduction_function - val is_conv : ?reds:Names.transparent_state -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool - val beta_applist : Evd.evar_map -> EConstr.constr * EConstr.constr list -> EConstr.constr - val sort_of_arity : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.ESorts.t - val is_conv_leq : ?reds:Names.transparent_state -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool - val whd_betaiota : local_reduction_function - val is_arity : Environ.env -> Evd.evar_map -> EConstr.constr -> bool - val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr - val nf_meta : Evd.evar_map -> EConstr.constr -> EConstr.constr - val hnf_prod_appvect : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr array -> EConstr.constr - val pr_state : state -> Pp.std_ppcmds - module Stack : - sig - type 'a t = 'a Reductionops.Stack.t - val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds - end - module Cst_stack : - sig - type t = Reductionops.Cst_stack.t - val pr : t -> Pp.std_ppcmds - end -end - -module Inductiveops : +module Typeclasses : sig - type inductive_family = Inductiveops.inductive_family - type inductive_type = Inductiveops.inductive_type = - | IndType of inductive_family * EConstr.constr list - type constructor_summary = Inductiveops.constructor_summary = - { - cs_cstr : Term.pconstructor; - cs_params : Term.constr list; - cs_nargs : int; - cs_args : Context.Rel.t; - cs_concl_realargs : Term.constr array; - } - - val arities_of_constructors : Environ.env -> Term.pinductive -> Term.types array - val constructors_nrealargs_env : Environ.env -> Names.inductive -> int array - val constructor_nallargs_env : Environ.env -> Names.constructor -> int - - val inductive_nparams : Names.inductive -> int - - val inductive_nparamdecls : Names.inductive -> int - - val type_of_constructors : Environ.env -> Term.pinductive -> Term.types array - val find_mrectype : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.constr list - val mis_is_recursive : - Names.inductive * Declarations.mutual_inductive_body * Declarations.one_inductive_body -> bool - val nconstructors : Names.inductive -> int - val find_rectype : Environ.env -> Evd.evar_map -> EConstr.types -> inductive_type - val get_constructors : Environ.env -> inductive_family -> constructor_summary array - val dest_ind_family : inductive_family -> Names.inductive Term.puniverses * Term.constr list - val find_inductive : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * Term.constr list - val type_of_inductive : Environ.env -> Term.pinductive -> Term.types -end + type typeclass = { + cl_univs : Univ.AUContext.t; + cl_impl : Globnames.global_reference; + cl_context : (Globnames.global_reference * bool) option list * Context.Rel.t; + cl_props : Context.Rel.t; + cl_projs : (Names.Name.t * (direction * Vernacexpr.hint_info_expr) option + * Names.Constant.t option) list; + cl_strict : bool; + cl_unique : bool; + } + and direction -module Recordops : -sig - type cs_pattern = Recordops.cs_pattern = - | Const_cs of Globnames.global_reference - | Prod_cs - | Sort_cs of Sorts.family - | Default_cs - type obj_typ = Recordops.obj_typ = { - o_DEF : Term.constr; - o_CTX : Univ.ContextSet.t; - o_INJ : int option; (** position of trivial argument *) - o_TABS : Term.constr list; (** ordered *) - o_TPARAMS : Term.constr list; (** ordered *) - o_NPARAMS : int; - o_TCOMPS : Term.constr list } - val lookup_projections : Names.inductive -> Names.Constant.t option list - val lookup_canonical_conversion : (Globnames.global_reference * cs_pattern) -> Term.constr * obj_typ - val find_projection_nparams : Globnames.global_reference -> int -end + type instance + type evar_filter = Evar.t -> Evar_kinds.t -> bool -module Retyping : (* reconstruct the type of a term knowing that it was already typechecked *) -sig - val get_type_of : ?polyprop:bool -> ?lax:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types - val get_sort_family_of : ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.family - val expand_projection : Environ.env -> Evd.evar_map -> Names.Projection.t -> EConstr.constr -> EConstr.constr list -> EConstr.constr - val get_sort_of : - ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.t + val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool -> + ?split:bool -> ?fail:bool -> Environ.env -> Evd.evar_map -> Evd.evar_map + val set_resolvable : Evd.Store.t -> bool -> Evd.Store.t + val resolve_one_typeclass : ?unique:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.constr + val class_info : Globnames.global_reference -> typeclass + val mark_resolvables : ?filter:evar_filter -> Evd.evar_map -> Evd.evar_map + val add_instance : instance -> unit + val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic -> + Globnames.global_reference -> instance end -module Typing : +module Classops : sig - val e_sort_of : Environ.env -> Evd.evar_map ref -> EConstr.types -> Sorts.t - - val type_of : ?refresh:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.types - val e_solve_evars : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr - - val unsafe_type_of : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types - - val e_check : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types -> unit + type coe_index + type inheritance_path = coe_index list + type cl_index - val e_type_of : ?refresh:bool -> Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types + val hide_coercion : Globnames.global_reference -> int option + val lookup_path_to_sort_from : Environ.env -> Evd.evar_map -> EConstr.types -> + EConstr.types * inheritance_path + val get_coercion_value : coe_index -> Constr.t + val coercions : unit -> coe_index list + val pr_cl_index : cl_index -> Pp.t end -module Evarsolve : +module Detyping : sig - val refresh_universes : - ?status:Evd.rigid -> ?onlyalg:bool -> ?refreshset:bool -> bool option -> - Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.types + val print_universes : bool ref + val print_evar_arguments : bool ref + val detype : ?lax:bool -> bool -> Names.Id.t list -> Environ.env -> Evd.evar_map -> EConstr.constr -> Glob_term.glob_constr + val subst_glob_constr : Mod_subst.substitution -> Glob_term.glob_constr -> Glob_term.glob_constr + val set_detype_anonymous : (?loc:Loc.t -> int -> Glob_term.glob_constr) -> unit end -module Constr_matching : -sig - val special_meta : Prelude.metavariable - - type binding_bound_vars = Names.Id.Set.t - type bound_ident_map = Names.Id.t Names.Id.Map.t - val is_matching : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> bool - val extended_matches : - Environ.env -> Evd.evar_map -> binding_bound_vars * Pattern.constr_pattern -> - EConstr.constr -> bound_ident_map * Pattern.extended_patvar_map - exception PatternMatchingFailure - type matching_result = - { m_sub : bound_ident_map * Pattern.patvar_map; - m_ctx : EConstr.constr } - val match_subterm_gen : Environ.env -> Evd.evar_map -> - bool -> - binding_bound_vars * Pattern.constr_pattern -> EConstr.constr -> - matching_result IStream.t - val matches : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> Pattern.patvar_map -end - -module Tactypes : +module Indrec : sig - type glob_constr_and_expr = Glob_term.glob_constr * Constrexpr.constr_expr option - type glob_constr_pattern_and_expr = Names.Id.Set.t * glob_constr_and_expr * Pattern.constr_pattern - type 'a delayed_open = Environ.env -> Evd.evar_map -> Evd.evar_map * 'a - type delayed_open_constr = EConstr.constr delayed_open - type delayed_open_constr_with_bindings = EConstr.constr Misctypes.with_bindings delayed_open - type intro_pattern = delayed_open_constr Misctypes.intro_pattern_expr Loc.located - type intro_patterns = delayed_open_constr Misctypes.intro_pattern_expr Loc.located list - type intro_pattern_naming = Misctypes.intro_pattern_naming_expr Loc.located - type or_and_intro_pattern = delayed_open_constr Misctypes.or_and_intro_pattern_expr Loc.located + type dep_flag = bool + val lookup_eliminator : Names.inductive -> Sorts.family -> Globnames.global_reference + val build_case_analysis_scheme : Environ.env -> Evd.evar_map -> Term.pinductive -> + dep_flag -> Sorts.family -> Evd.evar_map * Constr.t + val make_elimination_ident : Names.Id.t -> Sorts.family -> Names.Id.t + val build_mutual_induction_scheme : + Environ.env -> Evd.evar_map -> (Term.pinductive * dep_flag * Sorts.family) list -> Evd.evar_map * Constr.t list + val build_case_analysis_scheme_default : Environ.env -> Evd.evar_map -> Term.pinductive -> + Sorts.family -> Evd.evar_map * Constr.t end module Pretyping : sig - type typing_constraint = Pretyping.typing_constraint = - | OfType of EConstr.types - | IsType - | WithoutTypeConstraint + type typing_constraint = + | OfType of EConstr.types + | IsType + | WithoutTypeConstraint type inference_hook = Environ.env -> Evd.evar_map -> Evar.t -> Evd.evar_map * EConstr.constr - type inference_flags = Pretyping.inference_flags = { + + type inference_flags = { use_typeclasses : bool; solve_unification_constraints : bool; use_hook : inference_hook option; @@ -2988,7 +4026,7 @@ sig ?expected_type:typing_constraint -> Geninterp.interp_sign -> Glob_term.closed_glob_constr -> EConstr.constr Tactypes.delayed_open val understand : ?flags:inference_flags -> ?expected_type:typing_constraint -> - Environ.env -> Evd.evar_map -> Glob_term.glob_constr -> Term.constr Evd.in_evar_universe_context + Environ.env -> Evd.evar_map -> Glob_term.glob_constr -> Constr.t Evd.in_evar_universe_context val check_evars : Environ.env -> Evd.evar_map -> Evd.evar_map -> EConstr.constr -> unit val interp_elimination_sort : Misctypes.glob_sort -> Sorts.family val register_constr_interp0 : @@ -3000,39 +4038,30 @@ sig Glob_term.ltac_var_map -> typing_constraint -> Glob_term.glob_constr -> Evd.evar_map * EConstr.constr end -module Evarconv : -sig - val e_conv : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr -> bool - val the_conv_x : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map - val the_conv_x_leq : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map - val solve_unif_constraints_with_heuristics : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map -> Evd.evar_map -end - module Unification : sig - type core_unify_flags = Unification.core_unify_flags = - { - modulo_conv_on_closed_terms : Names.transparent_state option; - use_metas_eagerly_in_conv_on_closed_terms : bool; - use_evars_eagerly_in_conv_on_closed_terms : bool; - modulo_delta : Names.transparent_state; - modulo_delta_types : Names.transparent_state; - check_applied_meta_types : bool; - use_pattern_unification : bool; - use_meta_bound_pattern_unification : bool; - frozen_evars : Evar.Set.t; - restrict_conv_on_strict_subterms : bool; - modulo_betaiota : bool; - modulo_eta : bool; - } - type unify_flags = Unification.unify_flags = - { - core_unify_flags : core_unify_flags; - merge_unify_flags : core_unify_flags; - subterm_unify_flags : core_unify_flags; - allow_K_in_toplevel_higher_order_unification : bool; - resolve_evars : bool - } + type core_unify_flags = { + modulo_conv_on_closed_terms : Names.transparent_state option; + use_metas_eagerly_in_conv_on_closed_terms : bool; + use_evars_eagerly_in_conv_on_closed_terms : bool; + modulo_delta : Names.transparent_state; + modulo_delta_types : Names.transparent_state; + check_applied_meta_types : bool; + use_pattern_unification : bool; + use_meta_bound_pattern_unification : bool; + frozen_evars : Evar.Set.t; + restrict_conv_on_strict_subterms : bool; + modulo_betaiota : bool; + modulo_eta : bool; + } + type unify_flags = + { + core_unify_flags : core_unify_flags; + merge_unify_flags : core_unify_flags; + subterm_unify_flags : core_unify_flags; + allow_K_in_toplevel_higher_order_unification : bool; + resolve_evars : bool + } val default_no_delta_unify_flags : unit -> unify_flags val w_unify : Environ.env -> Evd.evar_map -> Reduction.conv_pb -> ?flags:unify_flags -> EConstr.constr -> EConstr.constr -> Evd.evar_map val elim_flags : unit -> unify_flags @@ -3040,76 +4069,47 @@ sig Environ.env -> Evd.evar_map -> ?flags:unify_flags -> EConstr.constr * EConstr.constr -> Evd.evar_map * EConstr.constr end -module Typeclasses : +(************************************************************************) +(* End of modules from pretyping/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from interp/ *) +(************************************************************************) + +module Genintern : sig - type typeclass = Typeclasses.typeclass = { - cl_impl : Globnames.global_reference; - cl_context : (Globnames.global_reference * bool) option list * Context.Rel.t; - cl_props : Context.Rel.t; - cl_projs : (Names.Name.t * (direction * Vernacexpr.hint_info_expr) option - * Names.Constant.t option) list; - cl_strict : bool; - cl_unique : bool; + open Genarg + + module Store : Store.S + + type glob_sign = { + ltacvars : Names.Id.Set.t; + genv : Environ.env; + extra : Store.t; } - and direction = Typeclasses.direction - type instance = Typeclasses.instance - type evar_filter = Evar.t -> Evar_kinds.t -> bool - val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool -> - ?split:bool -> ?fail:bool -> Environ.env -> Evd.evar_map -> Evd.evar_map - val set_resolvable : Evd.Store.t -> bool -> Evd.Store.t - val resolve_one_typeclass : ?unique:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.constr - val class_info : Globnames.global_reference -> typeclass - val mark_resolvables : ?filter:evar_filter -> Evd.evar_map -> Evd.evar_map - val add_instance : instance -> unit - val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic -> - Globnames.global_reference -> instance -end -module Pretype_errors : -sig - type unification_error = Pretype_errors.unification_error - type subterm_unification_error = Pretype_errors.subterm_unification_error - type pretype_error = Pretype_errors.pretype_error = - | CantFindCaseType of EConstr.constr - | ActualTypeNotCoercible of EConstr.unsafe_judgment * EConstr.types * unification_error - | UnifOccurCheck of Evar.t * EConstr.constr - | UnsolvableImplicit of Evar.t * Evd.unsolvability_explanation option - | CannotUnify of EConstr.constr * EConstr.constr * unification_error option - | CannotUnifyLocal of EConstr.constr * EConstr.constr * EConstr.constr - | CannotUnifyBindingType of EConstr.constr * EConstr.constr - | CannotGeneralize of EConstr.constr - | NoOccurrenceFound of EConstr.constr * Names.Id.t option - | CannotFindWellTypedAbstraction of EConstr.constr * EConstr.constr list * (Environ.env * Pretype_errors.type_error) option - | WrongAbstractionType of Names.Name.t * EConstr.constr * EConstr.types * EConstr.types - | AbstractionOverMeta of Names.Name.t * Names.Name.t - | NonLinearUnification of Names.Name.t * EConstr.constr - | VarNotFound of Names.Id.t - | UnexpectedType of EConstr.constr * EConstr.constr - | NotProduct of EConstr.constr - | TypingError of Pretype_errors.type_error - | CannotUnifyOccurrences of subterm_unification_error - | UnsatisfiableConstraints of - (Evar.t * Evar_kinds.t) option * Evar.Set.t option + val empty_glob_sign : Environ.env -> glob_sign - exception PretypeError of Environ.env * Evd.evar_map * pretype_error - val error_var_not_found : ?loc:Loc.t -> Names.Id.t -> 'b - val precatchable_exception : exn -> bool -end + type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb -module Smartlocate : -sig - val locate_global_with_alias : ?head:bool -> Libnames.qualid Loc.located -> Globnames.global_reference - val global_with_alias : ?head:bool -> Prelude.reference -> Globnames.global_reference - val global_of_extended_global : Globnames.extended_global_reference -> Globnames.global_reference - val loc_of_smart_reference : Prelude.reference Misctypes.or_by_notation -> Loc.t option - val smart_global : ?head:bool -> Prelude.reference Misctypes.or_by_notation -> Globnames.global_reference -end -module Dumpglob : -sig - val add_glob : ?loc:Loc.t -> Globnames.global_reference -> unit - val pause : unit -> unit - val continue : unit -> unit + val generic_intern : (raw_generic_argument, glob_generic_argument) intern_fun + + type 'glb subst_fun = Mod_subst.substitution -> 'glb -> 'glb + val generic_substitute : Genarg.glob_generic_argument subst_fun + + type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Names.Id.Map.t -> 'glb -> 'glb + + val register_intern0 : ('raw, 'glb, 'top) genarg_type -> + ('raw, 'glb) intern_fun -> unit + + val register_subst0 : ('raw, 'glb, 'top) genarg_type -> + 'glb subst_fun -> unit + + val register_ntn_subst0 : ('raw, 'glb, 'top) genarg_type -> + 'glb ntn_subst_fun -> unit + end module Stdarg : @@ -3121,18 +4121,18 @@ sig val wit_bool : bool Genarg.uniform_genarg_type val wit_string : string Genarg.uniform_genarg_type val wit_pre_ident : string Genarg.uniform_genarg_type - val wit_global : (Prelude.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type + val wit_global : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type val wit_ident : Names.Id.t Genarg.uniform_genarg_type val wit_integer : int Genarg.uniform_genarg_type val wit_constr : (Constrexpr.constr_expr, Tactypes.glob_constr_and_expr, EConstr.constr) Genarg.genarg_type val wit_open_constr : (Constrexpr.constr_expr, Tactypes.glob_constr_and_expr, EConstr.constr) Genarg.genarg_type val wit_intro_pattern : (Constrexpr.constr_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.glob_constr_and_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.intro_pattern) Genarg.genarg_type val wit_int_or_var : (int Misctypes.or_var, int Misctypes.or_var, int) Genarg.genarg_type - val wit_ref : (Prelude.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type + val wit_ref : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type val wit_clause_dft_concl : (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) Genarg.genarg_type val wit_uconstr : (Constrexpr.constr_expr , Tactypes.glob_constr_and_expr, Glob_term.closed_glob_constr) Genarg.genarg_type val wit_red_expr : - ((Constrexpr.constr_expr,Prelude.reference Misctypes.or_by_notation,Constrexpr.constr_expr) Genredexpr.red_expr_gen, + ((Constrexpr.constr_expr,Libnames.reference Misctypes.or_by_notation,Constrexpr.constr_expr) Genredexpr.red_expr_gen, (Tactypes.glob_constr_and_expr,Names.evaluable_global_reference Misctypes.and_short_name Misctypes.or_var,Tactypes.glob_constr_pattern_and_expr) Genredexpr.red_expr_gen, (EConstr.constr,Names.evaluable_global_reference,Pattern.constr_pattern) Genredexpr.red_expr_gen) Genarg.genarg_type val wit_quant_hyp : Misctypes.quantified_hypothesis Genarg.uniform_genarg_type @@ -3148,94 +4148,105 @@ sig val wit_quantified_hypothesis : Misctypes.quantified_hypothesis Genarg.uniform_genarg_type val wit_clause : (Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Loc.located Locus.clause_expr,Names.Id.t Locus.clause_expr) Genarg.genarg_type val wit_preident : string Genarg.uniform_genarg_type - val wit_reference : (Prelude.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type + val wit_reference : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type val wit_open_constr_with_bindings : (Constrexpr.constr_expr Misctypes.with_bindings, Tactypes.glob_constr_and_expr Misctypes.with_bindings, EConstr.constr Misctypes.with_bindings Tactypes.delayed_open) Genarg.genarg_type end -module Coqlib : +module Constrexpr_ops : sig - type coq_eq_data = Coqlib.coq_eq_data = { eq : Globnames.global_reference; - ind : Globnames.global_reference; - refl : Globnames.global_reference; - sym : Globnames.global_reference; - trans: Globnames.global_reference; - congr: Globnames.global_reference; - } - type coq_sigma_data = Coqlib.coq_sigma_data = { - proj1 : Globnames.global_reference; - proj2 : Globnames.global_reference; - elim : Globnames.global_reference; - intro : Globnames.global_reference; - typ : Globnames.global_reference } - val gen_reference : string -> string list -> string -> Globnames.global_reference - val find_reference : string -> string list -> string -> Globnames.global_reference - val check_required_library : string list -> unit - val logic_module_name : string list - val glob_true : Globnames.global_reference - val glob_false : Globnames.global_reference - val glob_O : Globnames.global_reference - val glob_S : Globnames.global_reference - val nat_path : Libnames.full_path - val datatypes_module_name : string list - val glob_eq : Globnames.global_reference - val build_coq_eq_sym : Globnames.global_reference Util.delayed - val build_coq_False : Globnames.global_reference Util.delayed - val build_coq_not : Globnames.global_reference Util.delayed - val build_coq_eq : Globnames.global_reference Util.delayed - val build_coq_eq_data : coq_eq_data Util.delayed - val path_of_O : Names.constructor - val path_of_S : Names.constructor - val build_prod : coq_sigma_data Util.delayed - val build_coq_True : Globnames.global_reference Util.delayed - val coq_iff_ref : Globnames.global_reference lazy_t - val build_coq_iff_left_proj : Globnames.global_reference Util.delayed - val build_coq_iff_right_proj : Globnames.global_reference Util.delayed - val init_modules : string list list - val build_coq_eq_refl : Globnames.global_reference Util.delayed - val arith_modules : string list list - val zarith_base_modules : string list list - val gen_reference_in_modules : string -> string list list-> string -> Globnames.global_reference - val jmeq_module_name : string list - val coq_eq_ref : Globnames.global_reference lazy_t - val coq_not_ref : Globnames.global_reference lazy_t - val coq_or_ref : Globnames.global_reference lazy_t - val build_coq_and : Globnames.global_reference Util.delayed - val build_coq_I : Globnames.global_reference Util.delayed - val coq_reference : string -> string list -> string -> Globnames.global_reference + val mkIdentC : Names.Id.t -> Constrexpr.constr_expr + val mkAppC : Constrexpr.constr_expr * Constrexpr.constr_expr list -> Constrexpr.constr_expr + val names_of_local_assums : Constrexpr.local_binder_expr list -> Names.Name.t Loc.located list + val coerce_reference_to_id : Libnames.reference -> Names.Id.t + val coerce_to_id : Constrexpr.constr_expr -> Names.Id.t Loc.located + val constr_loc : Constrexpr.constr_expr -> Loc.t option + val mkRefC : Libnames.reference -> Constrexpr.constr_expr + val mkLambdaC : Names.Name.t Loc.located list * Constrexpr.binder_kind * Constrexpr.constr_expr * Constrexpr.constr_expr -> Constrexpr.constr_expr + val default_binder_kind : Constrexpr.binder_kind + val mkLetInC : Names.Name.t Loc.located * Constrexpr.constr_expr * Constrexpr.constr_expr option * Constrexpr.constr_expr -> Constrexpr.constr_expr + val mkCProdN : ?loc:Loc.t -> Constrexpr.local_binder_expr list -> Constrexpr.constr_expr -> Constrexpr.constr_expr end -module Impargs : +module Notation_ops : sig - type implicit_status = Impargs.implicit_status - type implicit_side_condition = Impargs.implicit_side_condition - type implicits_list = implicit_side_condition * implicit_status list - type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool) - type manual_implicits = manual_explicitation list - val is_status_implicit : implicit_status -> bool - val name_of_implicit : implicit_status -> Names.Id.t - val implicits_of_global : Globnames.global_reference -> implicits_list list - val declare_manual_implicits : bool -> Globnames.global_reference -> ?enriching:bool -> - manual_implicits list -> unit - val is_implicit_args : unit -> bool - val is_strict_implicit_args : unit -> bool - val is_contextual_implicit_args : unit -> bool - val make_implicit_args : bool -> unit - val make_strict_implicit_args : bool -> unit - val make_contextual_implicit_args : bool -> unit + val glob_constr_of_notation_constr : ?loc:Loc.t -> Notation_term.notation_constr -> Glob_term.glob_constr + val glob_constr_of_notation_constr_with_binders : ?loc:Loc.t -> + ('a -> Names.Name.t -> 'a * Names.Name.t) -> + ('a -> Notation_term.notation_constr -> Glob_term.glob_constr) -> + 'a -> Notation_term.notation_constr -> Glob_term.glob_constr +end + +module Ppextend : +sig + + type precedence = int + type parenRelation = + | L | E | Any | Prec of precedence + type tolerability = precedence * parenRelation + +end + +module Notation : +sig + type cases_pattern_status = bool + type required_module = Libnames.full_path * string list + type 'a prim_token_interpreter = ?loc:Loc.t -> 'a -> Glob_term.glob_constr + type 'a prim_token_uninterpreter = Glob_term.glob_constr list * (Glob_term.glob_constr -> 'a option) * cases_pattern_status + type delimiters = string + type local_scopes = Notation_term.tmp_scope_name option * Notation_term.scope_name list + type notation_location = (Names.DirPath.t * Names.DirPath.t) * string + val declare_string_interpreter : Notation_term.scope_name -> required_module -> + string prim_token_interpreter -> string prim_token_uninterpreter -> unit + val declare_numeral_interpreter : Notation_term.scope_name -> required_module -> + Bigint.bigint prim_token_interpreter -> Bigint.bigint prim_token_uninterpreter -> unit + val interp_notation_as_global_reference : ?loc:Loc.t -> (Globnames.global_reference -> bool) -> + Constrexpr.notation -> delimiters option -> Globnames.global_reference + val locate_notation : (Glob_term.glob_constr -> Pp.t) -> Constrexpr.notation -> + Notation_term.scope_name option -> Pp.t + val find_delimiters_scope : ?loc:Loc.t -> delimiters -> Notation_term.scope_name + val pr_scope : (Glob_term.glob_constr -> Pp.t) -> Notation_term.scope_name -> Pp.t + val pr_scopes : (Glob_term.glob_constr -> Pp.t) -> Pp.t + val interp_notation : ?loc:Loc.t -> Constrexpr.notation -> local_scopes -> + Notation_term.interpretation * (notation_location * Notation_term.scope_name option) + val uninterp_prim_token : Glob_term.glob_constr -> Notation_term.scope_name * Constrexpr.prim_token +end + +module Dumpglob : +sig + val add_glob : ?loc:Loc.t -> Globnames.global_reference -> unit + val pause : unit -> unit + val continue : unit -> unit +end + +module Smartlocate : +sig + val locate_global_with_alias : ?head:bool -> Libnames.qualid Loc.located -> Globnames.global_reference + val global_with_alias : ?head:bool -> Libnames.reference -> Globnames.global_reference + val global_of_extended_global : Globnames.extended_global_reference -> Globnames.global_reference + val loc_of_smart_reference : Libnames.reference Misctypes.or_by_notation -> Loc.t option + val smart_global : ?head:bool -> Libnames.reference Misctypes.or_by_notation -> Globnames.global_reference +end + +module Topconstr : +sig + val replace_vars_constr_expr : + Names.Id.t Names.Id.Map.t -> Constrexpr.constr_expr -> Constrexpr.constr_expr end module Constrintern : sig - type ltac_sign = Constrintern.ltac_sign = { - ltac_vars : Names.Id.Set.t; - ltac_bound : Names.Id.Set.t; - ltac_extra : Genintern.Store.t; - } - type var_internalization_data = Constrintern.var_internalization_data - type var_internalization_type = Constrintern.var_internalization_type = + type ltac_sign = { + ltac_vars : Names.Id.Set.t; + ltac_bound : Names.Id.Set.t; + ltac_extra : Genintern.Store.t; + } + + type var_internalization_data + + type var_internalization_type = | Inductive of Names.Id.t list * bool | Recursive | Method @@ -3257,9 +4268,9 @@ sig Constrexpr.constr_pattern_expr -> Names.Id.t list * Pattern.constr_pattern val intern_constr : Environ.env -> Constrexpr.constr_expr -> Glob_term.glob_constr val for_grammar : ('a -> 'b) -> 'a -> 'b - val interp_reference : ltac_sign -> Prelude.reference -> Glob_term.glob_constr + val interp_reference : ltac_sign -> Libnames.reference -> Glob_term.glob_constr val interp_constr : Environ.env -> Evd.evar_map -> ?impls:internalization_env -> - Constrexpr.constr_expr -> Term.constr Evd.in_evar_universe_context + Constrexpr.constr_expr -> Constr.t Evd.in_evar_universe_context val interp_open_constr : Environ.env -> Evd.evar_map -> Constrexpr.constr_expr -> Evd.evar_map * EConstr.constr val locate_reference : Libnames.qualid -> Globnames.global_reference val interp_type : Environ.env -> Evd.evar_map -> ?impls:internalization_env -> @@ -3274,70 +4285,218 @@ sig val global_reference : Names.Id.t -> Globnames.global_reference end -module Notation_term : +module Constrextern : sig - type scope_name = string - type notation_var_instance_type = Notation_term.notation_var_instance_type = - | NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList - type tmp_scope_name = Notation_term.tmp_scope_name - type subscopes = tmp_scope_name option * scope_name list - type notation_constr = Notation_term.notation_constr = - | NRef of Globnames.global_reference - | NVar of Names.Id.t - | NApp of notation_constr * notation_constr list - | NHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option - | NList of Names.Id.t * Names.Id.t * notation_constr * notation_constr * bool - | NLambda of Names.Name.t * notation_constr * notation_constr - | NProd of Names.Name.t * notation_constr * notation_constr - | NBinderList of Names.Id.t * Names.Id.t * notation_constr * notation_constr - | NLetIn of Names.Name.t * notation_constr * notation_constr option * notation_constr - | NCases of Term.case_style * notation_constr option * - (notation_constr * (Names.Name.t * (Names.inductive * Names.Name.t list) option)) list * - (Glob_term.cases_pattern list * notation_constr) list - | NLetTuple of Names.Name.t list * (Names.Name.t * notation_constr option) * - notation_constr * notation_constr - | NIf of notation_constr * (Names.Name.t * notation_constr option) * - notation_constr * notation_constr - | NRec of Glob_term.fix_kind * Names.Id.t array * - (Names.Name.t * notation_constr option * notation_constr) list array * - notation_constr array * notation_constr array - | NSort of Misctypes.glob_sort - | NCast of notation_constr * notation_constr Misctypes.cast_type - type interpretation = (Names.Id.t * (subscopes * notation_var_instance_type)) list * - notation_constr + val extern_glob_constr : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr + val extern_glob_type : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr + val extern_constr : ?lax:bool -> bool -> Environ.env -> Evd.evar_map -> Constr.t -> Constrexpr.constr_expr + val without_symbols : ('a -> 'b) -> 'a -> 'b + val print_universes : bool ref + val extern_type : bool -> Environ.env -> Evd.evar_map -> Term.types -> Constrexpr.constr_expr + val with_universes : ('a -> 'b) -> 'a -> 'b + val set_extern_reference : + (?loc:Loc.t -> Names.Id.Set.t -> Globnames.global_reference -> Libnames.reference) -> unit end -module Notation : +module Declare : sig - type cases_pattern_status = bool - type required_module = Libnames.full_path * string list - type 'a prim_token_interpreter = ?loc:Loc.t -> 'a -> Glob_term.glob_constr - type 'a prim_token_uninterpreter = Glob_term.glob_constr list * (Glob_term.glob_constr -> 'a option) * cases_pattern_status - type delimiters = string - type local_scopes = Notation_term.tmp_scope_name option * Notation_term.scope_name list - type notation_location = (Names.DirPath.t * Names.DirPath.t) * string - val declare_string_interpreter : Notation_term.scope_name -> required_module -> - string prim_token_interpreter -> string prim_token_uninterpreter -> unit - val declare_numeral_interpreter : Notation_term.scope_name -> required_module -> - Bigint.bigint prim_token_interpreter -> Bigint.bigint prim_token_uninterpreter -> unit - val interp_notation_as_global_reference : ?loc:Loc.t -> (Globnames.global_reference -> bool) -> - Constrexpr.notation -> delimiters option -> Globnames.global_reference - val locate_notation : (Glob_term.glob_constr -> Pp.std_ppcmds) -> Constrexpr.notation -> - Notation_term.scope_name option -> Pp.std_ppcmds - val find_delimiters_scope : ?loc:Loc.t -> delimiters -> Notation_term.scope_name - val pr_scope : (Glob_term.glob_constr -> Pp.std_ppcmds) -> Notation_term.scope_name -> Pp.std_ppcmds - val pr_scopes : (Glob_term.glob_constr -> Pp.std_ppcmds) -> Pp.std_ppcmds - val interp_notation : ?loc:Loc.t -> Constrexpr.notation -> local_scopes -> - Notation_term.interpretation * (notation_location * Notation_term.scope_name option) - val uninterp_prim_token : Glob_term.glob_constr -> Notation_term.scope_name * Constrexpr.prim_token + type internal_flag = + | UserAutomaticRequest + | InternalTacticRequest + | UserIndividualRequest + + type constant_declaration = Safe_typing.private_constants Entries.constant_entry * Decl_kinds.logical_kind + + type section_variable_entry = + | SectionLocalDef of Safe_typing.private_constants Entries.definition_entry + | SectionLocalAssum of Term.types Univ.in_universe_context_set * Decl_kinds.polymorphic * bool + + type variable_declaration = Names.DirPath.t * section_variable_entry * Decl_kinds.logical_kind + + val declare_constant : + ?internal:internal_flag -> ?local:bool -> Names.Id.t -> ?export_seff:bool -> constant_declaration -> Names.Constant.t + + val declare_universe_context : Decl_kinds.polymorphic -> Univ.ContextSet.t -> unit + + val declare_definition : + ?internal:internal_flag -> ?opaque:bool -> ?kind:Decl_kinds.definition_object_kind -> + ?local:bool -> ?poly:Decl_kinds.polymorphic -> Names.Id.t -> ?types:Constr.t -> + Constr.t Univ.in_universe_context_set -> Names.Constant.t + val definition_entry : ?fix_exn:Future.fix_exn -> + ?opaque:bool -> ?inline:bool -> ?types:Term.types -> + ?poly:Decl_kinds.polymorphic -> ?univs:Univ.UContext.t -> + ?eff:Safe_typing.private_constants -> Constr.t -> Safe_typing.private_constants Entries.definition_entry + val definition_message : Names.Id.t -> unit + val declare_variable : Names.Id.t -> variable_declaration -> Libnames.object_name end -module Mltop : +(************************************************************************) +(* End of modules from interp/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from proofs/ *) +(************************************************************************) + +module Miscprint : sig - val declare_cache_obj : (unit -> unit) -> string -> unit - val add_known_plugin : (unit -> unit) -> string -> unit - val add_known_module : string -> unit - val module_is_known : string -> bool + val pr_or_and_intro_pattern : + ('a -> Pp.t) -> 'a Misctypes.or_and_intro_pattern_expr -> Pp.t + val pr_intro_pattern_naming : Misctypes.intro_pattern_naming_expr -> Pp.t + val pr_intro_pattern : + ('a -> Pp.t) -> 'a Misctypes.intro_pattern_expr Loc.located -> Pp.t + val pr_bindings : + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a Misctypes.bindings -> Pp.t + val pr_bindings_no_with : + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a Misctypes.bindings -> Pp.t + val pr_with_bindings : + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a * 'a Misctypes.bindings -> Pp.t +end + +(* All items in the Goal modules are deprecated. *) +module Goal : +sig + type goal = Evar.t + + val pr_goal : goal -> Pp.t + + module V82 : + sig + val new_goal_with : Evd.evar_map -> goal -> Context.Named.t -> goal Evd.sigma + + val nf_hyps : Evd.evar_map -> goal -> Environ.named_context_val + + val env : Evd.evar_map -> goal -> Environ.env + + val concl : Evd.evar_map -> goal -> EConstr.constr + + val mk_goal : Evd.evar_map -> + Environ.named_context_val -> + EConstr.constr -> + Evd.Store.t -> + goal * EConstr.constr * Evd.evar_map + + val extra : Evd.evar_map -> goal -> Evd.Store.t + + val partial_solution_to : Evd.evar_map -> goal -> goal -> EConstr.constr -> Evd.evar_map + + val partial_solution : Evd.evar_map -> goal -> EConstr.constr -> Evd.evar_map + + val hyps : Evd.evar_map -> goal -> Environ.named_context_val + + val abstract_type : Evd.evar_map -> goal -> EConstr.types + end +end + +module Evar_refiner : +sig + val w_refine : Evar.t * Evd.evar_info -> + Pretyping.glob_constr_ltac_closure -> Evd.evar_map -> Evd.evar_map +end + + +module Proof_type : +sig + type prim_rule = + | Cut of bool * bool * Names.Id.t * Term.types + | Refine of Constr.t + + type tactic = Goal.goal Evd.sigma -> Goal.goal list Evd.sigma +end + +module Logic : +sig + type refiner_error = + | BadType of Constr.t * Constr.t * Constr.t + | UnresolvedBindings of Names.Name.t list + | CannotApply of Constr.t * Constr.t + | NotWellTyped of Constr.t + | NonLinearProof of Constr.t + | MetaInType of EConstr.constr + | IntroNeedsProduct + | DoesNotOccurIn of Constr.t * Names.Id.t + | NoSuchHyp of Names.Id.t + exception RefinerError of refiner_error + val catchable_exception : exn -> bool +end + +module Refine : +sig + val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit Proofview.tactic + val solve_constraints : unit Proofview.tactic +end + +module Proof : +sig + type proof + type 'a focus_kind + + val run_tactic : Environ.env -> + unit Proofview.tactic -> proof -> proof * (bool * Proofview_monad.Info.tree) + val unshelve : proof -> proof + val maximal_unfocus : 'a focus_kind -> proof -> proof + val pr_proof : proof -> Pp.t + module V82 : + sig + val grab_evars : proof -> proof + + val subgoals : proof -> Goal.goal list Evd.sigma + end +end + +module Proof_bullet : +sig + val get_default_goal_selector : unit -> Vernacexpr.goal_selector +end + +module Proof_global : +sig + type proof_mode = { + name : string; + set : unit -> unit ; + reset : unit -> unit + } + type proof_universes = UState.t * Universes.universe_binders option + type proof_object = { + id : Names.Id.t; + entries : Safe_typing.private_constants Entries.definition_entry list; + persistence : Decl_kinds.goal_kind; + universes: proof_universes; + } + + type proof_ending = + | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * + proof_universes + | Proved of Vernacexpr.opacity_flag * + Vernacexpr.lident option * + proof_object + + type proof_terminator + type lemma_possible_guards + type universe_binders + type closed_proof = proof_object * proof_terminator + + val make_terminator : (proof_ending -> unit) -> proof_terminator + val start_dependent_proof : + Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind -> + Proofview.telescope -> proof_terminator -> unit + val with_current_proof : + (unit Proofview.tactic -> Proof.proof -> Proof.proof * 'a) -> 'a + val simple_with_current_proof : + (unit Proofview.tactic -> Proof.proof -> Proof.proof) -> unit + val compact_the_proof : unit -> unit + val register_proof_mode : proof_mode -> unit + + exception NoCurrentProof + val give_me_the_proof : unit -> Proof.proof + (** @raise NoCurrentProof when outside proof mode. *) + + val discard_all : unit -> unit + val discard_current : unit -> unit + val get_current_proof_name : unit -> Names.Id.t end module Redexpr : @@ -3345,13 +4504,37 @@ sig type red_expr = (EConstr.constr, Names.evaluable_global_reference, Pattern.constr_pattern) Genredexpr.red_expr_gen val reduction_of_red_expr : - Environ.env -> red_expr -> Reductionops.e_reduction_function * Term.cast_kind + Environ.env -> red_expr -> Reductionops.e_reduction_function * Constr.cast_kind val declare_reduction : string -> Reductionops.reduction_function -> unit end +module Refiner : +sig + val project : 'a Evd.sigma -> Evd.evar_map + + val unpackage : 'a Evd.sigma -> Evd.evar_map ref * 'a + + val repackage : Evd.evar_map ref -> 'a -> 'a Evd.sigma + + val tclSHOWHYPS : Proof_type.tactic -> Proof_type.tactic + exception FailError of int * Pp.t Lazy.t + + val tclEVARS : Evd.evar_map -> Proof_type.tactic + val tclMAP : ('a -> Proof_type.tactic) -> 'a list -> Proof_type.tactic + val tclREPEAT : Proof_type.tactic -> Proof_type.tactic + val tclORELSE : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic + val tclFAIL : int -> Pp.t -> Proof_type.tactic + val tclIDTAC : Proof_type.tactic + val tclTHEN : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic + val tclTHENLIST : Proof_type.tactic list -> Proof_type.tactic + val tclTRY : Proof_type.tactic -> Proof_type.tactic + val tclAT_LEAST_ONCE : Proof_type.tactic -> Proof_type.tactic +end + module Tacmach : sig - type tactic = Goal.goal Evd.sigma -> Goal.goal list Evd.sigma + + type tactic = Proof_type.tactic type 'a sigma = 'a Evd.sigma [@@ocaml.deprecated "alias of API.Evd.sigma"] @@ -3373,8 +4556,8 @@ sig val pf_get_hyp : Goal.goal Evd.sigma -> Names.Id.t -> EConstr.named_declaration val pf_get_hyp_typ : Goal.goal Evd.sigma -> Names.Id.t -> EConstr.types val project : Goal.goal Evd.sigma -> Evd.evar_map - val refine : EConstr.constr -> tactic - val refine_no_check : EConstr.constr -> tactic + val refine : EConstr.constr -> Proof_type.tactic + val refine_no_check : EConstr.constr -> Proof_type.tactic val pf_type_of : Goal.goal Evd.sigma -> EConstr.constr -> Evd.evar_map * EConstr.types val pf_hyps : Goal.goal Evd.sigma -> EConstr.named_context @@ -3385,7 +4568,7 @@ sig val pf_reduce_to_quantified_ind : Goal.goal Evd.sigma -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.types - val pf_eapply : (Environ.env -> Evd.evar_map -> 'a -> Evd.evar_map * 'b) -> + val pf_eapply : (Environ.env -> Evd.evar_map -> 'a -> Evd.evar_map * 'b) -> Evar.t Evd.sigma -> 'a -> Evar.t Evd.sigma * 'b val pf_unfoldn : (Locus.occurrences * Names.evaluable_global_reference) list @@ -3399,7 +4582,7 @@ sig val pf_hyps_types : Goal.goal Evd.sigma -> (Names.Id.t * EConstr.types) list - val pr_gls : Goal.goal Evd.sigma -> Pp.std_ppcmds + val pr_gls : Goal.goal Evd.sigma -> Pp.t val pf_nf_betaiota : Goal.goal Evd.sigma -> EConstr.constr -> EConstr.constr @@ -3427,552 +4610,449 @@ sig end end -module Proof : +module Pfedit : sig - type proof = Proof.proof - type 'a focus_kind = 'a Proof.focus_kind - val run_tactic : Environ.env -> - unit Proofview.tactic -> proof -> proof * (bool * Proofview_monad.Info.tree) - val unshelve : proof -> proof - val maximal_unfocus : 'a focus_kind -> proof -> proof - val pr_proof : proof -> Pp.std_ppcmds - module V82 : - sig - val grab_evars : proof -> proof - - val subgoals : proof -> Goal.goal list Evd.sigma - end -end + val solve_by_implicit_tactic : unit -> Pretyping.inference_hook option + val refine_by_tactic : Environ.env -> Evd.evar_map -> EConstr.types -> unit Proofview.tactic -> + Constr.t * Evd.evar_map + val declare_implicit_tactic : unit Proofview.tactic -> unit + val clear_implicit_tactic : unit -> unit + val by : unit Proofview.tactic -> bool + val solve : ?with_end_tac:unit Proofview.tactic -> + Vernacexpr.goal_selector -> int option -> unit Proofview.tactic -> + Proof.proof -> Proof.proof * bool + val cook_proof : + unit -> (Names.Id.t * (Safe_typing.private_constants Entries.definition_entry * Proof_global.proof_universes * Decl_kinds.goal_kind)) -module Proof_global : -sig - type proof_mode = Proof_global.proof_mode = { - name : string; - set : unit -> unit ; - reset : unit -> unit - } - type proof_universes = UState.t * Universes.universe_binders option - type proof_object = Proof_global.proof_object = { - id : Names.Id.t; - entries : Safe_typing.private_constants Entries.definition_entry list; - persistence : Decl_kinds.goal_kind; - universes: proof_universes; - } - type proof_ending = Proof_global.proof_ending = - | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * - proof_universes - | Proved of Vernacexpr.opacity_flag * - Vernacexpr.lident option * - proof_object - type proof_terminator = Proof_global.proof_terminator - type lemma_possible_guards = Proof_global.lemma_possible_guards - type universe_binders = Proof_global.universe_binders - type closed_proof = proof_object * proof_terminator - val make_terminator : (proof_ending -> unit) -> proof_terminator - val start_dependent_proof : - Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind -> - Proofview.telescope -> proof_terminator -> unit - val with_current_proof : - (unit Proofview.tactic -> Proof.proof -> Proof.proof * 'a) -> 'a - val simple_with_current_proof : - (unit Proofview.tactic -> Proof.proof -> Proof.proof) -> unit - val compact_the_proof : unit -> unit - val register_proof_mode : proof_mode -> unit - val get_default_goal_selector : unit -> Vernacexpr.goal_selector + val get_current_context : unit -> Evd.evar_map * Environ.env - exception NoCurrentProof - val give_me_the_proof : unit -> Proof.proof - (** @raise NoCurrentProof when outside proof mode. *) + (* Deprecated *) + val delete_current_proof : unit -> unit + [@@ocaml.deprecated "use Proof_global.discard_current"] - val discard_all : unit -> unit - val discard_current : unit -> unit val get_current_proof_name : unit -> Names.Id.t -end - -module Nametab : -sig - exception GlobalizationError of Libnames.qualid - - type ltac_constant = Names.KerName.t - - val global : Libnames.reference -> Globnames.global_reference - val global_of_path : Libnames.full_path -> Globnames.global_reference - val shortest_qualid_of_global : Names.Id.Set.t -> Globnames.global_reference -> Libnames.qualid - val path_of_global : Globnames.global_reference -> Libnames.full_path - val locate_extended : Libnames.qualid -> Globnames.extended_global_reference - val full_name_module : Libnames.qualid -> Names.DirPath.t - val locate_tactic : Libnames.qualid -> Names.KerName.t - val pr_global_env : Names.Id.Set.t -> Globnames.global_reference -> Pp.std_ppcmds - val shortest_qualid_of_tactic : Names.KerName.t -> Libnames.qualid - val basename_of_global : Globnames.global_reference -> Names.Id.t - - type visibility = Nametab.visibility = - | Until of int - | Exactly of int + [@@ocaml.deprecated "use Proof_global.get_current_proof_name"] - val push_tactic : visibility -> Libnames.full_path -> Names.KerName.t -> unit - val error_global_not_found : ?loc:Loc.t -> Libnames.qualid -> 'a - val shortest_qualid_of_module : Names.ModPath.t -> Libnames.qualid - val dirpath_of_module : Names.ModPath.t -> Names.DirPath.t - val locate_module : Libnames.qualid -> Names.ModPath.t - val dirpath_of_global : Globnames.global_reference -> Names.DirPath.t - val locate : Libnames.qualid -> Globnames.global_reference - val locate_constant : Libnames.qualid -> Names.Constant.t + val current_proof_statement : unit -> Names.Id.t * Decl_kinds.goal_kind * EConstr.types end -module Ppextend : -sig - type precedence = int - type parenRelation = Ppextend.parenRelation = - | L | E | Any | Prec of precedence - type tolerability = precedence * parenRelation -end - -module Refiner : +module Clenv : sig - val project : 'a Evd.sigma -> Evd.evar_map - - val unpackage : 'a Evd.sigma -> Evd.evar_map ref * 'a - val repackage : Evd.evar_map ref -> 'a -> 'a Evd.sigma + type hole = { + hole_evar : EConstr.constr; + hole_type : EConstr.types; + hole_deps : bool; + hole_name : Names.Name.t; + } - val tclSHOWHYPS : Tacmach.tactic -> Tacmach.tactic - exception FailError of int * Pp.std_ppcmds Lazy.t + type clause = { + cl_holes : hole list; + cl_concl : EConstr.types; + } - val tclEVARS : Evd.evar_map -> Tacmach.tactic - val tclMAP : ('a -> Tacmach.tactic) -> 'a list -> Tacmach.tactic - val tclREPEAT : Tacmach.tactic -> Tacmach.tactic - val tclORELSE : Tacmach.tactic -> Tacmach.tactic -> Tacmach.tactic - val tclFAIL : int -> Pp.std_ppcmds -> Tacmach.tactic - val tclIDTAC : Tacmach.tactic - val tclTHEN : Tacmach.tactic -> Tacmach.tactic -> Tacmach.tactic - val tclTHENLIST : Tacmach.tactic list -> Tacmach.tactic - val tclTRY : Tacmach.tactic -> Tacmach.tactic - val tclAT_LEAST_ONCE : Tacmach.tactic -> Tacmach.tactic + val make_evar_clause : Environ.env -> Evd.evar_map -> ?len:int -> EConstr.types -> + (Evd.evar_map * clause) + val solve_evar_clause : Environ.env -> Evd.evar_map -> bool -> clause -> EConstr.constr Misctypes.bindings -> + Evd.evar_map + type clausenv + val pr_clenv : clausenv -> Pp.t end -module Termops : -sig - val it_mkLambda_or_LetIn : Term.constr -> Context.Rel.t -> Term.constr - val local_occur_var : Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool - val occur_var : Environ.env -> Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool - val pr_evar_info : Evd.evar_info -> Pp.std_ppcmds +(************************************************************************) +(* End of modules from proofs/ *) +(************************************************************************) - val print_constr : EConstr.constr -> Pp.std_ppcmds +(************************************************************************) +(* Modules from parsing/ *) +(************************************************************************) - (** [dependent m t] tests whether [m] is a subterm of [t] *) - val dependent : Prelude.evar_map -> EConstr.constr -> EConstr.constr -> bool +module Pcoq : +sig - (** [pop c] returns a copy of [c] with decremented De Bruijn indexes *) - val pop : EConstr.constr -> EConstr.constr + open Loc + open Names + open Extend + open Vernacexpr + open Genarg + open Constrexpr + open Libnames + open Misctypes + open Genredexpr - (** Does a given term contain an existential variable? *) - val occur_existential : Prelude.evar_map -> EConstr.constr -> bool + module Gram : sig + include Grammar.S with type te = Tok.t - (** [map_constr_with_binders_left_to_right g f acc c] maps [f updated_acc] on all the immediate subterms of [c]. - {ul {- if a given immediate subterm of [c] is not below a binder, then [updated_acc] is the same as [acc].} - {- if a given immediate subterm of [c] is below a binder [b], then [updated_acc] is computed as [g b acc].}} *) - val map_constr_with_binders_left_to_right : - Prelude.evar_map -> (EConstr.rel_declaration -> 'a -> 'a) -> ('a -> EConstr.constr -> EConstr.constr) -> 'a -> EConstr.constr -> EConstr.constr + type 'a entry = 'a Entry.e + type internal_entry = Tok.t Gramext.g_entry + type symbol = Tok.t Gramext.g_symbol + type action = Gramext.g_action + type production_rule = symbol list * action + type single_extend_statment = + string option * Gramext.g_assoc option * production_rule list + type extend_statment = + Gramext.position option * single_extend_statment list - (** Remove the outer-most {!Term.kind_of_term.Cast} from a given term. *) - val strip_outer_cast : Prelude.evar_map -> EConstr.constr -> EConstr.constr + type coq_parsable - (** [nb_lam] ⟦[fun (x1:t1)...(xn:tn) => c]⟧ where [c] is not an abstraction gives [n]. - Casts are ignored. *) - val nb_lam : Prelude.evar_map -> EConstr.constr -> int + val parsable : ?file:string -> char Stream.t -> coq_parsable + val action : 'a -> action + val entry_create : string -> 'a entry + val entry_parse : 'a entry -> coq_parsable -> 'a + val entry_print : Format.formatter -> 'a entry -> unit + val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b - (** [push_rel_assum env_assumtion env] adds a given {i env assumption} to the {i env context} of a given {i environment}. *) - val push_rel_assum : Names.Name.t * EConstr.types -> Environ.env -> Environ.env + (* Apparently not used *) + val srules' : production_rule list -> symbol + val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a - (** [push_rels_assum env_assumptions env] adds given {i env assumptions} to the {i env context} of a given {i environment}. *) - val push_rels_assum : (Names.Name.t * Term.types) list -> Environ.env -> Environ.env + end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e - type meta_value_map = Prelude.meta_value_map + val parse_string : 'a Gram.entry -> string -> 'a + val eoi_entry : 'a Gram.entry -> 'a Gram.entry + val map_entry : ('a -> 'b) -> 'a Gram.entry -> 'b Gram.entry - val last_arg : Evd.evar_map -> EConstr.constr -> EConstr.constr - val assums_of_rel_context : ('c, 't) Context.Rel.pt -> (Names.Name.t * 't) list - val prod_applist : Evd.evar_map -> EConstr.constr -> EConstr.constr list -> EConstr.constr - val nb_prod : Evd.evar_map -> EConstr.constr -> int - val is_section_variable : Names.Id.t -> bool - val ids_of_rel_context : ('c, 't) Context.Rel.pt -> Names.Id.t list - val subst_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr - val global_vars_set_of_decl : Environ.env -> Evd.evar_map -> EConstr.named_declaration -> Names.Id.Set.t - val vars_of_env: Environ.env -> Names.Id.Set.t - val ids_of_named_context : ('c, 't) Context.Named.pt -> Names.Id.t list - val ids_of_context : Environ.env -> Names.Id.t list - val global_of_constr : Evd.evar_map -> EConstr.constr -> Globnames.global_reference * EConstr.EInstance.t - val print_named_context : Environ.env -> Pp.std_ppcmds - val print_constr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.std_ppcmds - val clear_named_body : Names.Id.t -> Environ.env -> Environ.env - val is_Prop : Evd.evar_map -> EConstr.constr -> bool - val is_global : Evd.evar_map -> Globnames.global_reference -> EConstr.constr -> bool + type gram_universe - val eq_constr : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool + val uprim : gram_universe + val uconstr : gram_universe + val utactic : gram_universe + val uvernac : gram_universe - val occur_var_in_decl : - Environ.env -> Evd.evar_map -> - Names.Id.t -> EConstr.named_declaration -> bool + val register_grammar : ('raw, 'glb, 'top) genarg_type -> 'raw Gram.entry -> unit - val subst_meta : Prelude.meta_value_map -> Term.constr -> Term.constr + val genarg_grammar : ('raw, 'glb, 'top) genarg_type -> 'raw Gram.entry - val free_rels : Evd.evar_map -> EConstr.constr -> Int.Set.t + val create_generic_entry : gram_universe -> string -> + ('a, rlevel) abstract_argument_type -> 'a Gram.entry - val occur_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool - [@@ocaml.deprecated "alias of API.Termops.dependent"] + module Prim : + sig + open Names + open Libnames + val preident : string Gram.entry + val ident : Id.t Gram.entry + val name : Name.t located Gram.entry + val identref : Id.t located Gram.entry + val pidentref : (Id.t located * (Id.t located list) option) Gram.entry + val pattern_ident : Id.t Gram.entry + val pattern_identref : Id.t located Gram.entry + val base_ident : Id.t Gram.entry + val natural : int Gram.entry + val bigint : Constrexpr.raw_natural_number Gram.entry + val integer : int Gram.entry + val string : string Gram.entry + val lstring : string located Gram.entry + val qualid : qualid located Gram.entry + val fullyqualid : Id.t list located Gram.entry + val reference : reference Gram.entry + val by_notation : (string * string option) Loc.located Gram.entry + val smart_global : reference or_by_notation Gram.entry + val dirpath : DirPath.t Gram.entry + val ne_string : string Gram.entry + val ne_lstring : string located Gram.entry + val var : Id.t located Gram.entry + end - val replace_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr -> EConstr.constr - val map_named_decl : ('a -> 'b) -> ('a, 'a) Context.Named.Declaration.pt -> ('b, 'b) Context.Named.Declaration.pt - val map_rel_decl : ('a -> 'b) -> ('a, 'a) Context.Rel.Declaration.pt -> ('b, 'b) Context.Rel.Declaration.pt - val pr_metaset : Evd.Metaset.t -> Pp.std_ppcmds - val pr_evar_map : ?with_univs:bool -> int option -> Evd.evar_map -> Pp.std_ppcmds - val pr_evar_universe_context : UState.t -> Pp.std_ppcmds -end + module Constr : + sig + val constr : constr_expr Gram.entry + val constr_eoi : constr_expr Gram.entry + val lconstr : constr_expr Gram.entry + val binder_constr : constr_expr Gram.entry + val operconstr : constr_expr Gram.entry + val ident : Id.t Gram.entry + val global : reference Gram.entry + val universe_level : glob_level Gram.entry + val sort : glob_sort Gram.entry + val pattern : cases_pattern_expr Gram.entry + val constr_pattern : constr_expr Gram.entry + val lconstr_pattern : constr_expr Gram.entry + val closed_binder : local_binder_expr list Gram.entry + val binder : local_binder_expr list Gram.entry (* closed_binder or variable *) + val binders : local_binder_expr list Gram.entry (* list of binder *) + val open_binders : local_binder_expr list Gram.entry + val binders_fixannot : (local_binder_expr list * (Id.t located option * recursion_order_expr)) Gram.entry + val typeclass_constraint : (Name.t located * bool * constr_expr) Gram.entry + val record_declaration : constr_expr Gram.entry + val appl_arg : (constr_expr * explicitation located option) Gram.entry + end -module Locality : -sig - val make_section_locality : bool option -> bool - module LocalityFixme : sig - val consume : unit -> bool option + module Vernac_ : + sig + val gallina : vernac_expr Gram.entry + val gallina_ext : vernac_expr Gram.entry + val command : vernac_expr Gram.entry + val syntax : vernac_expr Gram.entry + val vernac : vernac_expr Gram.entry + val rec_definition : (fixpoint_expr * decl_notation list) Gram.entry + val vernac_eoi : vernac_expr Gram.entry + val noedit_mode : vernac_expr Gram.entry + val command_entry : vernac_expr Gram.entry + val red_expr : raw_red_expr Gram.entry + val hint_info : Vernacexpr.hint_info_expr Gram.entry end - val make_module_locality : bool option -> bool -end -module Search : -sig - type glob_search_about_item = Search.glob_search_about_item = - | GlobSearchSubPattern of Pattern.constr_pattern - | GlobSearchString of string - type filter_function = Globnames.global_reference -> Environ.env -> Term.constr -> bool - type display_function = Globnames.global_reference -> Environ.env -> Term.constr -> unit - val search_about_filter : glob_search_about_item -> filter_function - val module_filter : Names.DirPath.t list * bool -> filter_function - val generic_search : int option -> display_function -> unit -end + val epsilon_value : ('a -> 'self) -> ('self, 'a) Extend.symbol -> 'self option -module Notation_ops : -sig - val glob_constr_of_notation_constr : ?loc:Loc.t -> Notation_term.notation_constr -> Glob_term.glob_constr - val glob_constr_of_notation_constr_with_binders : ?loc:Loc.t -> - ('a -> Names.Name.t -> 'a * Names.Name.t) -> - ('a -> Notation_term.notation_constr -> Glob_term.glob_constr) -> - 'a -> Notation_term.notation_constr -> Glob_term.glob_constr -end + val get_command_entry : unit -> vernac_expr Gram.entry + val set_command_entry : vernac_expr Gram.entry -> unit -module Constrextern : -sig - val extern_glob_constr : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr - val extern_glob_type : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr - val extern_constr : ?lax:bool -> bool -> Environ.env -> Evd.evar_map -> Term.constr -> Constrexpr.constr_expr - val without_symbols : ('a -> 'b) -> 'a -> 'b - val print_universes : bool ref - val extern_type : bool -> Environ.env -> Evd.evar_map -> Term.types -> Constrexpr.constr_expr - val with_universes : ('a -> 'b) -> 'a -> 'b - val set_extern_reference : - (?loc:Loc.t -> Names.Id.Set.t -> Globnames.global_reference -> Libnames.reference) -> unit -end + type gram_reinit = gram_assoc * gram_position + val grammar_extend : 'a Gram.entry -> gram_reinit option -> + 'a Extend.extend_statment -> unit -module Patternops : -sig - val pattern_of_glob_constr : Glob_term.glob_constr -> Names.Id.t list * Pattern.constr_pattern - val subst_pattern : Mod_subst.substitution -> Pattern.constr_pattern -> Pattern.constr_pattern - val pattern_of_constr : Environ.env -> Evd.evar_map -> Term.constr -> Pattern.constr_pattern - val instantiate_pattern : Environ.env -> - Evd.evar_map -> Pattern.extended_patvar_map -> - Pattern.constr_pattern -> Pattern.constr_pattern -end + module GramState : Store.S -module Printer : -sig - val pr_named_context : Environ.env -> Evd.evar_map -> Context.Named.t -> Pp.std_ppcmds - val pr_rel_context : Environ.env -> Evd.evar_map -> Context.Rel.t -> Pp.std_ppcmds - val pr_goal : Goal.goal Evd.sigma -> Pp.std_ppcmds - - val pr_constr_env : Prelude.env -> Prelude.evar_map -> Term.constr -> Pp.std_ppcmds - val pr_lconstr_env : Prelude.env -> Prelude.evar_map -> Term.constr -> Pp.std_ppcmds - - val pr_constr : Term.constr -> Pp.std_ppcmds - - val pr_lconstr : Term.constr -> Pp.std_ppcmds - - val pr_econstr : EConstr.constr -> Pp.std_ppcmds - val pr_glob_constr : Glob_term.glob_constr -> Pp.std_ppcmds - val pr_constr_pattern : Pattern.constr_pattern -> Pp.std_ppcmds - val pr_glob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.std_ppcmds - val pr_lglob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.std_ppcmds - val pr_econstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.std_ppcmds - val pr_constr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.std_ppcmds - val pr_lconstr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.std_ppcmds - val pr_closed_glob : Glob_term.closed_glob_constr -> Pp.std_ppcmds - val pr_lglob_constr : Glob_term.glob_constr -> Pp.std_ppcmds - val pr_leconstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.std_ppcmds - val pr_leconstr : EConstr.constr -> Pp.std_ppcmds - val pr_global : Globnames.global_reference -> Pp.std_ppcmds - val pr_lconstr_under_binders : Pattern.constr_under_binders -> Pp.std_ppcmds - val pr_lconstr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.std_ppcmds - - val pr_constr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.std_ppcmds - val pr_closed_glob_env : Environ.env -> Evd.evar_map -> Glob_term.closed_glob_constr -> Pp.std_ppcmds - val pr_rel_context_of : Environ.env -> Evd.evar_map -> Pp.std_ppcmds - val pr_named_context_of : Environ.env -> Evd.evar_map -> Pp.std_ppcmds - val pr_ltype : Term.types -> Pp.std_ppcmds - val pr_ljudge : EConstr.unsafe_judgment -> Pp.std_ppcmds * Pp.std_ppcmds - val pr_idpred : Names.Id.Pred.t -> Pp.std_ppcmds - val pr_cpred : Names.Cpred.t -> Pp.std_ppcmds - val pr_transparent_state : Names.transparent_state -> Pp.std_ppcmds -end + type 'a grammar_command -module Classes : -sig - val set_typeclass_transparency : Names.evaluable_global_reference -> bool -> bool -> unit - val new_instance : - ?abstract:bool -> - ?global:bool -> - ?refine:bool -> - Decl_kinds.polymorphic -> - Constrexpr.local_binder_expr list -> - Constrexpr.typeclass_constraint -> - (bool * Constrexpr.constr_expr) option -> - ?generalize:bool -> - ?tac:unit Proofview.tactic -> - ?hook:(Globnames.global_reference -> unit) -> - Vernacexpr.hint_info_expr -> - Names.Id.t -end + type extend_rule = + | ExtendRule : 'a Gram.entry * gram_reinit option * 'a extend_statment -> extend_rule -module Classops : -sig - type coe_index = Classops.coe_index - type inheritance_path = coe_index list - type cl_index = Classops.cl_index + type 'a grammar_extension = 'a -> GramState.t -> extend_rule list * GramState.t - val hide_coercion : Globnames.global_reference -> int option - val lookup_path_to_sort_from : Environ.env -> Evd.evar_map -> EConstr.types -> - EConstr.types * inheritance_path - val get_coercion_value : coe_index -> Constr.t - val coercions : unit -> coe_index list - val pr_cl_index : cl_index -> Pp.std_ppcmds -end + val create_grammar_command : string -> 'a grammar_extension -> 'a grammar_command -module ExplainErr : -sig - val process_vernac_interp_error : ?allow_uncaught:bool -> Util.iexn -> Util.iexn - val register_additional_error_info : (Util.iexn -> Pp.std_ppcmds option Loc.located option) -> unit -end + val extend_grammar_command : 'a grammar_command -> 'a -> unit + val recover_grammar_command : 'a grammar_command -> 'a list + val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b -module Tacred : -sig - val try_red_product : Reductionops.reduction_function - val simpl : Reductionops.reduction_function - val unfoldn : - (Locus.occurrences * Names.evaluable_global_reference) list -> Reductionops.reduction_function - val hnf_constr : Reductionops.reduction_function - val red_product : Reductionops.reduction_function - val is_evaluable : Environ.env -> Names.evaluable_global_reference -> bool - val evaluable_of_global_reference : - Environ.env -> Globnames.global_reference -> Names.evaluable_global_reference - val error_not_evaluable : Globnames.global_reference -> 'a - val reduce_to_quantified_ref : - Environ.env -> Evd.evar_map -> Globnames.global_reference -> EConstr.types -> EConstr.types - val pattern_occs : (Locus.occurrences * EConstr.constr) list -> Reductionops.e_reduction_function - val cbv_norm_flags : CClosure.RedFlags.reds -> Reductionops.reduction_function -end + val to_coqloc : Ploc.t -> Loc.t + val (!@) : Ploc.t -> Loc.t -module Detyping : -sig - val print_universes : bool ref - val print_evar_arguments : bool ref - val detype : ?lax:bool -> bool -> Names.Id.t list -> Environ.env -> Evd.evar_map -> EConstr.constr -> Glob_term.glob_constr - val subst_glob_constr : Mod_subst.substitution -> Glob_term.glob_constr -> Glob_term.glob_constr - val set_detype_anonymous : (?loc:Loc.t -> int -> Glob_term.glob_constr) -> unit end -module Constrexpr_ops : +module Egramml : sig - val mkIdentC : Names.Id.t -> Constrexpr.constr_expr - val mkAppC : Constrexpr.constr_expr * Constrexpr.constr_expr list -> Constrexpr.constr_expr - val names_of_local_assums : Constrexpr.local_binder_expr list -> Names.Name.t Loc.located list - val coerce_reference_to_id : Prelude.reference -> Names.Id.t - val coerce_to_id : Constrexpr.constr_expr -> Names.Id.t Loc.located - val constr_loc : Constrexpr.constr_expr -> Loc.t option - val mkRefC : Prelude.reference -> Constrexpr.constr_expr - val mkLambdaC : Names.Name.t Loc.located list * Constrexpr.binder_kind * Constrexpr.constr_expr * Constrexpr.constr_expr -> Constrexpr.constr_expr - val default_binder_kind : Constrexpr.binder_kind - val mkLetInC : Names.Name.t Loc.located * Constrexpr.constr_expr * Constrexpr.constr_expr option * Constrexpr.constr_expr -> Constrexpr.constr_expr - val mkCProdN : ?loc:Loc.t -> Constrexpr.local_binder_expr list -> Constrexpr.constr_expr -> Constrexpr.constr_expr -end + open Vernacexpr -module Glob_ops : -sig - val map_glob_constr_left_to_right : (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr - val loc_of_glob_constr : Glob_term.glob_constr -> Loc.t option - val glob_constr_eq : Glob_term.glob_constr -> Glob_term.glob_constr -> bool - val bound_glob_vars : Glob_term.glob_constr -> Names.Id.Set.t + type 's grammar_prod_item = + | GramTerminal of string + | GramNonTerminal : ('a Genarg.raw_abstract_argument_type option * + ('s, 'a) Extend.symbol) Loc.located -> 's grammar_prod_item - (** Conversion from glob_constr to cases pattern, if possible + val extend_vernac_command_grammar : + extend_name -> vernac_expr Pcoq.Gram.entry option -> + vernac_expr grammar_prod_item list -> unit - Take the current alias as parameter, - @raise Not_found if translation is impossible *) - val cases_pattern_of_glob_constr : Names.Name.t -> Glob_term.glob_constr -> Glob_term.cases_pattern - val map_glob_constr : - (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr - val empty_lvar : Glob_term.ltac_var_map -end + val make_rule : + (Loc.t -> Genarg.raw_generic_argument list -> 'a) -> + 'a grammar_prod_item list -> 'a Extend.production_rule -module Indrec : -sig - type dep_flag = bool - val lookup_eliminator : Names.inductive -> Sorts.family -> Globnames.global_reference - val build_case_analysis_scheme : Environ.env -> Evd.evar_map -> Term.pinductive -> - dep_flag -> Sorts.family -> Evd.evar_map * Term.constr - val make_elimination_ident : Names.Id.t -> Sorts.family -> Names.Id.t - val build_mutual_induction_scheme : - Environ.env -> Evd.evar_map -> (Term.pinductive * dep_flag * Sorts.family) list -> Evd.evar_map * Term.constr list - val build_case_analysis_scheme_default : Environ.env -> Evd.evar_map -> Term.pinductive -> - Sorts.family -> Evd.evar_map * Term.constr end -module Logic : -sig - type refiner_error = Logic.refiner_error = - | BadType of Term.constr * Term.constr * Term.constr - | UnresolvedBindings of Names.Name.t list - | CannotApply of Term.constr * Term.constr - | NotWellTyped of Term.constr - | NonLinearProof of Term.constr - | MetaInType of EConstr.constr - | IntroNeedsProduct - | DoesNotOccurIn of Term.constr * Names.Id.t - | NoSuchHyp of Names.Id.t - exception RefinerError of refiner_error - val catchable_exception : exn -> bool -end +(************************************************************************) +(* End of modules from parsing/ *) +(************************************************************************) -module Himsg : -sig - val explain_refiner_error : Logic.refiner_error -> Pp.std_ppcmds - val explain_pretype_error : Environ.env -> Evd.evar_map -> Pretype_errors.pretype_error -> Pp.std_ppcmds -end +(************************************************************************) +(* Modules from printing/ *) +(************************************************************************) -module Extend : +module Genprint : sig - type ('self, 'a) symbol = ('self, 'a) Extend.symbol - type 'a user_symbol = 'a Extend.user_symbol = - | Ulist1 of 'a user_symbol - | Ulist1sep of 'a user_symbol * string - | Ulist0 of 'a user_symbol - | Ulist0sep of 'a user_symbol * string - | Uopt of 'a user_symbol - | Uentry of 'a - | Uentryl of 'a * int + type 'a printer = 'a -> Pp.t + val generic_top_print : Genarg.tlevel Genarg.generic_argument printer + val register_print0 : ('raw, 'glb, 'top) Genarg.genarg_type -> + 'raw printer -> 'glb printer -> 'top printer -> unit end module Pputils : sig - val pr_with_occurrences : ('a -> Pp.std_ppcmds) -> (string -> Pp.std_ppcmds) -> 'a Locus.with_occurrences -> Pp.std_ppcmds + val pr_with_occurrences : ('a -> Pp.t) -> (string -> Pp.t) -> 'a Locus.with_occurrences -> Pp.t val pr_red_expr : - ('a -> Pp.std_ppcmds) * ('a -> Pp.std_ppcmds) * ('b -> Pp.std_ppcmds) * ('c -> Pp.std_ppcmds) -> - (string -> Pp.std_ppcmds) -> - ('a,'b,'c) Genredexpr.red_expr_gen -> Pp.std_ppcmds - val pr_raw_generic : Environ.env -> Genarg.rlevel Genarg.generic_argument -> Pp.std_ppcmds - val pr_glb_generic : Environ.env -> Genarg.glevel Genarg.generic_argument -> Pp.std_ppcmds - val pr_or_var : ('a -> Pp.std_ppcmds) -> 'a Misctypes.or_var -> Pp.std_ppcmds - val pr_or_by_notation : ('a -> Pp.std_ppcmds) -> 'a Misctypes.or_by_notation -> Pp.std_ppcmds + ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) -> + (string -> Pp.t) -> + ('a,'b,'c) Genredexpr.red_expr_gen -> Pp.t + val pr_raw_generic : Environ.env -> Genarg.rlevel Genarg.generic_argument -> Pp.t + val pr_glb_generic : Environ.env -> Genarg.glevel Genarg.generic_argument -> Pp.t + val pr_or_var : ('a -> Pp.t) -> 'a Misctypes.or_var -> Pp.t + val pr_or_by_notation : ('a -> Pp.t) -> 'a Misctypes.or_by_notation -> Pp.t end module Ppconstr : sig - val pr_name : Names.Name.t -> Pp.std_ppcmds + val pr_name : Names.Name.t -> Pp.t [@@ocaml.deprecated "alias of API.Names.Name.print"] - val pr_id : Names.Id.t -> Pp.std_ppcmds - val pr_or_var : ('a -> Pp.std_ppcmds) -> 'a Misctypes.or_var -> Pp.std_ppcmds - val pr_with_comments : ?loc:Loc.t -> Pp.std_ppcmds -> Pp.std_ppcmds - val pr_lident : Names.Id.t Loc.located -> Pp.std_ppcmds - val pr_lname : Names.Name.t Loc.located -> Pp.std_ppcmds + val pr_id : Names.Id.t -> Pp.t + val pr_or_var : ('a -> Pp.t) -> 'a Misctypes.or_var -> Pp.t + val pr_with_comments : ?loc:Loc.t -> Pp.t -> Pp.t + val pr_lident : Names.Id.t Loc.located -> Pp.t + val pr_lname : Names.Name.t Loc.located -> Pp.t val prec_less : int -> int * Ppextend.parenRelation -> bool - val pr_constr_expr : Constrexpr.constr_expr -> Pp.std_ppcmds - val pr_lconstr_expr : Constrexpr.constr_expr -> Pp.std_ppcmds - val pr_constr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.std_ppcmds - val pr_lconstr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.std_ppcmds - val pr_binders : Constrexpr.local_binder_expr list -> Pp.std_ppcmds - val pr_glob_sort : Misctypes.glob_sort -> Pp.std_ppcmds + val pr_constr_expr : Constrexpr.constr_expr -> Pp.t + val pr_lconstr_expr : Constrexpr.constr_expr -> Pp.t + val pr_constr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.t + val pr_lconstr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.t + val pr_binders : Constrexpr.local_binder_expr list -> Pp.t + val pr_glob_sort : Misctypes.glob_sort -> Pp.t end -module Genprint : +module Printer : sig - type 'a printer = 'a -> Pp.std_ppcmds - val generic_top_print : Genarg.tlevel Genarg.generic_argument printer - val register_print0 : ('raw, 'glb, 'top) Genarg.genarg_type -> - 'raw printer -> 'glb printer -> 'top printer -> unit + val pr_named_context : Environ.env -> Evd.evar_map -> Context.Named.t -> Pp.t + val pr_rel_context : Environ.env -> Evd.evar_map -> Context.Rel.t -> Pp.t + val pr_goal : Goal.goal Evd.sigma -> Pp.t + + val pr_constr_env : Environ.env -> Evd.evar_map -> Constr.t -> Pp.t + val pr_lconstr_env : Environ.env -> Evd.evar_map -> Constr.t -> Pp.t + + val pr_constr : Constr.t -> Pp.t + + val pr_lconstr : Constr.t -> Pp.t + + val pr_econstr : EConstr.constr -> Pp.t + val pr_glob_constr : Glob_term.glob_constr -> Pp.t + val pr_constr_pattern : Pattern.constr_pattern -> Pp.t + val pr_glob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.t + val pr_lglob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.t + val pr_econstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t + val pr_constr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.t + val pr_lconstr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.t + val pr_closed_glob : Glob_term.closed_glob_constr -> Pp.t + val pr_lglob_constr : Glob_term.glob_constr -> Pp.t + val pr_leconstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t + val pr_leconstr : EConstr.constr -> Pp.t + val pr_global : Globnames.global_reference -> Pp.t + val pr_lconstr_under_binders : Pattern.constr_under_binders -> Pp.t + val pr_lconstr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.t + + val pr_constr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.t + val pr_closed_glob_env : Environ.env -> Evd.evar_map -> Glob_term.closed_glob_constr -> Pp.t + val pr_rel_context_of : Environ.env -> Evd.evar_map -> Pp.t + val pr_named_context_of : Environ.env -> Evd.evar_map -> Pp.t + val pr_ltype : Term.types -> Pp.t + val pr_ljudge : EConstr.unsafe_judgment -> Pp.t * Pp.t + val pr_idpred : Names.Id.Pred.t -> Pp.t + val pr_cpred : Names.Cpred.t -> Pp.t + val pr_transparent_state : Names.transparent_state -> Pp.t end -module Miscprint : -sig - val pr_or_and_intro_pattern : - ('a -> Pp.std_ppcmds) -> 'a Misctypes.or_and_intro_pattern_expr -> Pp.std_ppcmds - val pr_intro_pattern_naming : Misctypes.intro_pattern_naming_expr -> Pp.std_ppcmds - val pr_intro_pattern : - ('a -> Pp.std_ppcmds) -> 'a Misctypes.intro_pattern_expr Loc.located -> Pp.std_ppcmds - val pr_bindings : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a Misctypes.bindings -> Pp.std_ppcmds - val pr_bindings_no_with : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a Misctypes.bindings -> Pp.std_ppcmds - val pr_with_bindings : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a * 'a Misctypes.bindings -> Pp.std_ppcmds -end +(************************************************************************) +(* End of modules from printing/ *) +(************************************************************************) -module Miscops : -sig - val map_red_expr_gen : ('a -> 'd) -> ('b -> 'e) -> ('c -> 'f) -> - ('a,'b,'c) Genredexpr.red_expr_gen -> ('d,'e,'f) Genredexpr.red_expr_gen - val map_cast_type : ('a -> 'b) -> 'a Misctypes.cast_type -> 'b Misctypes.cast_type -end +(************************************************************************) +(* Modules from tactics/ *) +(************************************************************************) -module Stateid : +module Tacticals : sig - type t = Stateid.t - module Self : module type of struct include Stateid.Self end -end + open Proof_type -module Stm : -sig - type state = Stm.state - val state_of_id : - Stateid.t -> [ `Valid of state option | `Expired | `Error of exn ] + val tclORELSE : tactic -> tactic -> tactic + val tclDO : int -> tactic -> tactic + val tclIDTAC : tactic + val tclFAIL : int -> Pp.t -> tactic + val tclTHEN : tactic -> tactic -> tactic + val tclTHENLIST : tactic list -> tactic + val pf_constr_of_global : + Globnames.global_reference -> (EConstr.constr -> Proof_type.tactic) -> Proof_type.tactic + val tclMAP : ('a -> tactic) -> 'a list -> tactic + val tclTRY : tactic -> tactic + val tclCOMPLETE : tactic -> tactic + val tclTHENS : tactic -> tactic list -> tactic + val tclFIRST : tactic list -> tactic + val tclTHENFIRST : tactic -> tactic -> tactic + val tclTHENLAST : tactic -> tactic -> tactic + val tclTHENSFIRSTn : tactic -> tactic array -> tactic -> tactic + val tclTHENSLASTn : tactic -> tactic -> tactic array -> tactic + val tclSOLVE : tactic list -> tactic + + val onClause : (Names.Id.t option -> tactic) -> Locus.clause -> tactic + val onAllHypsAndConcl : (Names.Id.t option -> tactic) -> tactic + val onLastHypId : (Names.Id.t -> tactic) -> tactic + val onNthHypId : int -> (Names.Id.t -> tactic) -> tactic + val onNLastHypsId : int -> (Names.Id.t list -> tactic) -> tactic + + val tclTHENSEQ : tactic list -> tactic + [@@ocaml.deprecated "alias of API.Tacticals.tclTHENLIST"] + + val nLastDecls : int -> Goal.goal Evd.sigma -> EConstr.named_context + + val tclTHEN_i : tactic -> (int -> tactic) -> tactic + + val tclPROGRESS : tactic -> tactic + + val elimination_sort_of_goal : Goal.goal Evd.sigma -> Sorts.family + + module New : + sig + open Proofview + val tclORELSE0 : unit tactic -> unit tactic -> unit tactic + val tclFAIL : int -> Pp.t -> 'a tactic + val pf_constr_of_global : Globnames.global_reference -> EConstr.constr tactic + val tclTHEN : unit tactic -> unit tactic -> unit tactic + val tclTHENS : unit tactic -> unit tactic list -> unit tactic + val tclFIRST : unit tactic list -> unit tactic + val tclZEROMSG : ?loc:Loc.t -> Pp.t -> 'a tactic + val tclORELSE : unit tactic -> unit tactic -> unit tactic + val tclREPEAT : unit tactic -> unit tactic + val tclTRY : unit tactic -> unit tactic + val tclTHENFIRST : unit tactic -> unit tactic -> unit tactic + val tclPROGRESS : unit Proofview.tactic -> unit Proofview.tactic + val tclTHENS3PARTS : unit tactic -> unit tactic array -> unit tactic -> unit tactic array -> unit tactic + val tclDO : int -> unit tactic -> unit tactic + val tclTIMEOUT : int -> unit tactic -> unit tactic + val tclTIME : string option -> 'a tactic -> 'a tactic + val tclOR : unit tactic -> unit tactic -> unit tactic + val tclONCE : unit tactic -> unit tactic + val tclEXACTLY_ONCE : unit tactic -> unit tactic + val tclIFCATCH : + unit tactic -> + (unit -> unit tactic) -> + (unit -> unit tactic) -> unit tactic + val tclSOLVE : unit tactic list -> unit tactic + val tclCOMPLETE : 'a tactic -> 'a tactic + val tclSELECT : Vernacexpr.goal_selector -> 'a tactic -> 'a tactic + val tclWITHHOLES : bool -> 'a tactic -> Evd.evar_map -> 'a tactic + val tclDELAYEDWITHHOLES : bool -> 'a Tactypes.delayed_open -> ('a -> unit tactic) -> unit tactic + val tclTHENLIST : unit tactic list -> unit tactic + val tclTHENLAST : unit tactic -> unit tactic -> unit tactic + val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic + val tclIDTAC : unit tactic + val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic + val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic + end end -module Declaremods : +module Hipattern : sig - val append_end_library_hook : (unit -> unit) -> unit + exception NoEquationFound + type 'a matching_function = Evd.evar_map -> EConstr.constr -> 'a option + type testing_function = Evd.evar_map -> EConstr.constr -> bool + val is_disjunction : ?strict:bool -> ?onlybinary:bool -> testing_function + val match_with_disjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function + val match_with_equality_type : (EConstr.constr * EConstr.constr list) matching_function + val is_empty_type : testing_function + val is_unit_type : testing_function + val is_unit_or_eq_type : testing_function + val is_conjunction : ?strict:bool -> ?onlybinary:bool -> testing_function + val match_with_conjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function + val match_with_imp_term : (EConstr.constr * EConstr.constr) matching_function + val match_with_forall_term : (Names.Name.t * EConstr.constr * EConstr.constr) matching_function + val match_with_nodep_ind : (EConstr.constr * EConstr.constr list * int) matching_function + val match_with_sigma_type : (EConstr.constr * EConstr.constr list) matching_function end -module Pfedit : +module Ind_tables : sig - val solve_by_implicit_tactic : unit -> Pretyping.inference_hook option - val refine_by_tactic : Environ.env -> Evd.evar_map -> EConstr.types -> unit Proofview.tactic -> - Term.constr * Evd.evar_map - val declare_implicit_tactic : unit Proofview.tactic -> unit - val clear_implicit_tactic : unit -> unit - val by : unit Proofview.tactic -> bool - val solve : ?with_end_tac:unit Proofview.tactic -> - Vernacexpr.goal_selector -> int option -> unit Proofview.tactic -> - Proof.proof -> Proof.proof * bool - val cook_proof : - unit -> (Names.Id.t * (Safe_typing.private_constants Entries.definition_entry * Proof_global.proof_universes * Decl_kinds.goal_kind)) - - val get_current_context : unit -> Evd.evar_map * Environ.env - - (* Deprecated *) - val delete_current_proof : unit -> unit - [@@ocaml.deprecated "use Proof_global.discard_current"] + type individual + type 'a scheme_kind - val get_current_proof_name : unit -> Names.Id.t - [@@ocaml.deprecated "use Proof_global.get_current_proof_name"] + val check_scheme : 'a scheme_kind -> Names.inductive -> bool + val find_scheme : ?mode:Declare.internal_flag -> 'a scheme_kind -> Names.inductive -> Names.Constant.t * Safe_typing.private_constants + val pr_scheme_kind : 'a scheme_kind -> Pp.t +end +module Elimschemes : +sig + val case_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind + val case_dep_scheme_kind_from_type_in_prop : Ind_tables.individual Ind_tables.scheme_kind + val case_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind + val case_dep_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind + val case_dep_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind end module Tactics : @@ -3981,7 +5061,8 @@ sig type change_arg = Pattern.patvar_map -> Evd.evar_map -> Evd.evar_map * EConstr.constr type tactic_reduction = Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr - type elim_scheme = Tactics.elim_scheme = + + type elim_scheme = { elimc: EConstr.constr Misctypes.with_bindings option; elimt: EConstr.types; @@ -4011,7 +5092,7 @@ sig val simplest_elim : EConstr.constr -> unit tactic val introf : unit tactic val cut : EConstr.types -> unit tactic - val convert_concl : ?check:bool -> EConstr.types -> Term.cast_kind -> unit tactic + val convert_concl : ?check:bool -> EConstr.types -> Constr.cast_kind -> unit tactic val intro_using : Names.Id.t -> unit tactic val intro : unit tactic val fresh_id_in_env : Names.Id.t list -> Names.Id.t -> Environ.env -> Names.Id.t @@ -4021,7 +5102,7 @@ sig val apply_with_delayed_bindings_gen : Misctypes.advanced_flag -> Misctypes.evars_flag -> (Misctypes.clear_flag * Tactypes.delayed_open_constr_with_bindings Loc.located) list -> unit Proofview.tactic val apply_delayed_in : - Misctypes.advanced_flag -> Misctypes.evars_flag -> Names.Id.t -> + Misctypes.advanced_flag -> Misctypes.evars_flag -> Names.Id.t -> (Misctypes.clear_flag * Tactypes.delayed_open_constr_with_bindings Loc.located) list -> Tactypes.intro_pattern option -> unit Proofview.tactic val elim : @@ -4086,8 +5167,8 @@ sig val generalize : EConstr.constr list -> unit Proofview.tactic val simplest_case : EConstr.constr -> unit Proofview.tactic val introduction : ?check:bool -> Names.Id.t -> unit Proofview.tactic - val convert_concl_no_check : EConstr.types -> Term.cast_kind -> unit Proofview.tactic - val reduct_in_concl : tactic_reduction * Term.cast_kind -> unit Proofview.tactic + val convert_concl_no_check : EConstr.types -> Constr.cast_kind -> unit Proofview.tactic + val reduct_in_concl : tactic_reduction * Constr.cast_kind -> unit Proofview.tactic val reduct_in_hyp : ?check:bool -> tactic_reduction -> Locus.hyp_location -> unit Proofview.tactic val convert_hyp_no_check : EConstr.named_declaration -> unit Proofview.tactic val reflexivity_red : bool -> unit Proofview.tactic @@ -4104,7 +5185,7 @@ sig (Locus.occurrences * Names.evaluable_global_reference) list -> unit Proofview.tactic val intros_using : Names.Id.t list -> unit Proofview.tactic val simpl_in_concl : unit Proofview.tactic - val reduct_option : ?check:bool -> tactic_reduction * Term.cast_kind -> Locus.goal_location -> unit Proofview.tactic + val reduct_option : ?check:bool -> tactic_reduction * Constr.cast_kind -> Locus.goal_location -> unit Proofview.tactic val simplest_split : unit Proofview.tactic val unfold_in_hyp : (Locus.occurrences * Names.evaluable_global_reference) list -> Locus.hyp_location -> unit Proofview.tactic @@ -4140,83 +5221,12 @@ sig end end -module Tacticals : +module Elim : sig - open Tacmach - val tclORELSE : tactic -> tactic -> tactic - val tclDO : int -> tactic -> tactic - val tclIDTAC : tactic - val tclFAIL : int -> Pp.std_ppcmds -> tactic - val tclTHEN : tactic -> tactic -> tactic - val tclTHENLIST : tactic list -> tactic - val pf_constr_of_global : - Globnames.global_reference -> (EConstr.constr -> Tacmach.tactic) -> Tacmach.tactic - val tclMAP : ('a -> tactic) -> 'a list -> tactic - val tclTRY : tactic -> tactic - val tclCOMPLETE : tactic -> tactic - val tclTHENS : tactic -> tactic list -> tactic - val tclFIRST : tactic list -> tactic - val tclTHENFIRST : tactic -> tactic -> tactic - val tclTHENLAST : tactic -> tactic -> tactic - val tclTHENSFIRSTn : tactic -> tactic array -> tactic -> tactic - val tclTHENSLASTn : tactic -> tactic -> tactic array -> tactic - val tclSOLVE : tactic list -> tactic - - val onClause : (Names.Id.t option -> tactic) -> Locus.clause -> tactic - val onAllHypsAndConcl : (Names.Id.t option -> tactic) -> tactic - val onLastHypId : (Names.Id.t -> tactic) -> tactic - val onNthHypId : int -> (Names.Id.t -> tactic) -> tactic - val onNLastHypsId : int -> (Names.Id.t list -> tactic) -> tactic - - val tclTHENSEQ : tactic list -> tactic - [@@ocaml.deprecated "alias of API.Tacticals.tclTHENLIST"] - - val nLastDecls : int -> Goal.goal Evd.sigma -> EConstr.named_context - - val tclTHEN_i : tactic -> (int -> tactic) -> tactic - - val tclPROGRESS : tactic -> tactic - - val elimination_sort_of_goal : Goal.goal Evd.sigma -> Sorts.family - - module New : - sig - open Proofview - val tclORELSE0 : unit tactic -> unit tactic -> unit tactic - val tclFAIL : int -> Pp.std_ppcmds -> 'a tactic - val pf_constr_of_global : Globnames.global_reference -> EConstr.constr tactic - val tclTHEN : unit tactic -> unit tactic -> unit tactic - val tclTHENS : unit tactic -> unit tactic list -> unit tactic - val tclFIRST : unit tactic list -> unit tactic - val tclZEROMSG : ?loc:Loc.t -> Pp.std_ppcmds -> 'a tactic - val tclORELSE : unit tactic -> unit tactic -> unit tactic - val tclREPEAT : unit tactic -> unit tactic - val tclTRY : unit tactic -> unit tactic - val tclTHENFIRST : unit tactic -> unit tactic -> unit tactic - val tclPROGRESS : unit Proofview.tactic -> unit Proofview.tactic - val tclTHENS3PARTS : unit tactic -> unit tactic array -> unit tactic -> unit tactic array -> unit tactic - val tclDO : int -> unit tactic -> unit tactic - val tclTIMEOUT : int -> unit tactic -> unit tactic - val tclTIME : string option -> 'a tactic -> 'a tactic - val tclOR : unit tactic -> unit tactic -> unit tactic - val tclONCE : unit tactic -> unit tactic - val tclEXACTLY_ONCE : unit tactic -> unit tactic - val tclIFCATCH : - unit tactic -> - (unit -> unit tactic) -> - (unit -> unit tactic) -> unit tactic - val tclSOLVE : unit tactic list -> unit tactic - val tclCOMPLETE : 'a tactic -> 'a tactic - val tclSELECT : Vernacexpr.goal_selector -> 'a tactic -> 'a tactic - val tclWITHHOLES : bool -> 'a tactic -> Evd.evar_map -> 'a tactic - val tclDELAYEDWITHHOLES : bool -> 'a Tactypes.delayed_open -> ('a -> unit tactic) -> unit tactic - val tclTHENLIST : unit tactic list -> unit tactic - val tclTHENLAST : unit tactic -> unit tactic -> unit tactic - val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic - val tclIDTAC : unit tactic - val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic - val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic - end + val h_decompose : Names.inductive list -> EConstr.constr -> unit Proofview.tactic + val h_double_induction : Misctypes.quantified_hypothesis -> Misctypes.quantified_hypothesis-> unit Proofview.tactic + val h_decompose_or : EConstr.constr -> unit Proofview.tactic + val h_decompose_and : EConstr.constr -> unit Proofview.tactic end module Equality : @@ -4260,14 +5270,15 @@ sig orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag -> ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr Misctypes.with_bindings -> Misctypes.evars_flag -> unit Proofview.tactic val subst : Names.Id.t list -> unit Proofview.tactic - type subst_tactic_flags = Equality.subst_tactic_flags = { + + type subst_tactic_flags = { only_leibniz : bool; rewrite_dependent_proof : bool } val subst_all : ?flags:subst_tactic_flags -> unit -> unit Proofview.tactic val general_rewrite_in : - orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag -> + orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag -> ?tac:(unit Proofview.tactic * conditions) -> Names.Id.t -> EConstr.constr -> Misctypes.evars_flag -> unit Proofview.tactic val general_setoid_rewrite_clause : @@ -4293,43 +5304,63 @@ sig val absurd : EConstr.constr -> unit Proofview.tactic end -module Clenv : +module Inv : sig - type hole = Clenv.hole = { - hole_evar : EConstr.constr; - hole_type : EConstr.types; - hole_deps : bool; - hole_name : Names.Name.t; - } - type clause = Clenv.clause = { - cl_holes : hole list; - cl_concl : EConstr.types; - } - val make_evar_clause : Environ.env -> Evd.evar_map -> ?len:int -> EConstr.types -> - (Evd.evar_map * clause) - val solve_evar_clause : Environ.env -> Evd.evar_map -> bool -> clause -> EConstr.constr Misctypes.bindings -> - Evd.evar_map - type clausenv = Clenv.clausenv - val pr_clenv : Clenv.clausenv -> Pp.std_ppcmds + val dinv : + Misctypes.inversion_kind -> EConstr.constr option -> + Tactypes.or_and_intro_pattern option -> Misctypes.quantified_hypothesis -> unit Proofview.tactic + val inv_clause : + Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option -> Names.Id.t list -> + Misctypes.quantified_hypothesis -> unit Proofview.tactic + val inv_clear_tac : Names.Id.t -> unit Proofview.tactic + val inv_tac : Names.Id.t -> unit Proofview.tactic + val dinv_tac : Names.Id.t -> unit Proofview.tactic + val dinv_clear_tac : Names.Id.t -> unit Proofview.tactic + val inv : Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option -> + Misctypes.quantified_hypothesis -> unit Proofview.tactic +end + +module Leminv : +sig + val lemInv_clause : + Misctypes.quantified_hypothesis -> EConstr.constr -> Names.Id.t list -> unit Proofview.tactic + val add_inversion_lemma_exn : + Names.Id.t -> Constrexpr.constr_expr -> Misctypes.glob_sort -> bool -> (Names.Id.t -> unit Proofview.tactic) -> + unit end module Hints : sig - type hint = Hints.hint - type debug = Hints.debug = - | Debug | Info | Off - type 'a hints_path_atom_gen = 'a Hints.hints_path_atom_gen = + + type raw_hint = EConstr.t * EConstr.types * Univ.universe_context_set + + type 'a hint_ast = + | Res_pf of 'a (* Hint Apply *) + | ERes_pf of 'a (* Hint EApply *) + | Give_exact of 'a + | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *) + | Unfold_nth of Names.evaluable_global_reference (* Hint Unfold *) + | Extern of Genarg.glob_generic_argument (* Hint Extern *) + + type hint + + type debug = + | Debug | Info | Off + + type 'a hints_path_atom_gen = | PathHints of 'a list | PathAny - type hint_term = Hints.hint_term = + + type hint_term = | IsGlobRef of Globnames.global_reference | IsConstr of EConstr.constr * Univ.ContextSet.t + type hint_db_name = string type hint_info = (Names.Id.t list * Pattern.constr_pattern) Vernacexpr.hint_info_gen type hnf = bool type hints_path_atom = Globnames.global_reference hints_path_atom_gen - type 'a hints_path_gen = 'a Hints.hints_path_gen = + type 'a hints_path_gen = | PathAtom of 'a hints_path_atom_gen | PathStar of 'a hints_path_gen | PathSeq of 'a hints_path_gen * 'a hints_path_gen @@ -4339,7 +5370,7 @@ sig type hints_path = Globnames.global_reference hints_path_gen - type hints_entry = Hints.hints_entry = + type hints_entry = | HintsResolveEntry of (hint_info * Decl_kinds.polymorphic * hnf * hints_path_atom * hint_term) list | HintsImmediateEntry of (hints_path_atom * Decl_kinds.polymorphic * hint_term) list | HintsCutEntry of hints_path @@ -4348,15 +5379,7 @@ sig | HintsModeEntry of Globnames.global_reference * Vernacexpr.hint_mode list | HintsExternEntry of hint_info * Genarg.glob_generic_argument - type 'a hint_ast = 'a Hints.hint_ast = - | Res_pf of 'a - | ERes_pf of 'a - | Give_exact of 'a - | Res_pf_THEN_trivial_fail of 'a - | Unfold_nth of Names.evaluable_global_reference - | Extern of Genarg.glob_generic_argument - type raw_hint = EConstr.constr * EConstr.types * Univ.ContextSet.t - type 'a with_metadata = 'a Hints.with_metadata = private { + type 'a with_metadata = private { pri : int; poly : Decl_kinds.polymorphic; pat : Pattern.constr_pattern option; @@ -4369,7 +5392,7 @@ sig module Hint_db : sig - type t = Hints.Hint_db.t + type t val empty : ?name:hint_db_name -> Names.transparent_state -> bool -> t val transparent_state : t -> Names.transparent_state val iter : (Globnames.global_reference option -> @@ -4377,21 +5400,23 @@ sig end type hint_db = Hint_db.t - val add_hints : Vernacexpr.locality_flag -> hint_db_name list -> hints_entry -> unit + val add_hints : bool -> hint_db_name list -> hints_entry -> unit val searchtable_map : hint_db_name -> hint_db - val pp_hints_path_atom : ('a -> Pp.std_ppcmds) -> 'a hints_path_atom_gen -> Pp.std_ppcmds - val pp_hints_path_gen : ('a -> Pp.std_ppcmds) -> 'a hints_path_gen -> Pp.std_ppcmds + val pp_hints_path_atom : ('a -> Pp.t) -> 'a hints_path_atom_gen -> Pp.t + val pp_hints_path_gen : ('a -> Pp.t) -> 'a hints_path_gen -> Pp.t val glob_hints_path_atom : - Prelude.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen - val pp_hints_path : hints_path -> Pp.std_ppcmds + Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen + val pp_hints_path : hints_path -> Pp.t val glob_hints_path : - Prelude.reference hints_path_gen -> Globnames.global_reference hints_path_gen + Libnames.reference hints_path_gen -> Globnames.global_reference hints_path_gen + val run_hint : hint -> + ((raw_hint * Clenv.clausenv) hint_ast -> 'r Proofview.tactic) -> 'r Proofview.tactic val typeclasses_db : hint_db_name val add_hints_init : (unit -> unit) -> unit val create_hint_db : bool -> hint_db_name -> Names.transparent_state -> bool -> unit val empty_hint_info : 'a Vernacexpr.hint_info_gen val repr_hint : hint -> (raw_hint * Clenv.clausenv) hint_ast - val pr_hint_db : Hint_db.t -> Pp.std_ppcmds + val pr_hint_db : Hint_db.t -> Pp.t end module Auto : @@ -4412,140 +5437,6 @@ sig val default_full_auto : unit Proofview.tactic end -module Hipattern : -sig - exception NoEquationFound - type 'a matching_function = Evd.evar_map -> EConstr.constr -> 'a option - type testing_function = Evd.evar_map -> EConstr.constr -> bool - val is_disjunction : ?strict:bool -> ?onlybinary:bool -> testing_function - val match_with_disjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function - val match_with_equality_type : (EConstr.constr * EConstr.constr list) matching_function - val is_empty_type : testing_function - val is_unit_type : testing_function - val is_unit_or_eq_type : testing_function - val is_conjunction : ?strict:bool -> ?onlybinary:bool -> testing_function - val match_with_conjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function - val match_with_imp_term : (EConstr.constr * EConstr.constr) matching_function - val match_with_forall_term : (Names.Name.t * EConstr.constr * EConstr.constr) matching_function - val match_with_nodep_ind : (EConstr.constr * EConstr.constr list * int) matching_function - val match_with_sigma_type : (EConstr.constr * EConstr.constr list) matching_function -end - -module Inv : -sig - val dinv : - Misctypes.inversion_kind -> EConstr.constr option -> - Tactypes.or_and_intro_pattern option -> Misctypes.quantified_hypothesis -> unit Proofview.tactic - val inv_clause : - Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option -> Names.Id.t list -> - Misctypes.quantified_hypothesis -> unit Proofview.tactic - val inv_clear_tac : Names.Id.t -> unit Proofview.tactic - val inv_tac : Names.Id.t -> unit Proofview.tactic - val dinv_tac : Names.Id.t -> unit Proofview.tactic - val dinv_clear_tac : Names.Id.t -> unit Proofview.tactic - val inv : Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option -> - Misctypes.quantified_hypothesis -> unit Proofview.tactic -end - -module Leminv : -sig - val lemInv_clause : - Misctypes.quantified_hypothesis -> EConstr.constr -> Names.Id.t list -> unit Proofview.tactic - val add_inversion_lemma_exn : - Names.Id.t -> Constrexpr.constr_expr -> Misctypes.glob_sort -> bool -> (Names.Id.t -> unit Proofview.tactic) -> - unit -end - -module Vernacentries : -sig - val dump_global : Prelude.reference Misctypes.or_by_notation -> unit - val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr -> - Evd.evar_map * Redexpr.red_expr) Hook.t - val command_focus : unit Proof.focus_kind -end - -module Evar_refiner : -sig - val w_refine : Evar.t * Evd.evar_info -> - Pretyping.glob_constr_ltac_closure -> Evd.evar_map -> Evd.evar_map -end - -module Obligations : -sig - val default_tactic : unit Proofview.tactic ref - val obligation : int * Names.Id.t option * Constrexpr.constr_expr option -> - Genarg.glob_generic_argument option -> unit - val next_obligation : Names.Id.t option -> Genarg.glob_generic_argument option -> unit - val try_solve_obligation : int -> Names.Id.t option -> unit Proofview.tactic option -> unit - val try_solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> unit - val solve_all_obligations : unit Proofview.tactic option -> unit - val admit_obligations : Names.Id.t option -> unit - val show_obligations : ?msg:bool -> Names.Id.t option -> unit - val show_term : Names.Id.t option -> Pp.std_ppcmds -end - -module Elim : -sig - val h_decompose : Names.inductive list -> EConstr.constr -> unit Proofview.tactic - val h_double_induction : Misctypes.quantified_hypothesis -> Misctypes.quantified_hypothesis-> unit Proofview.tactic - val h_decompose_or : EConstr.constr -> unit Proofview.tactic - val h_decompose_and : EConstr.constr -> unit Proofview.tactic -end - -module Redops : -sig - val all_flags : 'a Genredexpr.glob_red_flag - val make_red_flag : 'a Genredexpr.red_atom list -> 'a Genredexpr.glob_red_flag -end - -module Autorewrite : -sig - type rew_rule = { rew_lemma: Term.constr; - rew_type: Term.types; - rew_pat: Term.constr; - rew_ctx: Univ.ContextSet.t; - rew_l2r: bool; - rew_tac: Genarg.glob_generic_argument option } - type raw_rew_rule = (Term.constr Univ.in_universe_context_set * bool * - Genarg.raw_generic_argument option) - Loc.located - val auto_multi_rewrite : ?conds:Equality.conditions -> string list -> Locus.clause -> unit Proofview.tactic - val auto_multi_rewrite_with : ?conds:Equality.conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic - val add_rew_rules : string -> raw_rew_rule list -> unit - val find_rewrites : string -> rew_rule list - val find_matches : string -> Term.constr -> rew_rule list - val print_rewrite_hintdb : string -> Pp.std_ppcmds -end - -module Refine : -sig - val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit Proofview.tactic - val solve_constraints : unit Proofview.tactic -end - -module Find_subterm : -sig - val error_invalid_occurrence : int list -> 'a -end - -module Vernac_classifier : -sig - val declare_vernac_classifier : - Vernacexpr.extend_name -> (Genarg.raw_generic_argument list -> unit -> Vernacexpr.vernac_classification) -> unit - val classify_as_proofstep : Vernacexpr.vernac_classification - val classify_as_query : Vernacexpr.vernac_classification - val classify_as_sideeff : Vernacexpr.vernac_classification - val classify_vernac : Vernacexpr.vernac_expr -> Vernacexpr.vernac_classification -end - -module Keys : -sig - type key = Keys.key - val constr_key : ('a -> ('a, 't, 'u, 'i) Term.kind_of_term) -> 'a -> key option - val declare_equiv_keys : key -> key -> unit - val pr_keys : (Globnames.global_reference -> Pp.std_ppcmds) -> Pp.std_ppcmds -end - module Eauto : sig val e_assumption : unit Proofview.tactic @@ -4557,14 +5448,16 @@ sig val autounfold_tac : Hints.hint_db_name list option -> Locus.clause -> unit Proofview.tactic val autounfold_one : Hints.hint_db_name list -> Locus.hyp_location option -> unit Proofview.tactic val eauto_with_bases : - ?debug:Hints.debug -> bool * int -> Tactypes.delayed_open_constr list -> Hints.hint_db list -> Tacmach.tactic + ?debug:Hints.debug -> bool * int -> Tactypes.delayed_open_constr list -> Hints.hint_db list -> Proof_type.tactic end module Class_tactics : sig - type search_strategy = Class_tactics.search_strategy = + + type search_strategy = | Dfs | Bfs + val set_typeclasses_debug : bool -> unit val set_typeclasses_strategy : search_strategy -> unit val set_typeclasses_depth : int option -> unit @@ -4578,34 +5471,56 @@ sig val catchable : exn -> bool end -module Ind_tables : +module Eqdecide : sig - type individual = Ind_tables.individual - type 'a scheme_kind = 'a Ind_tables.scheme_kind + val compare : EConstr.constr -> EConstr.constr -> unit Proofview.tactic + val decideEqualityGoal : unit Proofview.tactic +end - val check_scheme : 'a scheme_kind -> Names.inductive -> bool - val find_scheme : ?mode:Declare.internal_flag -> 'a scheme_kind -> Names.inductive -> Names.Constant.t * Safe_typing.private_constants - val pr_scheme_kind : 'a scheme_kind -> Pp.std_ppcmds +module Autorewrite : +sig + type rew_rule = { rew_lemma: Constr.t; + rew_type: Term.types; + rew_pat: Constr.t; + rew_ctx: Univ.ContextSet.t; + rew_l2r: bool; + rew_tac: Genarg.glob_generic_argument option } + type raw_rew_rule = (Constr.t Univ.in_universe_context_set * bool * + Genarg.raw_generic_argument option) + Loc.located + val auto_multi_rewrite : ?conds:Equality.conditions -> string list -> Locus.clause -> unit Proofview.tactic + val auto_multi_rewrite_with : ?conds:Equality.conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic + val add_rew_rules : string -> raw_rew_rule list -> unit + val find_rewrites : string -> rew_rule list + val find_matches : string -> Constr.t -> rew_rule list + val print_rewrite_hintdb : string -> Pp.t end -module Elimschemes : +(************************************************************************) +(* End of modules from tactics/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from vernac/ *) +(************************************************************************) + +module Ppvernac : sig - val case_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind - val case_dep_scheme_kind_from_type_in_prop : Ind_tables.individual Ind_tables.scheme_kind - val case_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind - val case_dep_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind - val case_dep_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind + val pr_vernac : Vernacexpr.vernac_expr -> Pp.t + val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.t end module Lemmas : sig - type 'a declaration_hook = 'a Lemmas.declaration_hook + + type 'a declaration_hook + val mk_hook : (Decl_kinds.locality -> Globnames.global_reference -> 'a) -> 'a declaration_hook val start_proof : Names.Id.t -> ?pl:Proof_global.universe_binders -> Decl_kinds.goal_kind -> Evd.evar_map -> ?terminator:(Proof_global.lemma_possible_guards -> unit declaration_hook -> Proof_global.proof_terminator) -> ?sign:Environ.named_context_val -> EConstr.types -> - ?init_tac:unit Proofview.tactic -> ?compute_guard:Proof_global.lemma_possible_guards -> + ?init_tac:unit Proofview.tactic -> ?compute_guard:Proof_global.lemma_possible_guards -> unit declaration_hook -> unit val call_hook : Future.fix_exn -> 'a declaration_hook -> Decl_kinds.locality -> Globnames.global_reference -> 'a @@ -4613,152 +5528,94 @@ sig val get_current_context : unit -> Evd.evar_map * Environ.env end -module Eqdecide : +module Himsg : sig - val compare : EConstr.constr -> EConstr.constr -> unit Proofview.tactic - val decideEqualityGoal : unit Proofview.tactic + val explain_refiner_error : Logic.refiner_error -> Pp.t + val explain_pretype_error : Environ.env -> Evd.evar_map -> Pretype_errors.pretype_error -> Pp.t end -module Locusops : +module ExplainErr : sig - val clause_with_generic_occurrences : 'a Locus.clause_expr -> bool - val nowhere : 'a Locus.clause_expr - val allHypsAndConcl : 'a Locus.clause_expr - val is_nowhere : 'a Locus.clause_expr -> bool - val occurrences_map : - ('a list -> 'b list) -> 'a Locus.occurrences_gen -> 'b Locus.occurrences_gen - val convert_occs : Locus.occurrences -> bool * int list - val onConcl : 'a Locus.clause_expr - val onHyp : 'a -> 'a Locus.clause_expr + val process_vernac_interp_error : ?allow_uncaught:bool -> Util.iexn -> Util.iexn + val register_additional_error_info : (Util.iexn -> Pp.t option Loc.located option) -> unit end -module Topfmt : +module Locality : sig - val std_ft : Format.formatter ref - val with_output_to : out_channel -> Format.formatter - val get_margin : unit -> int option + val make_section_locality : bool option -> bool + module LocalityFixme : sig + val consume : unit -> bool option + end + val make_module_locality : bool option -> bool end -module Nameops : +module Metasyntax : sig - val atompart_of_id : Names.Id.t -> string - val pr_id : Names.Id.t -> Pp.std_ppcmds - [@@ocaml.deprecated "alias of API.Names.Id.print"] + val add_token_obj : string -> unit - val pr_name : Names.Name.t -> Pp.std_ppcmds - [@@ocaml.deprecated "alias of API.Names.Name.print"] + type any_entry = AnyEntry : 'a Pcoq.Gram.entry -> any_entry + val register_grammar : string -> any_entry list -> unit - val name_fold : (Names.Id.t -> 'a -> 'a) -> Names.Name.t -> 'a -> 'a - val name_app : (Names.Id.t -> Names.Id.t) -> Names.Name.t -> Names.Name.t - val add_suffix : Names.Id.t -> string -> Names.Id.t - val increment_subscript : Names.Id.t -> Names.Id.t - val make_ident : string -> int option -> Names.Id.t - val out_name : Names.Name.t -> Names.Id.t - val pr_lab : Names.Label.t -> Pp.std_ppcmds - module Name : - sig - include module type of struct include Names.Name end - val get_id : t -> Names.Id.t - val fold_right : (Names.Id.t -> 'a -> 'a) -> t -> 'a -> 'a - end end -module Declareops : +module Search : sig - val constant_has_body : Declarations.constant_body -> bool - val is_opaque : Declarations.constant_body -> bool - val eq_recarg : Declarations.recarg -> Declarations.recarg -> bool - val body_of_constant : - Opaqueproof.opaquetab -> Declarations.constant_body -> Term.constr option + type glob_search_about_item = + | GlobSearchSubPattern of Pattern.constr_pattern + | GlobSearchString of string + type filter_function = Globnames.global_reference -> Environ.env -> Constr.t -> bool + type display_function = Globnames.global_reference -> Environ.env -> Constr.t -> unit + val search_about_filter : glob_search_about_item -> filter_function + val module_filter : Names.DirPath.t list * bool -> filter_function + val generic_search : int option -> display_function -> unit end -module Constr : +module Obligations : sig - type t = Term.constr - [@@ocaml.deprecated "alias of API.Term.constr"] - - type constr = Term.constr - [@@ocaml.deprecated "alias of API.Term.constr"] - - type types = Term.constr - [@@ocaml.deprecated "alias of API.Term.types"] - - type cast_kind = Term.cast_kind = - | VMcast - | NATIVEcast - | DEFAULTcast - | REVERTcast - type ('constr, 'types, 'sort, 'univs) kind_of_term = ('constr, 'types, 'sort, 'univs) Term.kind_of_term = - | Rel of int - | Var of Names.Id.t - | Meta of Term.metavariable - | Evar of 'constr Term.pexistential - | Sort of 'sort - | Cast of 'constr * cast_kind * 'types - | Prod of Names.Name.t * 'types * 'types - | Lambda of Names.Name.t * 'types * 'constr - | LetIn of Names.Name.t * 'constr * 'types * 'constr - | App of 'constr * 'constr array - | Const of (Names.Constant.t * 'univs) - | Ind of (Names.inductive * 'univs) - | Construct of (Names.constructor * 'univs) - | Case of Term.case_info * 'constr * 'constr * 'constr array - | Fix of ('constr, 'types) Term.pfixpoint - | CoFix of ('constr, 'types) Term.pcofixpoint - | Proj of Names.Projection.t * 'constr - [@@ocaml.deprecated "alias of API.Term.cast_kind"] - - val equal : Term.constr -> Term.constr -> bool - [@@ocaml.deprecated "alias of API.Term.eq_constr"] - - val mkIndU : Term.pinductive -> Term.constr - [@@ocaml.deprecated "alias of API.Term.mkIndU"] - - val mkConstU : Term.pconstant -> Term.constr - [@@ocaml.deprecated "alias of API.Term.mkConstU"] - - val mkConst : Names.Constant.t -> Term.constr - [@@ocaml.deprecated "alias of API.Term.mkConst"] - - val mkVar : Names.Id.t -> Term.constr - [@@ocaml.deprecated "alias of API.Term.mkVar"] - - val compare : Term.constr -> Term.constr -> int - [@@ocaml.deprecated "alias of API.Term.constr_ord"] - - val mkApp : Term.constr * Term.constr array -> Term.constr - [@@ocaml.deprecated "alias of API.Term.mkApp"] + val default_tactic : unit Proofview.tactic ref + val obligation : int * Names.Id.t option * Constrexpr.constr_expr option -> + Genarg.glob_generic_argument option -> unit + val next_obligation : Names.Id.t option -> Genarg.glob_generic_argument option -> unit + val try_solve_obligation : int -> Names.Id.t option -> unit Proofview.tactic option -> unit + val try_solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> unit + val solve_all_obligations : unit Proofview.tactic option -> unit + val admit_obligations : Names.Id.t option -> unit + val show_obligations : ?msg:bool -> Names.Id.t option -> unit + val show_term : Names.Id.t option -> Pp.t end -[@@ocaml.deprecated "alias of API.Term"] -module Coq_config : +module Command : sig - val exec_extension : string -end + open Names + open Constrexpr + open Vernacexpr + + type structured_fixpoint_expr = { + fix_name : Id.t; + fix_univs : lident list option; + fix_annot : Id.t Loc.located option; + fix_binders : local_binder_expr list; + fix_body : constr_expr option; + fix_type : constr_expr + } -module Kindops : -sig - val logical_kind_of_goal_kind : Decl_kinds.goal_object_kind -> Decl_kinds.logical_kind -end + type structured_one_inductive_expr = { + ind_name : Id.t; + ind_univs : lident list option; + ind_arity : constr_expr; + ind_lc : (Id.t * constr_expr) list + } -module States : -sig - val with_state_protection_on_exception : ('a -> 'b) -> 'a -> 'b - val with_state_protection : ('a -> 'b) -> 'a -> 'b -end + type structured_inductive_expr = + local_binder_expr list * structured_one_inductive_expr list -module Command : -sig - type structured_fixpoint_expr = Command.structured_fixpoint_expr - type recursive_preentry = Names.Id.t list * Term.constr option list * Term.types list - type structured_inductive_expr = Command.structured_inductive_expr - type one_inductive_impls = Command.one_inductive_impls + type recursive_preentry = Names.Id.t list * Constr.t option list * Constr.types list + + type one_inductive_impls val do_mutual_inductive : - (Vernacexpr.one_inductive_expr * Vernacexpr.decl_notation list) list -> - Decl_kinds.cumulative_inductive_flag -> - Decl_kinds.polymorphic -> + (Vernacexpr.one_inductive_expr * Vernacexpr.decl_notation list) list -> Decl_kinds.cumulative_inductive_flag -> Decl_kinds.polymorphic -> Decl_kinds.private_flag -> Decl_kinds.recursivity_kind -> unit val do_definition : Names.Id.t -> Decl_kinds.definition_kind -> Vernacexpr.lident list option -> @@ -4774,7 +5631,7 @@ sig val interp_fixpoint : structured_fixpoint_expr list -> Vernacexpr.decl_notation list -> - recursive_preentry * Vernacexpr.lident list option * UState.t * + recursive_preentry * Vernacexpr.lident list option * UState.t * (EConstr.rel_context * Impargs.manual_implicits * int option) list val extract_mutual_inductive_declaration_components : @@ -4793,14 +5650,108 @@ sig Names.MutInd.t end -module Ppvernac : +module Classes : sig - val pr_vernac : Vernacexpr.vernac_expr -> Pp.std_ppcmds - val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.std_ppcmds + val set_typeclass_transparency : Names.evaluable_global_reference -> bool -> bool -> unit + val new_instance : + ?abstract:bool -> + ?global:bool -> + ?refine:bool -> + Decl_kinds.polymorphic -> + Constrexpr.local_binder_expr list -> + Constrexpr.typeclass_constraint -> + (bool * Constrexpr.constr_expr) option -> + ?generalize:bool -> + ?tac:unit Proofview.tactic -> + ?hook:(Globnames.global_reference -> unit) -> + Vernacexpr.hint_info_expr -> + Names.Id.t end -module Topconstr : +module Vernacinterp : sig - val replace_vars_constr_expr : - Names.Id.t Names.Id.Map.t -> Constrexpr.constr_expr -> Constrexpr.constr_expr + type deprecation = bool + + type vernac_command = Genarg.raw_generic_argument list -> unit -> unit + + val vinterp_add : deprecation -> Vernacexpr.extend_name -> + vernac_command -> unit + +end + +module Mltop : +sig + val declare_cache_obj : (unit -> unit) -> string -> unit + val add_known_plugin : (unit -> unit) -> string -> unit + val add_known_module : string -> unit + val module_is_known : string -> bool +end + +module Topfmt : +sig + val std_ft : Format.formatter ref + val with_output_to : out_channel -> Format.formatter + val get_margin : unit -> int option +end + +module Vernacentries : +sig + val dump_global : Libnames.reference Misctypes.or_by_notation -> unit + val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr -> + Evd.evar_map * Redexpr.red_expr) Hook.t + val command_focus : unit Proof.focus_kind end + +(************************************************************************) +(* End of modules from vernac/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from stm/ *) +(************************************************************************) + +module Vernac_classifier : +sig + val declare_vernac_classifier : + Vernacexpr.extend_name -> (Genarg.raw_generic_argument list -> unit -> Vernacexpr.vernac_classification) -> unit + val classify_as_proofstep : Vernacexpr.vernac_classification + val classify_as_query : Vernacexpr.vernac_classification + val classify_as_sideeff : Vernacexpr.vernac_classification + val classify_vernac : Vernacexpr.vernac_expr -> Vernacexpr.vernac_classification +end + +module Stm : +sig + type state + val state_of_id : + Stateid.t -> [ `Valid of state option | `Expired | `Error of exn ] +end + +(************************************************************************) +(* End of modules from stm/ *) +(************************************************************************) + +(************************************************************************) +(* Modules from highparsing/ *) +(************************************************************************) + +module G_vernac : +sig + + val def_body : Vernacexpr.definition_expr Pcoq.Gram.entry + val section_subset_expr : Vernacexpr.section_subset_expr Pcoq.Gram.entry + val query_command : (Vernacexpr.goal_selector option -> Vernacexpr.vernac_expr) Pcoq.Gram.entry + +end + +module G_proofs : +sig + + val hint : Vernacexpr.hints_expr Pcoq.Gram.entry + val hint_proof_using : 'a Pcoq.Gram.entry -> 'a option -> 'a option + +end + +(************************************************************************) +(* End of modules from highparsing/ *) +(************************************************************************) diff --git a/API/API.mllib b/API/API.mllib index f4bdf83db7..25275c7046 100644 --- a/API/API.mllib +++ b/API/API.mllib @@ -1,2 +1 @@ API -Grammar_API diff --git a/API/grammar_API.ml b/API/grammar_API.ml deleted file mode 100644 index 2f3da8d984..0000000000 --- a/API/grammar_API.ml +++ /dev/null @@ -1,63 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -module G_proofs = G_proofs -module Metasyntax = Metasyntax -module Egramcoq = Egramcoq -module G_vernac = G_vernac -module Pcoq = Pcoq -module Tok = Tok -module CLexer = CLexer -module Egramml = Egramml -module Mltop = Mltop -module Vernacinterp = Vernacinterp -module Genintern = Genintern - -module Extend = - struct - type 'a entry = 'a Extend.entry - type ('self, 'a) symbol = ('self, 'a) Extend.symbol = - | Atoken : Tok.t -> ('self, string) symbol - | Alist1 : ('self, 'a) symbol -> ('self, 'a list) symbol - | Alist1sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol - | Alist0 : ('self, 'a) symbol -> ('self, 'a list) symbol - | Alist0sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol - | Aopt : ('self, 'a) symbol -> ('self, 'a option) symbol - | Aself : ('self, 'self) symbol - | Anext : ('self, 'self) symbol - | Aentry : 'a entry -> ('self, 'a) symbol - | Aentryl : 'a entry * int -> ('self, 'a) symbol - | Arules : 'a rules list -> ('self, 'a) symbol - and ('self, 'a, 'r) rule = ('self, 'a, 'r) Extend.rule = - | Stop : ('self, 'r, 'r) rule - | Next : ('self, 'a, 'r) rule * ('self, 'b) symbol -> ('self, 'b -> 'a, 'r) rule - and ('a, 'r) norec_rule = ('a, 'r) Extend.norec_rule = - { norec_rule : 's. ('s, 'a, 'r) rule } - and 'a rules = 'a Extend.rules = - | Rules : ('act, Loc.t -> 'a) norec_rule * 'act -> 'a rules - type gram_assoc = Extend.gram_assoc = NonA | RightA | LeftA - type 'a production_rule = 'a Extend.production_rule = - | Rule : ('a, 'act, Loc.t -> 'a) rule * 'act -> 'a production_rule - type 'a single_extend_statment = string option * gram_assoc option * 'a production_rule list - type gram_position = Extend.gram_position = - | First - | Last - | Before of string - | After of string - | Level of string - type 'a extend_statment = Extend.gram_position option * 'a single_extend_statment list - - type 'a user_symbol = 'a Extend.user_symbol = - | Ulist1 of 'a user_symbol - | Ulist1sep of 'a user_symbol * string - | Ulist0 of 'a user_symbol - | Ulist0sep of 'a user_symbol * string - | Uopt of 'a user_symbol - | Uentry of 'a - | Uentryl of 'a * int - end diff --git a/API/grammar_API.mli b/API/grammar_API.mli deleted file mode 100644 index c643f09086..0000000000 --- a/API/grammar_API.mli +++ /dev/null @@ -1,249 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) -(* \VV/ **************************************************************) -(* // * This file is distributed under the terms of the *) -(* * GNU Lesser General Public License Version 2.1 *) -(************************************************************************) - -module Extend : -sig - type 'a entry = 'a Pcoq.Gram.Entry.e - type ('self, 'a) symbol = ('self, 'a) Extend.symbol = - | Atoken : Tok.t -> ('self, string) symbol - | Alist1 : ('self, 'a) symbol -> ('self, 'a list) symbol - | Alist1sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol - | Alist0 : ('self, 'a) symbol -> ('self, 'a list) symbol - | Alist0sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol - | Aopt : ('self, 'a) symbol -> ('self, 'a option) symbol - | Aself : ('self, 'self) symbol - | Anext : ('self, 'self) symbol - | Aentry : 'a entry -> ('self, 'a) symbol - | Aentryl : 'a entry * int -> ('self, 'a) symbol - | Arules : 'a rules list -> ('self, 'a) symbol - and ('self, 'a, 'r) rule = ('self, 'a, 'r) Extend.rule = - | Stop : ('self, 'r, 'r) rule - | Next : ('self, 'a, 'r) rule * ('self, 'b) symbol -> ('self, 'b -> 'a, 'r) rule - and ('a, 'r) norec_rule = ('a, 'r) Extend.norec_rule = - { norec_rule : 's. ('s, 'a, 'r) rule } - and 'a rules = 'a Extend.rules = - | Rules : ('act, Loc.t -> 'a) norec_rule * 'act -> 'a rules - type gram_assoc = Extend.gram_assoc = NonA | RightA | LeftA - type 'a production_rule = 'a Extend.production_rule = - | Rule : ('a, 'act, Loc.t -> 'a) rule * 'act -> 'a production_rule - type 'a single_extend_statment = string option * gram_assoc option * 'a production_rule list - type gram_position = Extend.gram_position = - | First - | Last - | Before of string - | After of string - | Level of string - type 'a extend_statment = gram_position option * 'a single_extend_statment list - type 'a user_symbol = 'a Extend.user_symbol = - | Ulist1 of 'a user_symbol - | Ulist1sep of 'a user_symbol * string - | Ulist0 of 'a user_symbol - | Ulist0sep of 'a user_symbol * string - | Uopt of 'a user_symbol - | Uentry of 'a - | Uentryl of 'a * int -end - -module Genintern : -sig - open API - module Store : module type of struct include Genintern.Store end - type glob_sign = Genintern.glob_sign = - { ltacvars : Names.Id.Set.t; - genv : Environ.env; - extra : Store.t } - type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb - type 'glb subst_fun = Mod_subst.substitution -> 'glb -> 'glb - type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Names.Id.Map.t -> 'glb -> 'glb - val empty_glob_sign : Environ.env -> glob_sign - val register_intern0 : ('raw, 'glb, 'top) Genarg.genarg_type -> - ('raw, 'glb) intern_fun -> unit - val register_subst0 : ('raw, 'glb, 'top) Genarg.genarg_type -> - 'glb subst_fun -> unit - val register_ntn_subst0 : ('raw, 'glb, 'top) Genarg.genarg_type -> - 'glb ntn_subst_fun -> unit - val generic_substitute : Genarg.glob_generic_argument subst_fun - val generic_intern : (Genarg.raw_generic_argument, Genarg.glob_generic_argument) intern_fun -end - -module Tok : -sig - type t = Tok.t = - | KEYWORD of string - | PATTERNIDENT of string - | IDENT of string - | FIELD of string - | INT of string - | STRING of string - | LEFTQMARK - | BULLET of string - | EOI -end - -module Pcoq : -sig - type gram_universe = Pcoq.gram_universe - module Gram : - sig - type te = Tok.t - module Entry : - sig - type 'a e = 'a Extend.entry - val of_parser : string -> (te Stream.t -> 'a) -> 'a e - val obj : 'a e -> te Gramext.g_entry - val create : string -> 'a e - end - type 'a entry = 'a Entry.e - val extend : 'a Pcoq.Gram.Entry.e -> Gramext.position option -> - (string option * Gramext.g_assoc option * - (Tok.t Gramext.g_symbol list * Gramext.g_action) list) list -> unit - val entry_create : string -> 'a Entry.e - end - module Prim : sig - open Names - open Loc - val preident : string Gram.Entry.e - val ident : Names.Id.t Gram.Entry.e - val name : Name.t located Gram.Entry.e - val identref : Names.Id.t located Gram.Entry.e - val pidentref : (Names.Id.t located * (Names.Id.t located list) option) Gram.Entry.e - val pattern_ident : Names.Id.t Gram.Entry.e - val pattern_identref : Names.Id.t located Gram.Entry.e - val base_ident : Names.Id.t Gram.Entry.e - val natural : int Gram.Entry.e - val bigint : Constrexpr.raw_natural_number Gram.Entry.e - val integer : int Gram.Entry.e - val string : string Gram.Entry.e - val qualid : API.Libnames.qualid located Gram.Entry.e - val fullyqualid : Names.Id.t list located Gram.Entry.e - val reference : API.Libnames.reference Gram.Entry.e - val by_notation : (string * string option) Loc.located Gram.entry - val smart_global : API.Libnames.reference API.Misctypes.or_by_notation Gram.Entry.e - val dirpath : DirPath.t Gram.Entry.e - val ne_string : string Gram.Entry.e - val ne_lstring : string located Gram.Entry.e - val var : Names.Id.t located Gram.Entry.e - end - - val eoi_entry : 'a Gram.Entry.e -> 'a Gram.Entry.e - val create_generic_entry : gram_universe -> string -> - ('a, Genarg.rlevel) Genarg.abstract_argument_type -> 'a Gram.Entry.e - val utactic : gram_universe - type gram_reinit = Extend.gram_assoc * Extend.gram_position - val grammar_extend : 'a Gram.Entry.e -> gram_reinit option -> - 'a Extend.extend_statment -> unit - val genarg_grammar : ('raw, 'glb, 'top) Genarg.genarg_type -> 'raw Gram.Entry.e - val register_grammar : ('raw, 'glb, 'top) Genarg.genarg_type -> 'raw Gram.Entry.e -> unit - module Constr : - sig - val sort : API.Misctypes.glob_sort Gram.Entry.e - val lconstr : API.Constrexpr.constr_expr Gram.Entry.e - val lconstr_pattern : API.Constrexpr.constr_expr Gram.Entry.e - val ident : API.Names.Id.t Gram.Entry.e - val constr : API.Constrexpr.constr_expr Gram.Entry.e - val closed_binder : API.Constrexpr.local_binder_expr list Gram.Entry.e - val constr_pattern : API.Constrexpr.constr_expr Gram.Entry.e - val global : API.Libnames.reference Gram.Entry.e - val binder_constr : API.Constrexpr.constr_expr Gram.Entry.e - val operconstr : API.Constrexpr.constr_expr Gram.Entry.e - val pattern : API.Constrexpr.cases_pattern_expr Gram.Entry.e - val binders : API.Constrexpr.local_binder_expr list Gram.Entry.e - end - module Vernac_ : - sig - val gallina : API.Vernacexpr.vernac_expr Gram.Entry.e - val gallina_ext : API.Vernacexpr.vernac_expr Gram.Entry.e - val red_expr : API.Genredexpr.raw_red_expr Gram.Entry.e - val noedit_mode : API.Vernacexpr.vernac_expr Gram.Entry.e - val command : API.Vernacexpr.vernac_expr Gram.Entry.e - val rec_definition : (API.Vernacexpr.fixpoint_expr * API.Vernacexpr.decl_notation list) Gram.Entry.e - val vernac : API.Vernacexpr.vernac_expr Gram.Entry.e - end - - type extend_rule = - | ExtendRule : 'a Gram.Entry.e * gram_reinit option * 'a Extend.extend_statment -> extend_rule - - module GramState : module type of struct include Pcoq.GramState end - type 'a grammar_command = 'a Pcoq.grammar_command - type 'a grammar_extension = 'a -> GramState.t -> extend_rule list * GramState.t - val create_grammar_command : string -> 'a grammar_extension -> 'a grammar_command - val extend_grammar_command : 'a grammar_command -> 'a -> unit - val epsilon_value : ('a -> 'self) -> ('self, 'a) Extend.symbol -> 'self option - val parse_string : 'a Gram.Entry.e -> string -> 'a - val (!@) : Ploc.t -> Loc.t - val set_command_entry : API.Vernacexpr.vernac_expr Gram.Entry.e -> unit - val to_coqloc : Ploc.t -> Loc.t -end - -module CLexer : -sig - type keyword_state = CLexer.keyword_state - val terminal : string -> Tok.t - val add_keyword : string -> unit - val is_keyword : string -> bool - val check_ident : string -> unit - val get_keyword_state : unit -> keyword_state - val set_keyword_state : keyword_state -> unit -end - -module Egramml : -sig - type 's grammar_prod_item = 's Egramml.grammar_prod_item = - | GramTerminal of string - | GramNonTerminal : ('a Genarg.raw_abstract_argument_type option * - ('s, 'a) Extend.symbol) Loc.located -> 's grammar_prod_item - - - val extend_vernac_command_grammar : - API.Vernacexpr.extend_name -> Vernacexpr.vernac_expr Pcoq.Gram.Entry.e option -> - Vernacexpr.vernac_expr grammar_prod_item list -> unit - - val make_rule : - (Loc.t -> Genarg.raw_generic_argument list -> 'a) -> - 'a grammar_prod_item list -> 'a Extend.production_rule -end - -module Mltop : -sig - val add_known_module : string -> unit - val module_is_known : string -> bool - val declare_cache_obj : (unit -> unit) -> string -> unit -end -module Vernacinterp : -sig - type deprecation = bool - type vernac_command = Genarg.raw_generic_argument list -> unit -> unit - val vinterp_add : deprecation -> API.Vernacexpr.extend_name -> - vernac_command -> unit -end - -module G_vernac : -sig - val def_body : API.Vernacexpr.definition_expr Pcoq.Gram.Entry.e - val section_subset_expr : API.Vernacexpr.section_subset_expr Pcoq.Gram.Entry.e - val query_command : (Vernacexpr.goal_selector option -> Vernacexpr.vernac_expr) - Pcoq.Gram.Entry.e -end - -module G_proofs : -sig - val hint : Vernacexpr.hints_expr Pcoq.Gram.Entry.e - val hint_proof_using : 'a Pcoq.Gram.Entry.e -> 'a option -> 'a option -end - -module Egramcoq : -sig -end - -module Metasyntax : -sig - type any_entry = Metasyntax.any_entry = - | AnyEntry : 'a Pcoq.Gram.Entry.e -> any_entry - val register_grammar : string -> any_entry list -> unit - val add_token_obj : string -> unit -end @@ -1,3 +1,10 @@ +To be inserted at the proper place: + +Notations + +- Recursive notations with the recursive pattern repeating on the + right (e.g. "( x ; .. ; y ; z )") now supported. + Changes beyond V8.6 =================== @@ -6,6 +13,17 @@ Tactics - New tactic "extensionality in H" which applies (possibly dependent) functional extensionality in H supposed to be a quantified equality until giving a bare equality. +- New tactic "inversion_sigma" which turns equalities of dependent + pairs (e.g., "existT P x p = existT P y q", frequently left over by + "inversion" on a dependent type family) into pairs of equalities + (e.g., a hypothesis "H : x = y" and a hypothesis of type "rew H in p + = q"); these hypotheses can subsequently be simplified using + "subst", without ever invoking any kind of axiom asserting + uniqueness of identity proofs. If you want to explicitly specify the + hypothesis to be inverted, or name the generated hypotheses, you can + invoke "induction H as [H1 H2] using eq_sigT_rect". The tactic also + works for "sig", "sigT2", and "sig2", and there are similar + "eq_sig*_rect" induction lemmas. - Tactic "specialize with ..." now accepts any partial bindings. Missing bindings are either solved by unification or left quantified in the hypothesis. @@ -64,6 +82,8 @@ Standard Library Plugins - The mathematical proof language (also known as declarative mode) was removed. +- A new command Extraction TestCompile has been introduced, not meant + for the general user but instead for Coq's test-suite. Dependencies @@ -84,6 +104,11 @@ Tools The current version contains code for retro compatibility that prints warnings when a deprecated feature is used. Please upgrade your _CoqProject accordingly. + * Additionally, coq_makefile-made Makefiles now support experimental timing + targets `pretty-timed`, `pretty-timed-before`, `pretty-timed-after`, + `print-pretty-timed-diff`, `print-pretty-single-time-diff`, + `all.timing.diff`, and the variable `TIMING=1` (or `TIMING=before` or + `TIMING=after`); see the documentation for more details. Build Infrastructure @@ -95,6 +95,8 @@ package "intf" ( directory = "intf" + archive(byte) = "intf.cma" + archive(native) = "intf.cmxa" ) package "engine" ( @@ -239,19 +241,6 @@ package "toplevel" ( ) -package "highparsing" ( - - description = "Coq Extra Parsing" - version = "8.7" - - requires = "coq.toplevel" - directory = "parsing" - - archive(byte) = "highparsing.cma" - archive(native) = "highparsing.cmxa" - -) - package "idetop" ( description = "Coq IDE Libraries" @@ -279,28 +268,43 @@ package "ide" ( ) -package "ltac" ( +# XXX: Remove the dependency on toplevel (due to Coqinit use for compat flags) +package "highparsing" ( - description = "Coq LTAC Plugin" + description = "Coq Extra Parsing" version = "8.7" - requires = "coq.highparsing" - directory = "plugins/ltac" + requires = "coq.toplevel" + directory = "parsing" - archive(byte) = "ltac_plugin.cmo" - archive(native) = "ltac_plugin.cmx" + archive(byte) = "highparsing.cma" + archive(native) = "highparsing.cmxa" ) +# XXX: API should depend only on stm. package "API" ( description = "Coq API" version = "8.7" - requires = "coq.toplevel" + requires = "coq.highparsing" directory = "API" archive(byte) = "API.cma" archive(native) = "API.cmxa" ) + +package "ltac" ( + + description = "Coq LTAC Plugin" + version = "8.7" + + requires = "coq.API" + directory = "plugins/ltac" + + archive(byte) = "ltac_plugin.cmo" + archive(native) = "ltac_plugin.cmx" + +) @@ -17,7 +17,7 @@ # read # http://miller.emu.id.au/pmiller/books/rmch/ # before complaining. -# +# # When you are working in a subdir, you can compile without moving to the # upper directory using "make -C ..", and the output is still understood # by Emacs' next-error. @@ -42,9 +42,9 @@ # to communicate between make sub-calls (in Win32, 8kb max per env variable, # 32kb total) -# !! Before using FIND_VCS_CLAUSE, please read how you should in the !! -# !! FIND_VCS_CLAUSE section of dev/doc/build-system.dev.txt !! -FIND_VCS_CLAUSE:='(' \ +# !! Before using FIND_SKIP_DIRS, please read how you should in the !! +# !! FIND_SKIP_DIRS section of dev/doc/build-system.dev.txt !! +FIND_SKIP_DIRS:='(' \ -name '{arch}' -o \ -name '.svn' -o \ -name '_darcs' -o \ @@ -55,25 +55,23 @@ FIND_VCS_CLAUSE:='(' \ -name '_build' -o \ -name '_build_ci' -o \ -name 'coq-makefile' -o \ - -name '.opamcache' \ + -name '.opamcache' -o \ + -name '.coq-native' \ ')' -prune -o define find - $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -print | sed 's|^\./||') + $(shell find . $(FIND_SKIP_DIRS) '(' -name $(1) ')' -print | sed 's|^\./||') endef define findindir - $(shell find $(1) $(FIND_VCS_CLAUSE) '(' -name $(2) ')' -print | sed 's|^\./||') -endef - -define findx - $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -exec $(2) {} \; | sed 's|^\./||') + $(shell find $(1) $(FIND_SKIP_DIRS) '(' -name $(2) ')' -print | sed 's|^\./||') endef ## Files in the source tree LEXFILES := $(call find, '*.mll') -export MLLIBFILES := $(call find, '*.mllib') $(call find, '*.mlpack') +export MLLIBFILES := $(call find, '*.mllib') +export MLPACKFILES := $(call find, '*.mlpack') export ML4FILES := $(call find, '*.ml4') export CFILES := $(call findindir, 'kernel/byterun', '*.c') @@ -97,11 +95,7 @@ export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) ## More complex file lists -define diff - $(strip $(foreach f, $(1), $(if $(filter $(f),$(2)),,$f))) -endef - -export MLSTATICFILES := $(call diff, $(EXISTINGML), $(GENMLFILES) $(GENML4FILES)) +export MLSTATICFILES := $(filter-out $(GENMLFILES) $(GENML4FILES), $(EXISTINGML)) export MLIFILES := $(sort $(GENMLIFILES) $(EXISTINGMLI)) include Makefile.common @@ -139,6 +133,38 @@ Then, you may want to consider whether you want to restore the autosaves) #run. endif +# Check that every compiled file around has a known source file. +# This should help preventing weird compilation failures caused by leftover +# compiled files after deleting or moving some source files. + +ifeq (,$(findstring clean,$(MAKECMDGOALS))) # Skip this for 'make clean' and alii +ifndef ACCEPT_ALIEN_VO +EXISTINGVO:=$(call find, '*.vo') +KNOWNVO:=$(patsubst %.v,%.vo,$(call find, '*.v')) +ALIENVO:=$(filter-out $(KNOWNVO),$(EXISTINGVO)) +ifdef ALIENVO +$(error Leftover compiled Coq files without known sources: $(ALIENVO); \ +remove them first, for instance via 'make voclean' \ +(or skip this check via 'make ACCEPT_ALIEN_VO=1')) +endif +endif + +ifndef ACCEPT_ALIEN_OBJ +EXISTINGOBJS:=$(call find, '*.cm[oxia]' -o -name '*.cmxa') +KNOWNML:=$(EXISTINGML) $(GENMLFILES) $(GENML4FILES) $(MLPACKFILES:.mlpack=.ml) \ + $(patsubst %.mlp,%.ml,$(wildcard grammar/*.mlp)) +KNOWNOBJS:=$(KNOWNML:.ml=.cmo) $(KNOWNML:.ml=.cmx) $(KNOWNML:.ml=.cmi) \ + $(MLIFILES:.mli=.cmi) \ + $(MLLIBFILES:.mllib=.cma) $(MLLIBFILES:.mllib=.cmxa) grammar/grammar.cma +ALIENOBJS:=$(filter-out $(KNOWNOBJS),$(EXISTINGOBJS)) +ifdef ALIENOBJS +$(error Leftover compiled OCaml files without known sources: $(ALIENOBJS); \ +remove them first, for instance via 'make clean' \ +(or skip this check via 'make ACCEPT_ALIEN_OBJ=1')) +endif +endif +endif + # Apart from clean and tags, everything will be done in a sub-call to make # on Makefile.build. This way, we avoid doing here the -include of .d : # since they trigger some compilations, we do not want them for a mere clean. @@ -168,7 +194,7 @@ Makefile $(wildcard Makefile.*) config/Makefile : ; # Cleaning ########################################################################### -.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean devdocclean +.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean timingclean devdocclean clean: objclean cruftclean depclean docclean devdocclean @@ -218,7 +244,7 @@ archclean: clean-ide optclean voclean optclean: rm -f $(COQTOPEXE) $(COQMKTOP) $(CHICKEN) rm -f $(TOOLS) $(PRIVATEBINARIES) $(CSDPCERT) - find . -name '*.cmx' -o -name '*.cmxs' -o -name '*.cmxa' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f + find . -name '*.cmx' -o -name '*.cmx[as]' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f clean-ide: rm -f $(COQIDECMO) $(COQIDECMX) $(COQIDECMO:.cmo=.cmi) $(COQIDEBYTE) $(COQIDE) @@ -231,7 +257,7 @@ ml4clean: rm -f $(GENML4FILES) depclean: - find . $(FIND_VCS_CLAUSE) '(' -name '*.d' ')' -print | xargs rm -f + find . $(FIND_SKIP_DIRS) '(' -name '*.d' ')' -print | xargs rm -f cacheclean: find theories plugins test-suite -name '.*.aux' -delete @@ -239,16 +265,19 @@ cacheclean: cleanconfig: rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-coq dev/camlp4.dbg config/Info-*.plist -distclean: clean cleanconfig cacheclean +distclean: clean cleanconfig cacheclean timingclean voclean: find theories plugins test-suite \( -name '*.vo' -o -name '*.glob' -o -name "*.cmxs" -o -name "*.native" -o -name "*.cmx" -o -name "*.cmi" -o -name "*.o" \) -delete find theories plugins test-suite -name .coq-native -empty -delete +timingclean: + find theories plugins test-suite \( -name '*.v.timing' -o -name '*.v.before-timing' -o -name "*.v.after-timing" -o -name "*.v.timing.diff" -o -name "time-of-build.log" -o -name "time-of-build-before.log" -o -name "time-of-build-after.log" -o -name "time-of-build-pretty.log" -o -name "time-of-build-both.log" \) -delete + devdocclean: find . -name '*.dep.ps' -o -name '*.dot' | xargs rm -f - rm -f $(OCAMLDOCDIR)/*.log $(OCAMLDOCDIR)/*.aux $(OCAMLDOCDIR)/*.toc - rm -f $(OCAMLDOCDIR)/ocamldoc.sty $(OCAMLDOCDIR)/coq.tex + rm -f $(OCAMLDOCDIR)/*.log $(OCAMLDOCDIR)/*.aux $(OCAMLDOCDIR)/*.toc + rm -f $(OCAMLDOCDIR)/ocamldoc.sty $(OCAMLDOCDIR)/coq.tex rm -f $(OCAMLDOCDIR)/html/*.html ########################################################################### @@ -299,4 +328,3 @@ printenv: @env | wc -L @echo -n "Total (win32 limit is 32k) : " @env | wc -m - diff --git a/Makefile.build b/Makefile.build index 0dafde9977..b45c6427a1 100644 --- a/Makefile.build +++ b/Makefile.build @@ -34,6 +34,12 @@ TIMED ?= # it could be set to "'/usr/bin/time -p'". TIMECMD ?= +# When non-empty, -time is passed to coqc and the output is recorded +# in a timing file for each .v file. If set to "before" or "after", +# the file name for foo.v is foo.v.$(TIMING)-timing; otherwise, it is +# foo.v.timing +TIMING ?= + # Non-empty skips the update of all dependency .d files: NO_RECALC_DEPS ?= @@ -43,6 +49,16 @@ VALIDATE ?= # Is "-xml" when building XML library: COQ_XML ?= +# Output file names for timed builds +TIME_OF_BUILD_FILE ?= time-of-build.log +TIME_OF_BUILD_BEFORE_FILE ?= time-of-build-before.log +TIME_OF_BUILD_AFTER_FILE ?= time-of-build-after.log +TIME_OF_PRETTY_BUILD_FILE ?= time-of-build-pretty.log +TIME_OF_PRETTY_BOTH_BUILD_FILE ?= time-of-build-both.log +TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line +BEFORE ?= +AFTER ?= + ########################################################################### # Default starting rule ########################################################################### @@ -53,6 +69,9 @@ world: coq coqide documentation revision coq: coqlib coqbinaries tools +world.timing.diff: coq.timing.diff +coq.timing.diff: coqlib.timing.diff + # Note: 'world' does not build the bytecode binaries anymore. # For that, you can use the 'byte' rule. Native and byte compilations # shouldn't be done in a same make -j... run, otherwise both ocamlc and @@ -60,7 +79,7 @@ coq: coqlib coqbinaries tools byte: coqbyte coqide-byte pluginsbyte printers -.PHONY: world coq byte +.PHONY: world coq byte world.timing.diff coq.timing.diff ########################################################################### # Includes @@ -78,6 +97,53 @@ include Makefile.install include Makefile.dev ## provides the 'printers' and 'revision' rules ########################################################################### +# Timing targets +########################################################################### +make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE) +make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE) +make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: + $(HIDE)rm -f pretty-timed-success.ok + $(HIDE)($(MAKE) --no-print-directory $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE) + $(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed +print-pretty-timed:: + $(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +print-pretty-timed-diff:: + $(HIDE)$(COQMAKE_BOTH_TIME_FILES) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +ifeq (,$(BEFORE)) +print-pretty-single-time-diff:: + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + $(HIDE)false +else +ifeq (,$(AFTER)) +print-pretty-single-time-diff:: + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + $(HIDE)false +else +print-pretty-single-time-diff:: + $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) $(BEFORE) $(AFTER) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +endif +endif +pretty-timed: + $(HIDE)$(MAKE) --no-print-directory make-pretty-timed + $(HIDE)$(MAKE) --no-print-directory print-pretty-timed +.PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff + +ifneq (,$(TIMING)) +TIMING_ARG=-time +ifeq (after,$(TIMING)) +TIMING_EXT=after-timing +else +ifeq (before,$(TIMING)) +TIMING_EXT=before-timing +else +TIMING_EXT=timing +endif +endif +else +TIMING_ARG= +endif + +########################################################################### # This include below will lauch the build of all .d. # The - at front is for disabling warnings about currently missing ones. @@ -85,7 +151,7 @@ include Makefile.dev ## provides the 'printers' and 'revision' rules # coqdep_boot (for the .v.d files) or grammar.cma (for .ml4 -> .ml -> .ml.d). DEPENDENCIES := \ - $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(CFILES) $(VFILES)) + $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(MLPACKFILES) $(CFILES) $(VFILES)) -include $(DEPENDENCIES) @@ -101,7 +167,21 @@ DEPENDENCIES := \ ########################################################################### # Default timing command -STDTIME=/usr/bin/time -f "$* (user: %U mem: %M ko)" +# Use /usr/bin/time on linux, gtime on Mac OS +TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)" +ifneq (,$(TIMED)) +ifeq (0,$(shell /usr/bin/time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +STDTIME?=/usr/bin/time -f $(TIMEFMT) +else +ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +STDTIME?=gtime -f $(TIMEFMT) +else +STDTIME?=time +endif +endif +else +STDTIME?=/usr/bin/time -f $(TIMEFMT) +endif TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD)) @@ -112,7 +192,7 @@ TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD)) COQOPTS=$(COQ_XML) $(NATIVECOMPUTE) BOOTCOQC=$(TIMER) $(COQTOPBEST) -boot $(COQOPTS) -compile -LOCALINCLUDES=$(if $(filter plugins/%,$<),-I lib -I API $(addprefix -I plugins/,$(PLUGINDIRS)),$(addprefix -I ,$(SRCDIRS))) +LOCALINCLUDES=$(if $(filter plugins/%,$<),-I lib -I API -open API $(addprefix -I plugins/,$(PLUGINDIRS)),$(addprefix -I ,$(SRCDIRS))) MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB) OCAMLC := $(OCAMLFIND) ocamlc $(CAMLFLAGS) @@ -157,7 +237,7 @@ endef # Camlp5 settings -CAMLP4DEPS:=grammar/compat5.cmo grammar/grammar.cma +CAMLP4DEPS:=grammar/grammar.cma CAMLP4USE=pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION) PR_O := $(if $(READABLE_ML4),pr_o.cmo,pr_dump.cmo) @@ -275,7 +355,7 @@ grammar/grammar.cma : $(GRAMCMO) @touch grammar/test.mlp $(HIDE)$(GRAMC) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) $^ -impl' -impl grammar/test.mlp -o grammar/test @rm -f grammar/test.* grammar/test - $(SHOW)'OCAMLC -a $@' + $(SHOW)'OCAMLC -a $@' $(HIDE)$(GRAMC) $^ -linkall -a -o $@ ## Support of Camlp5 and Camlp5 @@ -307,7 +387,7 @@ coqbyte: $(COQTOPBYTE) $(CHICKENBYTE) ifeq ($(BEST),opt) $(COQTOPEXE): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs) - $(SHOW)'COQMKTOP -o $@' + $(SHOW)'COQMKTOP -o $@' $(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) $(LINKMETADATA) -o $@ $(STRIP) $@ $(CODESIGN) $@ @@ -317,7 +397,7 @@ $(COQTOPEXE): $(COQTOPBYTE) endif $(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA) - $(SHOW)'COQMKTOP -o $@' + $(SHOW)'COQMKTOP -o $@' $(HIDE)$(COQMKTOP) -boot -top $(BYTEFLAGS) -o $@ # coqmktop @@ -484,6 +564,12 @@ kernel/kernel.cma: kernel/kernel.mllib $(SHOW)'OCAMLC -a -o $@' $(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(VMBYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^) +# Specific rule for API/API.cmi +# Make sure that API/API.mli cannot leak types from the Coq codebase. +API/API.cmi : API/API.mli + $(SHOW)'OCAMLC $<' + $(HIDE)$(OCAMLC) -I lib -I $(MYCAMLP4LIB) -c $< + %.cma: %.mllib $(SHOW)'OCAMLC -a -o $@' $(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^) @@ -602,18 +688,28 @@ OCAMLDEP = $(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack # since they are all mentioned in at least one Declare ML Module in some .v coqlib: theories plugins +coqlib.timing.diff: theories.timing.diff plugins.timing.diff theories: $(THEORIESVO) plugins: $(PLUGINSVO) -.PHONY: coqlib theories plugins +theories.timing.diff: $(THEORIESVO:.vo=.v.timing.diff) +plugins.timing.diff: $(PLUGINSVO:.vo=.v.timing.diff) + +.PHONY: coqlib theories plugins coqlib.timing.diff theories.timing.diff plugins.timing.diff # The .vo files in Init are built with the -noinit option +ifneq (,$(TIMING)) +TIMING_EXTRA = > $<.$(TIMING_EXT) +else +TIMING_EXTRA = +endif + theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP) $(SHOW)'COQC $(COQ_XML) -noinit $<' $(HIDE)rm -f theories/Init/$*.glob - $(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq + $(HIDE)$(BOOTCOQC) $< $(COQ_XML) -noinit -R theories Coq $(TIMING_ARG) $(TIMING_EXTRA) # MExtraction.v generates the ml core file of the micromega tactic. # We check that this generated code is still in sync with the version @@ -640,13 +736,18 @@ $(MICROMEGAV:.v=.vo) $(MICROMEGAV:.v=.glob) : $(MICROMEGAV) theories/Init/Prelud %.vo %.glob: %.v theories/Init/Prelude.vo $(VO_TOOLS_DEP) $(SHOW)'COQC $<' $(HIDE)rm -f $*.glob - $(HIDE)$(BOOTCOQC) $< + $(HIDE)$(BOOTCOQC) $< $(TIMING_ARG) $(TIMING_EXTRA) ifdef VALIDATE $(SHOW)'COQCHK $(call vo_to_mod,$@)' $(HIDE)$(CHICKEN) -boot -silent -norec $(call vo_to_mod,$@) \ || ( RV=$$?; rm -f "$@"; exit $${RV} ) endif +%.v.timing.diff: %.v.before-timing %.v.after-timing + $(SHOW)PYTHON TIMING-DIFF $< + $(HIDE)$(MAKE) --no-print-directory print-pretty-single-time-diff BEFORE=$*.v.before-timing AFTER=$*.v.after-timing TIME_OF_PRETTY_BUILD_FILE="$@" + + # Dependencies of .v files %.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) @@ -667,7 +768,7 @@ Makefile $(wildcard Makefile.*) config/Makefile : ; %: @echo "Error: no rule to make target $@ (or missing .PHONY)" && false -# For emacs: -# Local Variables: -# mode: makefile +# For emacs: +# Local Variables: +# mode: makefile # End: diff --git a/Makefile.ci b/Makefile.ci index 3be90c0a31..1b09905cc7 100644 --- a/Makefile.ci +++ b/Makefile.ci @@ -24,4 +24,9 @@ CI_TARGETS=ci-all \ # Generic rule, we use make to easy travis integraton with mixed rules $(CI_TARGETS): ci-%: - ./dev/ci/ci-$*.sh + rm -f ci-$*.ok + +(./dev/ci/ci-$*.sh 2>&1 && touch ci-$*.ok) | tee time-of-build.log + echo 'Aggregating timing log...' && echo -en 'travis_fold:start:coq.test.timing\\r' + python ./tools/make-one-time-file.py time-of-build.log + echo -en 'travis_fold:end:coq.test.timing\\r' + rm ci-$*.ok # must not be -f; we're checking to see that it exists diff --git a/Makefile.common b/Makefile.common index 100698321a..afd6164fca 100644 --- a/Makefile.common +++ b/Makefile.common @@ -12,7 +12,7 @@ # Executables ########################################################################### -COQMKTOP:=bin/coqmktop$(EXE) +COQMKTOP:=bin/coqmktop$(EXE) COQTOPBYTE:=bin/coqtop.byte$(EXE) COQTOPEXE:=bin/coqtop$(EXE) @@ -25,9 +25,15 @@ COQWC:=bin/coqwc$(EXE) COQDOC:=bin/coqdoc$(EXE) COQC:=bin/coqc$(EXE) COQWORKMGR:=bin/coqworkmgr$(EXE) +COQMAKE_ONE_TIME_FILE:=tools/make-one-time-file.py +COQTIME_FILE_MAKER:=tools/TimeFileMaker.py +COQMAKE_BOTH_TIME_FILES:=tools/make-both-time-files.py +COQMAKE_BOTH_SINGLE_TIMING_FILES:=tools/make-both-single-timing-files.py TOOLS:=$(COQDEP) $(COQMAKEFILE) $(GALLINA) $(COQTEX) $(COQWC) $(COQDOC) $(COQC)\ $(COQWORKMGR) +TOOLS_HELPERS:=tools/CoqMakefile.in $(COQMAKE_ONE_TIME_FILE) $(COQTIME_FILE_MAKER)\ + $(COQMAKE_BOTH_TIME_FILES) $(COQMAKE_BOTH_SINGLE_TIMING_FILES) COQDEPBOOT:=bin/coqdep_boot$(EXE) OCAMLLIBDEP:=bin/ocamllibdep$(EXE) @@ -64,7 +70,7 @@ DYNLIB:=.cma endif INSTALLBIN:=install -INSTALLLIB:=install -m 644 +INSTALLLIB:=install -m 644 INSTALLSH:=./install.sh MKDIR:=install -d @@ -103,7 +109,7 @@ CORECMA:=lib/clib.cma lib/lib.cma kernel/kernel.cma intf/intf.cma library/librar TOPLOOPCMA:=stm/proofworkertop.cma stm/tacworkertop.cma stm/queryworkertop.cma -GRAMMARCMA:=grammar/compat5.cmo grammar/grammar.cma +GRAMMARCMA:=grammar/grammar.cma # modules known by the toplevel of Coq @@ -191,7 +197,7 @@ LIBFILES:=$(ALLVO) $(call vo_to_cm,$(ALLVO)) \ $(call vo_to_obj,$(ALLVO)) \ $(VFILES) $(GLOBFILES) -# For emacs: -# Local Variables: -# mode: makefile +# For emacs: +# Local Variables: +# mode: makefile # End: diff --git a/Makefile.ide b/Makefile.ide index 0cfbdeb4e0..b534b385b9 100644 --- a/Makefile.ide +++ b/Makefile.ide @@ -61,12 +61,16 @@ GTKLIBS=$(shell pkg-config --variable=libdir gtk+-2.0) # CoqIde special targets ########################################################################### -.PHONY: coqide coqide-opt coqide-byte coqide-files +.PHONY: coqide coqide-opt coqide-byte coqide-files coqide-binaries .PHONY: ide-toploop ide-byteloop ide-optloop -# target to build CoqIde +# target to build CoqIde (native version) and the stuff needed to lauch it coqide: coqide-files coqide-opt theories/Init/Prelude.vo +# target to build CoqIde (in native and byte versions), and no more +# NB: this target is used in the opam package coq-coqide +coqide-binaries: coqide-opt coqide-byte + ifeq ($(HASCOQIDE),opt) coqide-opt: $(COQIDE) ide-toploop else diff --git a/Makefile.install b/Makefile.install index 4a3227620c..02ae724dfe 100644 --- a/Makefile.install +++ b/Makefile.install @@ -107,7 +107,7 @@ install-devfiles: $(MKDIR) $(FULLCOQLIB) $(INSTALLSH) $(FULLCOQLIB) $(GRAMMARCMA) $(INSTALLSH) $(FULLCOQLIB) $(INSTALLCMI) - $(INSTALLSH) $(FULLCOQLIB) tools/CoqMakefile.in + $(INSTALLSH) $(FULLCOQLIB) $(TOOLS_HELPERS) ifeq ($(BEST),opt) $(INSTALLSH) $(FULLCOQLIB) $(LINKCMX) $(CORECMA:.cma=.a) $(STATICPLUGINS:.cma=.a) endif diff --git a/README.ci.md b/README.ci.md index 9e25390d72..cf9da50941 100644 --- a/README.ci.md +++ b/README.ci.md @@ -1,30 +1,42 @@ **WARNING:** This document is a work in progress and intended as a RFC. -If you are not a Coq Developer, don't follow this instructions yet. +If you are not a Coq Developer, don't follow these instructions yet. Introduction ============ -The Coq Travis CI infrastructure is meant to provide lightweight -automatics testing of pull requests. -If you are on GitLab, their integrated CI is also set up. +As of 2017, Coq's Git repository includes a `.travis.yml` file, a +`.gitlab-ci.yml` file, and supporting scripts, that enable lightweight +Continuous Integration (CI) tests to be run on clones of that repository stored +at Github or on a GitLab instance, respectively. This affords two benefits. -More comprehensive testing is the responsability of Coq's [Jenkins CI -server](https://ci.inria.fr/coq/) see, [XXX: add document] for -instructions on how to add your development to Jenkins. +First, it allows developers working on Coq itself to perform CI on their own +Git remotes, thereby enabling them to catch and fix problems with their +proposed changes before submitting pull requests to Coq itself. This in turn +reduces the risk of a faulty PR being opened against the official Coq +repository. -How to submit your development for Coq CI -========================================= +Secondly, it allows developers working on a library dependent on Coq to have +that library included in the Travis CI tests invoked by the official Coq +repository on GitHub. + +(More comprehensive testing than is provided by the Travis CI and GitLab CI +integration is the responsibility of Coq's [Jenkins CI +server](https://ci.inria.fr/coq/) see, [XXX: add document] for instructions on +how to add your development to Jenkins.) + +How to submit your library for inclusion in Coq's Travis CI builds +================================================================== CI provides a convenient way to perform testing of Coq changes versus a set of curated libraries. Are you an author of a Coq library who would be interested in having -the latest Coq changes validated against your development? +the latest Coq changes validated against it? -If so, keep reading! Getting Coq changes tested against your library -is easy, all that you need to do is: +If so, all you need to do is: -1. Put you development in a public repository tracking coq trunk. +1. Put your library in a public repository tracking the `master` + branch of Coq's Git repository. 2. Make sure that your development builds in less than 35 minutes. 3. Submit a PR adding your development. 4. ? @@ -1,6 +1,6 @@ # Coq -[](https://travis-ci.org/coq/coq/builds) [](https://gitter.im/coq/coq) +[](https://travis-ci.org/coq/coq/builds) [](https://gitter.im/coq/coq) Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000000..ec6ded7218 --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,26 @@ +version: '{branch}~{build}' +clone_depth: 10 + +platform: +- x64 + +image: +- Visual Studio 2017 + +environment: + CYGROOT: C:\cygwin64 + CYGMIRROR: http://ftp.inf.tu-dresden.de/software/windows/cygwin32 + CYGCACHE: C:\cygwin64\var\cache\setup + opam_url: https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam64.tar.xz + +install: +- cmd: '%CYGROOT%\setup-x86_64.exe -qnNdO -R %CYGROOT% -l %CYGCACHE% -s + %CYGMIRROR% -P rsync -P patch -P diffutils -P curl -P make -P unzip -P git -p m4 + -P perl -P findutils -P time' +- cmd: '%CYGROOT%/bin/bash -l %APPVEYOR_BUILD_FOLDER%/dev/build/windows/appveyor.sh' + +build_script: +- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && ./configure -local && make"' + +test_script: +- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && make -C test-suite && make validate"' diff --git a/checker/check.ml b/checker/check.ml index b3b4034258..180ca1ece1 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/check_stat.ml b/checker/check_stat.ml index 741f532848..9751b45975 100644 --- a/checker/check_stat.ml +++ b/checker/check_stat.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/check_stat.mli b/checker/check_stat.mli index 39e19d10e4..cfa1e7b067 100644 --- a/checker/check_stat.mli +++ b/checker/check_stat.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/checker.ml b/checker/checker.ml index e00f47a540..7a69700d28 100644 --- a/checker/checker.ml +++ b/checker/checker.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/cic.mli b/checker/cic.mli index e298c41cf1..59dd5bc4d3 100644 --- a/checker/cic.mli +++ b/checker/cic.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -182,8 +182,6 @@ type ('a, 'b) declaration_arity = | RegularArity of 'a | TemplateArity of 'b -type constant_type = (constr, rel_context * template_arity) declaration_arity - (** Inlining level of parameters at functor applications. This is ignored by the checker. *) @@ -226,7 +224,7 @@ type typing_flags = { type constant_body = { const_hyps : section_context; (** New: younger hyp at top *) const_body : constant_def; - const_type : constant_type; + const_type : constr; const_body_code : to_patch_substituted; const_universes : constant_universes; const_proj : projection_body option; diff --git a/checker/closure.ml b/checker/closure.ml index ac8388f6ed..70718bfdca 100644 --- a/checker/closure.ml +++ b/checker/closure.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/closure.mli b/checker/closure.mli index 8da9ad4ea5..ed5bb3d094 100644 --- a/checker/closure.mli +++ b/checker/closure.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/declarations.ml b/checker/declarations.ml index 2eefe47816..093d999a34 100644 --- a/checker/declarations.ml +++ b/checker/declarations.ml @@ -515,12 +515,6 @@ let subst_rel_declaration sub = let subst_rel_context sub = List.smartmap (subst_rel_declaration sub) -let subst_template_cst_arity sub (ctx,s as arity) = - let ctx' = subst_rel_context sub ctx in - if ctx==ctx' then arity else (ctx',s) - -let subst_arity sub s = subst_decl_arity subst_mps subst_template_cst_arity sub s - let constant_is_polymorphic cb = match cb.const_universes with | Monomorphic_const _ -> false @@ -531,7 +525,7 @@ let constant_is_polymorphic cb = let subst_const_body sub cb = { cb with const_body = subst_constant_def sub cb.const_body; - const_type = subst_arity sub cb.const_type } + const_type = subst_mps sub cb.const_type } let subst_regular_ind_arity sub s = diff --git a/checker/environ.ml b/checker/environ.ml index 11b8ea67cc..a0818012c7 100644 --- a/checker/environ.ml +++ b/checker/environ.ml @@ -122,14 +122,7 @@ type const_evaluation_result = NoBody | Opaque | IsProj let constraints_of cb u = match cb.const_universes with | Monomorphic_const _ -> Univ.Constraint.empty - | Polymorphic_const ctx -> - Univ.UContext.constraints (Univ.subst_instance_context u ctx) - -let map_regular_arity f = function - | RegularArity a as ar -> - let a' = f a in - if a' == a then ar else RegularArity a' - | TemplateArity _ -> assert false + | Polymorphic_const ctx -> Univ.AUContext.instantiate u ctx (* constant_type gives the type of a constant *) let constant_type env (kn,u) = @@ -138,7 +131,7 @@ let constant_type env (kn,u) = | Monomorphic_const _ -> cb.const_type, Univ.Constraint.empty | Polymorphic_const ctx -> let csts = constraints_of cb u in - (map_regular_arity (subst_instance_constr u) cb.const_type, csts) + (subst_instance_constr u cb.const_type, csts) exception NotEvaluableConst of const_evaluation_result diff --git a/checker/environ.mli b/checker/environ.mli index 754c295d27..8e8d0fd49c 100644 --- a/checker/environ.mli +++ b/checker/environ.mli @@ -46,7 +46,7 @@ val check_constraints : Univ.constraints -> env -> bool (* Constants *) val lookup_constant : constant -> env -> Cic.constant_body val add_constant : constant -> Cic.constant_body -> env -> env -val constant_type : env -> constant puniverses -> constant_type Univ.constrained +val constant_type : env -> constant puniverses -> constr Univ.constrained type const_evaluation_result = NoBody | Opaque | IsProj exception NotEvaluableConst of const_evaluation_result val constant_value : env -> constant puniverses -> constr diff --git a/checker/indtypes.ml b/checker/indtypes.ml index 54dec56b54..22c8438126 100644 --- a/checker/indtypes.ml +++ b/checker/indtypes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -525,10 +525,10 @@ let check_positivity env_ar mind params nrecp inds = Array.iter2 (fun ind wfpi -> check_subtree ind.mind_recargs wfpi) inds wfp (* Check arities and constructors *) -let check_subtyping_arity_constructor env (subst : constr -> constr) (arcn : constr) numparams is_arity = +let check_subtyping_arity_constructor env (subst : Univ.Instance.t) (arcn : constr) numparams is_arity = let numchecked = ref 0 in let basic_check ev tp = - if !numchecked < numparams then () else conv_leq ev tp (subst tp); + if !numchecked < numparams then () else conv_leq ev tp (Term.subst_instance_constr subst tp); numchecked := !numchecked + 1 in let check_typ typ typ_env = @@ -548,26 +548,27 @@ let check_subtyping_arity_constructor env (subst : constr -> constr) (arcn : con (* Check that the subtyping information inferred for inductive types in the block is correct. *) (* This check produces a value of the unit type if successful or raises an anomaly if check fails. *) -let check_subtyping cumi paramsctxt env_ar inds = +let check_subtyping cumi paramsctxt env inds = + let open Univ in let numparams = rel_context_nhyps paramsctxt in - let sbsubst = Univ.CumulativityInfo.subtyping_susbst cumi in - let other_instnace = Univ.CumulativityInfo.subtyping_other_instance cumi in - let dosubst = subst_univs_level_constr sbsubst in - let uctx = Univ.CumulativityInfo.univ_context cumi in - let uctx_other = Univ.UContext.make (other_instnace, Univ.UContext.constraints uctx) in - let env = Environ.push_context uctx env_ar - in - let env = Environ.push_context uctx_other env - in - let env = Environ.push_context - (Univ.CumulativityInfo.subtyp_context cumi) env - in + (** In [env] we already have [ Var(0) ... Var(n-1) |- cst ] available. + We must produce the substitution σ : [ Var(i) -> Var (i + n) | 0 <= i < n] + and push the constraints [ Var(n) ... Var(2n - 1) |- cst{σ} ], together + with the cumulativity constraints [ cumul_cst ]. *) + let len = AUContext.size (ACumulativityInfo.univ_context cumi) in + let inst = Instance.of_array (Array.init len (fun i -> Level.var (i + len))) in + let other_context = ACumulativityInfo.univ_context cumi in + let uctx_other = UContext.make (inst, AUContext.instantiate inst other_context) in + let cumul_context = AUContext.repr (ACumulativityInfo.subtyp_context cumi) in + let cumul_cst = UContext.constraints cumul_context in + let env = Environ.push_context uctx_other env in + let env = Environ.add_constraints cumul_cst env in (* process individual inductive types: *) Array.iter (fun { mind_user_lc = lc; mind_arity = arity } -> match arity with | RegularArity { mind_user_arity = full_arity} -> - check_subtyping_arity_constructor env dosubst full_arity numparams true; - Array.iter (fun cnt -> check_subtyping_arity_constructor env dosubst cnt numparams false) lc + check_subtyping_arity_constructor env inst full_arity numparams true; + Array.iter (fun cnt -> check_subtyping_arity_constructor env inst cnt numparams false) lc | TemplateArity _ -> () ) inds @@ -579,10 +580,10 @@ let check_inductive env kn mib = (* check mind_constraints: should be consistent with env *) let ind_ctx = match mib.mind_universes with - | Monomorphic_ind ctx -> ctx - | Polymorphic_ind auctx -> Univ.instantiate_univ_context auctx + | Monomorphic_ind _ -> Univ.UContext.empty (** Already in the global environment *) + | Polymorphic_ind auctx -> Univ.AUContext.repr auctx | Cumulative_ind cumi -> - Univ.instantiate_univ_context (Univ.ACumulativityInfo.univ_context cumi) + Univ.AUContext.repr (Univ.ACumulativityInfo.univ_context cumi) in let env = Environ.push_context ind_ctx env in (* check mind_record : TODO ? check #constructor = 1 ? *) @@ -606,8 +607,7 @@ let check_inductive env kn mib = match mib.mind_universes with | Monomorphic_ind _ | Polymorphic_ind _ -> () | Cumulative_ind acumi -> - check_subtyping - (Univ.instantiate_cumulativity_info acumi) params env_ar mib.mind_packets + check_subtyping acumi params env_ar mib.mind_packets in (* check mind_nparams_rec: positivity condition *) check_positivity env_ar kn params mib.mind_nparams_rec mib.mind_packets; diff --git a/checker/indtypes.mli b/checker/indtypes.mli index 071eecbbcd..b0554989ef 100644 --- a/checker/indtypes.mli +++ b/checker/indtypes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,8 +12,8 @@ open Cic open Environ (*i*) -val prkn : kernel_name -> Pp.std_ppcmds -val prcon : constant -> Pp.std_ppcmds +val prkn : kernel_name -> Pp.t +val prcon : constant -> Pp.t (*s The different kinds of errors that may result of a malformed inductive definition. *) diff --git a/checker/inductive.ml b/checker/inductive.ml index e1860a23f0..1271a02b0e 100644 --- a/checker/inductive.ml +++ b/checker/inductive.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -66,20 +66,6 @@ let inductive_is_cumulative mib = | Polymorphic_ind ctx -> false | Cumulative_ind cumi -> true -let inductive_polymorphic_instance mib = - match mib.mind_universes with - | Monomorphic_ind _ -> Univ.Instance.empty - | Polymorphic_ind ctx -> Univ.AUContext.instance ctx - | Cumulative_ind cumi -> - Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi) - -let inductive_polymorphic_context mib = - match mib.mind_universes with - | Monomorphic_ind _ -> Univ.UContext.empty - | Polymorphic_ind ctx -> Univ.instantiate_univ_context ctx - | Cumulative_ind cumi -> - Univ.instantiate_univ_context (Univ.ACumulativityInfo.univ_context cumi) - (************************************************************************) (* Build the substitution that replaces Rels by the appropriate *) diff --git a/checker/inductive.mli b/checker/inductive.mli index 9a5541f39b..8f605935db 100644 --- a/checker/inductive.mli +++ b/checker/inductive.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -26,10 +26,6 @@ val inductive_is_polymorphic : mutual_inductive_body -> bool val inductive_is_cumulative : mutual_inductive_body -> bool -val inductive_polymorphic_instance : mutual_inductive_body -> Univ.universe_instance - -val inductive_polymorphic_context : mutual_inductive_body -> Univ.universe_context - val type_of_inductive : env -> mind_specif puniverses -> constr (* Return type as quoted by the user *) diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml index 15e9ae2951..b6816dd484 100644 --- a/checker/mod_checking.ml +++ b/checker/mod_checking.ml @@ -26,30 +26,24 @@ let refresh_arity ar = let check_constant_declaration env kn cb = Feedback.msg_notice (str " checking cst:" ++ prcon kn); - let env', u = + (** [env'] contains De Bruijn universe variables *) + let env' = match cb.const_universes with - | Monomorphic_const ctx -> push_context ~strict:true ctx env, Univ.Instance.empty + | Monomorphic_const ctx -> push_context ~strict:true ctx env | Polymorphic_const auctx -> - let ctx = Univ.instantiate_univ_context auctx in - push_context ~strict:false ctx env, Univ.UContext.instance ctx + let ctx = Univ.AUContext.repr auctx in + push_context ~strict:false ctx env in let envty, ty = - match cb.const_type with - RegularArity ty -> - let ty = subst_instance_constr u ty in - let ty', cu = refresh_arity ty in - let envty = push_context_set cu env' in - let _ = infer_type envty ty' in envty, ty - | TemplateArity(ctxt,par) -> - assert(Univ.Instance.is_empty u); - let _ = check_ctxt env' ctxt in - check_polymorphic_arity env' ctxt par; - env', it_mkProd_or_LetIn (Sort(Type par.template_level)) ctxt + let ty = cb.const_type in + let ty', cu = refresh_arity ty in + let envty = push_context_set cu env' in + let _ = infer_type envty ty' in + envty, ty in let () = match body_of_constant cb with | Some bd -> - let bd = subst_instance_constr u bd in (match cb.const_proj with | None -> let j = infer envty bd in conv_leq envty j ty diff --git a/checker/mod_checking.mli b/checker/mod_checking.mli index 5c7b392ffd..16a3792aa1 100644 --- a/checker/mod_checking.mli +++ b/checker/mod_checking.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/modops.ml b/checker/modops.ml index be35c7e981..79cd5c29fd 100644 --- a/checker/modops.ml +++ b/checker/modops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/modops.mli b/checker/modops.mli index 26a088f32b..0efff63c82 100644 --- a/checker/modops.mli +++ b/checker/modops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/print.ml b/checker/print.ml index 7ef752b002..84c327941e 100644 --- a/checker/print.ml +++ b/checker/print.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/reduction.ml b/checker/reduction.ml index 95dc93f5d2..6d8783d7e5 100644 --- a/checker/reduction.ml +++ b/checker/reduction.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -157,25 +157,23 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 = else raise NotConvertible let convert_inductive_instances cv_pb cumi u u' univs = - let ind_instance = - Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi) in + let len_instance = + Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi) in let ind_subtypctx = Univ.ACumulativityInfo.subtyp_context cumi in - if not ((Univ.Instance.length ind_instance = Univ.Instance.length u) && - (Univ.Instance.length ind_instance = Univ.Instance.length u')) then + if not ((len_instance = Univ.Instance.length u) && + (len_instance = Univ.Instance.length u')) then anomaly (Pp.str "Invalid inductive subtyping encountered!") else let comp_cst = let comp_subst = (Univ.Instance.append u u') in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) + Univ.AUContext.instantiate comp_subst ind_subtypctx in let comp_cst = match cv_pb with CONV -> let comp_cst' = let comp_subst = (Univ.Instance.append u' u) in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) + Univ.AUContext.instantiate comp_subst ind_subtypctx in Univ.Constraint.union comp_cst comp_cst' | CUMUL -> comp_cst diff --git a/checker/reduction.mli b/checker/reduction.mli index 15a2df1f14..d0fa40e62d 100644 --- a/checker/reduction.mli +++ b/checker/reduction.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml index c70cd5c8ce..5d7784e777 100644 --- a/checker/safe_typing.ml +++ b/checker/safe_typing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/safe_typing.mli b/checker/safe_typing.mli index 8724f8e014..0eaeb1243c 100644 --- a/checker/safe_typing.mli +++ b/checker/safe_typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/subtyping.ml b/checker/subtyping.ml index bfe19584a7..68a467bea2 100644 --- a/checker/subtyping.ml +++ b/checker/subtyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -81,6 +81,14 @@ let check_conv_error error f env a1 a2 = with NotConvertible -> error () +let check_polymorphic_instance error env auctx1 auctx2 = + if not (Univ.AUContext.size auctx1 == Univ.AUContext.size auctx2) then + error () + else if not (Univ.check_subtype (Environ.universes env) auctx2 auctx1) then + error () + else + Environ.push_context ~strict:false (Univ.AUContext.repr auctx2) env + (* for now we do not allow reorderings *) let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2= let kn = MutInd.make2 mp1 l in @@ -93,19 +101,17 @@ let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2= in let mib2 = subst_mind subst2 mib2 in let check eq f = if not (eq (f mib1) (f mib2)) then error () in - let u = - let process inst inst' = - if Univ.Instance.equal inst inst' then inst else error () - in + let env, u = match mib1.mind_universes, mib2.mind_universes with - | Monomorphic_ind _, Monomorphic_ind _ -> Univ.Instance.empty + | Monomorphic_ind _, Monomorphic_ind _ -> env, Univ.Instance.empty | Polymorphic_ind auctx, Polymorphic_ind auctx' -> - process - (Univ.AUContext.instance auctx) (Univ.AUContext.instance auctx') + let env = check_polymorphic_instance error env auctx auctx' in + env, Univ.make_abstract_instance auctx' | Cumulative_ind cumi, Cumulative_ind cumi' -> - process - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi)) - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi')) + let auctx = Univ.ACumulativityInfo.univ_context cumi in + let auctx' = Univ.ACumulativityInfo.univ_context cumi' in + let env = check_polymorphic_instance error env auctx auctx' in + env, Univ.make_abstract_instance auctx' | _ -> error () in let eq_projection_body p1 p2 = @@ -118,7 +124,7 @@ let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2= check (eq_constr) (fun x -> snd x.proj_eta); check (eq_constr) (fun x -> x.proj_body); true in - let check_inductive_type env t1 t2 = + let check_inductive_type t1 t2 = (* Due to template polymorphism, the conclusions of t1 and t2, if in Type, are generated as the least upper bounds @@ -170,8 +176,8 @@ let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2= (* nparams done *) (* params_ctxt done because part of the inductive types *) (* Don't check the sort of the type if polymorphic *) - check_inductive_type env - (type_of_inductive env ((mib1,p1),u)) (type_of_inductive env ((mib2,p2),u)) + check_inductive_type + (type_of_inductive env ((mib1,p1), u)) (type_of_inductive env ((mib2,p2),u)) in let check_cons_types i p1 p2 = Array.iter2 (check_conv conv env) @@ -288,8 +294,8 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = let cb1 = subst_const_body subst1 cb1 in let cb2 = subst_const_body subst2 cb2 in (*Start by checking types*) - let typ1 = Typeops.type_of_constant_type env cb1.const_type in - let typ2 = Typeops.type_of_constant_type env cb2.const_type in + let typ1 = cb1.const_type in + let typ2 = cb2.const_type in check_type env typ1 typ2; (* Now we check the bodies: - A transparent constant can only be implemented by a compatible @@ -309,27 +315,17 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = let c2 = force_constr lc2 in check_conv conv env c1 c2)) | IndType ((kn,i),mind1) -> - ignore (CErrors.user_err (Pp.str ( + CErrors.user_err (Pp.str ( "The kernel does not recognize yet that a parameter can be " ^ "instantiated by an inductive type. Hint: you can rename the " ^ "inductive type and give a definition to map the old name to the new " ^ - "name."))); - if constant_has_body cb2 then error () ; - let u = inductive_polymorphic_instance mind1 in - let arity1 = type_of_inductive env ((mind1,mind1.mind_packets.(i)),u) in - let typ2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv conv_leq env arity1 typ2 - | IndConstr (((kn,i),j) as cstr,mind1) -> - ignore (CErrors.user_err (Pp.str ( + "name.")) + | IndConstr (((kn,i),j),mind1) -> + CErrors.user_err (Pp.str ( "The kernel does not recognize yet that a parameter can be " ^ "instantiated by a constructor. Hint: you can rename the " ^ "constructor and give a definition to map the old name to the new " ^ - "name."))); - if constant_has_body cb2 then error () ; - let u1 = inductive_polymorphic_instance mind1 in - let ty1 = type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in - let ty2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv conv env ty1 ty2 + "name.")) let rec check_modules env msb1 msb2 subst1 subst2 = let mty1 = module_type_of_module None msb1 in diff --git a/checker/subtyping.mli b/checker/subtyping.mli index cc66fc5382..b1cfac2781 100644 --- a/checker/subtyping.mli +++ b/checker/subtyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/term.ml b/checker/term.ml index dea3d3e659..5995dfcc61 100644 --- a/checker/term.ml +++ b/checker/term.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -447,37 +447,3 @@ let subst_instance_constr subst c = let subst_instance_context s ctx = if Univ.Instance.is_empty s then ctx else map_rel_context (fun x -> subst_instance_constr s x) ctx - -let subst_univs_level_constr subst c = - if Univ.is_empty_level_subst subst then c - else - let f = Univ.Instance.subst_fn (Univ.subst_univs_level_level subst) in - let changed = ref false in - let rec aux t = - match t with - | Const (c, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Const (c, u')) - | Ind (i, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Ind (i, u')) - | Construct (c, u) -> - if Univ.Instance.is_empty u then t - else - let u' = f u in - if u' == u then t - else (changed := true; Construct (c, u')) - | Sort (Type u) -> - let u' = Univ.subst_univs_level_universe subst u in - if u' == u then t else - (changed := true; Sort (sort_of_univ u')) - | _ -> map_constr aux t - in - let c' = aux c in - if !changed then c' else c diff --git a/checker/term.mli b/checker/term.mli index ccf5b59e0c..679a56ee45 100644 --- a/checker/term.mli +++ b/checker/term.mli @@ -57,4 +57,3 @@ val eq_constr : constr -> constr -> bool (** Instance substitution for polymorphism. *) val subst_instance_constr : Univ.universe_instance -> constr -> constr val subst_instance_context : Univ.universe_instance -> rel_context -> rel_context -val subst_univs_level_constr : Univ.universe_level_subst -> constr -> constr diff --git a/checker/type_errors.ml b/checker/type_errors.ml index b7718e02da..c5a69efdcd 100644 --- a/checker/type_errors.ml +++ b/checker/type_errors.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/type_errors.mli b/checker/type_errors.mli index d9d1479580..b5f14c7189 100644 --- a/checker/type_errors.mli +++ b/checker/type_errors.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/typeops.ml b/checker/typeops.ml index 543f9acced..9f39d588a7 100644 --- a/checker/typeops.ml +++ b/checker/typeops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -69,35 +69,16 @@ let judge_of_relative env n = (* Type of constants *) - -let type_of_constant_type_knowing_parameters env t paramtyps = - match t with - | RegularArity t -> t - | TemplateArity (sign,ar) -> - let ctx = List.rev sign in - let ctx,s = instantiate_universes env ctx ar paramtyps in - mkArity (List.rev ctx,s) - -let type_of_constant_knowing_parameters env cst paramtyps = - let ty, cu = constant_type env cst in - type_of_constant_type_knowing_parameters env ty paramtyps, cu - -let type_of_constant_type env t = - type_of_constant_type_knowing_parameters env t [||] - -let judge_of_constant_knowing_parameters env (kn,u as cst) paramstyp = +let judge_of_constant env (kn,u as cst) = let _cb = try lookup_constant kn env with Not_found -> failwith ("Cannot find constant: "^Constant.to_string kn) in - let ty, cu = type_of_constant_knowing_parameters env cst paramstyp in + let ty, cu = constant_type env cst in let () = check_constraints cu env in ty -let judge_of_constant env cst = - judge_of_constant_knowing_parameters env cst [||] - (* Type of an application. *) let judge_of_apply env (f,funj) argjv = @@ -276,8 +257,6 @@ let rec execute env cstr = match f with | Ind ind -> judge_of_inductive_knowing_parameters env ind jl - | Const cst -> - judge_of_constant_knowing_parameters env cst jl | _ -> (* No template polymorphism *) execute env f diff --git a/checker/typeops.mli b/checker/typeops.mli index db8e467a33..d9f2915a30 100644 --- a/checker/typeops.mli +++ b/checker/typeops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,6 +18,3 @@ val infer_type : env -> constr -> sorts val check_ctxt : env -> rel_context -> env val check_polymorphic_arity : env -> rel_context -> template_arity -> unit - -val type_of_constant_type : env -> constant_type -> constr - diff --git a/checker/univ.ml b/checker/univ.ml index 0ee4686c1a..558315c2c1 100644 --- a/checker/univ.ml +++ b/checker/univ.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -1071,10 +1071,11 @@ module Instance : sig val equal : t -> t -> bool val subst_fn : universe_level_subst_fn -> t -> t val subst : universe_level_subst -> t -> t - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t val check_eq : t check_function val length : t -> int val append : t -> t -> t + val of_array : Level.t array -> t end = struct type t = Level.t array @@ -1157,9 +1158,38 @@ struct let length = Array.length let append = Array.append - + + let of_array i = i + end +(** Substitute instance inst for ctx in csts *) + +let subst_instance_level s l = + match l.Level.data with + | Level.Var n -> s.(n) + | _ -> l + +let subst_instance_instance s i = + Array.smartmap (fun l -> subst_instance_level s l) i + +let subst_instance_universe s u = + let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in + let u' = Universe.smartmap f u in + if u == u' then u + else Universe.sort u' + +let subst_instance_constraint s (u,d,v as c) = + let u' = subst_instance_level s u in + let v' = subst_instance_level s v in + if u' == u && v' == v then c + else (u',d,v') + +let subst_instance_constraints s csts = + Constraint.fold + (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) + csts Constraint.empty + type universe_instance = Instance.t type 'a puniverses = 'a * Instance.t @@ -1175,6 +1205,7 @@ struct let make x = x let instance (univs, cst) = univs let constraints (univs, cst) = cst + let size (univs, _) = Instance.length univs let is_empty (univs, cst) = Instance.is_empty univs && Constraint.is_empty cst let pr prl (univs, cst as ctx) = @@ -1184,7 +1215,18 @@ end type universe_context = UContext.t -module AUContext = UContext +module AUContext = +struct + include UContext + + let repr (inst, cst) = + (Array.mapi (fun i l -> Level.var i) inst, cst) + + let instantiate inst (u, cst) = + assert (Array.length u = Array.length inst); + subst_instance_constraints inst cst + +end type abstract_universe_context = AUContext.t @@ -1192,43 +1234,11 @@ module CumulativityInfo = struct type t = universe_context * universe_context - let make x = - if (Array.length (UContext.instance (snd x))) = - (Array.length (UContext.instance (fst x))) * 2 then x - else anomaly (Pp.str "Invalid subtyping information encountered!") - - let empty = (UContext.empty, UContext.empty) - - let halve_context ctx = - let len = Array.length ctx in - let halflen = len / 2 in - ((Array.sub ctx 0 halflen), (Array.sub ctx halflen halflen)) - let univ_context (univcst, subtypcst) = univcst let subtyp_context (univcst, subtypcst) = subtypcst - let create_trivial_subtyping ctx ctx' = - CArray.fold_left_i - (fun i cst l -> Constraint.add (l, Eq, Array.get ctx' i) cst) - Constraint.empty ctx - - let from_universe_context univcst freshunivs = - let inst = (UContext.instance univcst) in - assert (Array.length freshunivs = Array.length inst); - (univcst, UContext.make (Array.append inst freshunivs, - create_trivial_subtyping inst freshunivs)) - - let subtyping_other_instance (univcst, subtypcst) = - let (_, ctx') = (halve_context (UContext.instance subtypcst)) in ctx' - - let subtyping_susbst (univcst, subtypcst) = - let (ctx, ctx') = (halve_context (UContext.instance subtypcst)) in - Array.fold_left2 (fun subst l1 l2 -> LMap.add l1 l2 subst) LMap.empty ctx ctx' - end -type cumulativity_info = CumulativityInfo.t - module ACumulativityInfo = CumulativityInfo type abstract_cumulativity_info = ACumulativityInfo.t @@ -1242,7 +1252,17 @@ struct end type universe_context_set = ContextSet.t +(** Instance subtyping *) +let check_subtype univs ctxT ctx = + if AUContext.size ctx == AUContext.size ctx then + let (inst, cst) = AUContext.repr ctx in + let cstT = UContext.constraints (AUContext.repr ctxT) in + let push accu v = add_universe v false accu in + let univs = Array.fold_left push univs inst in + let univs = merge_constraints cstT univs in + check_constraints cst univs + else false (** Substitutions. *) @@ -1263,46 +1283,9 @@ let subst_univs_level_universe subst u = if u == u' then u else Universe.sort u' -(** Substitute instance inst for ctx in csts *) - -let subst_instance_level s l = - match l.Level.data with - | Level.Var n -> s.(n) - | _ -> l - -let subst_instance_instance s i = - Array.smartmap (fun l -> subst_instance_level s l) i - -let subst_instance_universe s u = - let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in - let u' = Universe.smartmap f u in - if u == u' then u - else Universe.sort u' - -let subst_instance_constraint s (u,d,v as c) = - let u' = subst_instance_level s u in - let v' = subst_instance_level s v in - if u' == u && v' == v then c - else (u',d,v') - -let subst_instance_constraints s csts = - Constraint.fold - (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) - csts Constraint.empty - -let subst_instance_context inst (inner_inst, inner_constr) = - (inner_inst, subst_instance_constraints inst inner_constr) - let make_abstract_instance (ctx, _) = Array.mapi (fun i l -> Level.var i) ctx -(** Substitute instance inst for ctx in csts *) -let instantiate_univ_context (ctx, csts) = - (ctx, subst_instance_constraints ctx csts) - -let instantiate_cumulativity_info (ctx, ctx') = - (instantiate_univ_context ctx, instantiate_univ_context ctx') - (** With level to universe substitutions. *) type universe_subst_fn = universe_level -> universe diff --git a/checker/univ.mli b/checker/univ.mli index a503924708..0a21019b1b 100644 --- a/checker/univ.mli +++ b/checker/univ.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,7 +18,9 @@ sig (** Create a new universe level from a unique identifier and an associated module path. *) - val pr : t -> Pp.std_ppcmds + val var : int -> t + + val pr : t -> Pp.t (** Pretty-printing *) val equal : t -> t -> bool @@ -51,7 +53,7 @@ type universe = Universe.t (** Alias name. *) -val pr_uni : universe -> Pp.std_ppcmds +val pr_uni : universe -> Pp.t (** The universes hierarchy: Type 0- = Prop <= Type 0 = Set <= Type 1 <= ... Typing of universes: Type 0-, Type 0 : Type 1; Type i : Type (i+1) if i>0 *) @@ -170,7 +172,7 @@ sig val subst : universe_level_subst -> t -> t (** Substitution by a level-to-level function. *) - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t (** Pretty-printing, no comments *) val check_eq : t check_function @@ -179,6 +181,8 @@ sig val length : t -> int (** Compute the length of the instance *) + val of_array : Level.t array -> t + val append : t -> t -> t (** Append two universe instances *) end @@ -208,32 +212,14 @@ module AUContext : sig type t - val instance : t -> Instance.t - -end - -type abstract_universe_context = AUContext.t - -module CumulativityInfo : -sig - type t - - val make : universe_context * universe_context -> t - - val empty : t - - val univ_context : t -> universe_context - val subtyp_context : t -> universe_context - - val from_universe_context : universe_context -> universe_instance -> t + val size : t -> int - val subtyping_other_instance : t -> universe_instance - - val subtyping_susbst : t -> universe_level_subst + val instantiate : Instance.t -> t -> Constraint.t + val repr : t -> UContext.t end -type cumulativity_info = CumulativityInfo.t +type abstract_universe_context = AUContext.t module ACumulativityInfo : sig @@ -276,22 +262,20 @@ val subst_univs_universe : universe_subst_fn -> universe -> universe (** Substitution of instances *) val subst_instance_instance : universe_instance -> universe_instance -> universe_instance val subst_instance_universe : universe_instance -> universe -> universe -val subst_instance_context : universe_instance -> abstract_universe_context -> universe_context (* val make_instance_subst : universe_instance -> universe_level_subst *) (* val make_inverse_instance_subst : universe_instance -> universe_level_subst *) -(** Get the instantiated graph. *) -val instantiate_univ_context : abstract_universe_context -> universe_context -val instantiate_cumulativity_info : abstract_cumulativity_info -> cumulativity_info - (** Build the relative instance corresponding to the context *) val make_abstract_instance : abstract_universe_context -> universe_instance - + +(** Check instance subtyping *) +val check_subtype : universes -> AUContext.t -> AUContext.t -> bool + (** {6 Pretty-printing of universes. } *) -val pr_constraint_type : constraint_type -> Pp.std_ppcmds -val pr_constraints : (Level.t -> Pp.std_ppcmds) -> constraints -> Pp.std_ppcmds -val pr_universe_context : (Level.t -> Pp.std_ppcmds) -> universe_context -> Pp.std_ppcmds +val pr_constraint_type : constraint_type -> Pp.t +val pr_constraints : (Level.t -> Pp.t) -> constraints -> Pp.t +val pr_universe_context : (Level.t -> Pp.t) -> universe_context -> Pp.t -val pr_universes : universes -> Pp.std_ppcmds +val pr_universes : universes -> Pp.t diff --git a/checker/validate.ml b/checker/validate.ml index c434ef09d3..8200405878 100644 --- a/checker/validate.ml +++ b/checker/validate.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/checker/values.ml b/checker/values.ml index b8b395aaf7..c95c3f1b2b 100644 --- a/checker/values.ml +++ b/checker/values.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,7 @@ To ensure this file is up-to-date, 'make' now compares the md5 of cic.mli with a copy we maintain here: -MD5 b132075590daf5e202de0d9cc34e6003 checker/cic.mli +MD5 c802f941f368bedd96e931cda0559d67 checker/cic.mli *) @@ -201,9 +201,6 @@ let v_engagement = v_impredicative_set let v_pol_arity = v_tuple "polymorphic_arity" [|List(Opt v_level);v_univ|] -let v_cst_type = - v_sum "constant_type" 0 [|[|v_constr|]; [|v_pair v_rctxt v_pol_arity|]|] - let v_cst_def = v_sum "constant_def" 0 [|[|Opt Int|]; [|v_cstr_subst|]; [|v_lazy_constr|]|] @@ -222,7 +219,7 @@ let v_const_univs = v_sum "constant_universes" 0 [|[|v_context|]; [|v_abs_contex let v_cb = v_tuple "constant_body" [|v_section_ctxt; v_cst_def; - v_cst_type; + v_constr; Any; v_const_univs; Opt v_projbody; diff --git a/checker/votour.ml b/checker/votour.ml index c255e5cdb2..0998bb94b1 100644 --- a/checker/votour.ml +++ b/checker/votour.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/config/coq_config.mli b/config/coq_config.mli index 3f7b65c395..b0f39e9d28 100644 --- a/config/coq_config.mli +++ b/config/coq_config.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -3,7 +3,7 @@ ## This micro-configure shell script is here only to ## launch the real configuration via ocaml -cmd=ocaml +ocaml=ocaml script=./configure.ml if [ ! -f $script ]; then @@ -16,17 +16,18 @@ fi ## Parse the args, only looking for -camldir ## We avoid using shift to keep "$@" intact +cmd=$ocaml last= for i; do case $last in - -camldir|--camldir) cmd="$i/ocaml"; break;; + -camldir) cmd="$i/$ocaml"; break;; esac last=$i done ## We check that $cmd is ok before the real exec $cmd -`$cmd -version > /dev/null 2>&1` && exec $cmd $script "$@" +`$cmd -version > /dev/null 2>&1` && exec $cmd -w "-3" $script "$@" ## If we're still here, something is wrong with $cmd diff --git a/configure.ml b/configure.ml index 549b32772b..4eac8eaccf 100644 --- a/configure.ml +++ b/configure.ml @@ -11,7 +11,7 @@ #load "str.cma" open Printf -let coq_version = "trunk" +let coq_version = "8.7+alpha" let coq_macos_version = "8.6.90" (** "[...] should be a string comprised of three non-negative, period-separated integers [...]" *) let vo_magic = 8691 @@ -300,27 +300,17 @@ let args_options = Arg.align [ "<dir> Where to install doc files"; "-emacslib", arg_string_option Prefs.emacslib, "<dir> Where to install emacs files"; - "-emacs", Arg.String (fun s -> - prerr_endline "Warning: -emacs option is deprecated. Use -emacslib instead."; - Prefs.emacslib := Some s), - "<dir> Deprecated: same as -emacslib"; "-coqdocdir", arg_string_option Prefs.coqdocdir, "<dir> Where to install Coqdoc style files"; "-ocamlfind", arg_string_option Prefs.ocamlfindcmd, "<dir> Specifies the ocamlfind command to use"; "-lablgtkdir", arg_string_option Prefs.lablgtkdir, "<dir> Specifies the path to the Lablgtk library"; - "-usecamlp5", Arg.Unit (fun () -> - prerr_endline "Warning: -usecamlp5 option is deprecated. Camlp5 is already a required dependency."), - " Deprecated: Camlp5 is a required dependency (Camlp4 is not supported anymore)"; "-camlp5dir", Arg.String (fun s -> Prefs.camlp5dir:=Some s), "<dir> Specifies where is the Camlp5 library and tells to use it"; "-arch", arg_string_option Prefs.arch, "<arch> Specifies the architecture"; - "-opt", Arg.Unit (fun () -> - prerr_endline "Warning: -opt option is deprecated. Native OCaml executables are detected automatically."), - " Deprecated: native OCaml executables detected automatically"; "-natdynlink", arg_bool Prefs.natdynlink, "(yes|no) Use dynamic loading of native code or not"; "-coqide", Arg.String (fun s -> Prefs.coqide := Some (get_ide s)), @@ -329,33 +319,18 @@ let args_options = Arg.align [ " Do not try to build CoqIDE MacOS integration"; "-browser", arg_string_option Prefs.browser, "<command> Use <command> to open URL %s"; - "-nodoc", Arg.Unit (fun () -> - prerr_endline "Warning: -nodoc option is deprecated. Use -with-doc no instead."; - Prefs.withdoc := false), - " Deprecated: use -with-doc no instead"; "-with-doc", arg_bool Prefs.withdoc, "(yes|no) Compile the documentation or not"; "-with-geoproof", arg_bool Prefs.geoproof, "(yes|no) Use Geoproof binding or not"; "-byte-only", Arg.Set Prefs.byteonly, " Compiles only bytecode version of Coq"; - "-byteonly", Arg.Unit (fun () -> - prerr_endline "Warning: -byteonly option is deprecated. Use -byte-only instead."; - Prefs.byteonly := true), - " Deprecated: use -byte-only instead"; - "-debug", Arg.Unit (fun () -> - prerr_endline "Warning: -debug option is deprecated. Coq is compiled in debug mode by default."; - Prefs.debug := true), - " Deprecated: Coq is compiled in debug mode by default"; "-nodebug", Arg.Clear Prefs.debug, " Do not add debugging information in the Coq executables"; "-profile", Arg.Set Prefs.profile, " Add profiling information in the Coq executables"; "-annotate", Arg.Set Prefs.annotate, " Dumps ml annotation files while compiling Coq"; - "-makecmd", Arg.String (fun _ -> - prerr_endline "Warning: -makecmd option is deprecated and doesn't have any effect."), - "<command> Deprecated"; "-native-compiler", arg_bool Prefs.nativecompiler, "(yes|no) Compilation to native code for conversion and normalization"; "-coqwebsite", Arg.Set_string Prefs.coqwebsite, @@ -364,6 +339,8 @@ let args_options = Arg.align [ " Force OCaml version"; "-warn-error", Arg.Set Prefs.warn_error, " Make OCaml warnings into errors"; + "-camldir", Arg.String (fun _ -> ()), + "<dir> Specifies path to 'ocaml' for running configure script"; ] let parse_args () = diff --git a/dev/base_include b/dev/base_include index 8ee1cceb23..79ecd73e0d 100644 --- a/dev/base_include +++ b/dev/base_include @@ -194,8 +194,8 @@ let qid = Libnames.qualid_of_string;; (* parsing of terms *) let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;; -let parse_tac = Pcoq.parse_string Ltac_plugin.Pltac.tactic;; let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;; +let parse_tac = API.Pcoq.parse_string Ltac_plugin.Pltac.tactic;; (* build a term of type glob_constr without type-checking or resolution of implicit syntax *) @@ -215,7 +215,7 @@ open Declareops;; let constbody_of_string s = let b = Global.lookup_constant (Nametab.locate_constant (qualid_of_string s)) in - Option.get (Declareops.body_of_constant Opaqueproof.empty_opaquetab b);; + Option.get (Global.body_of_constant_body b);; (* Get the current goal *) (* diff --git a/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat index bdcb01db92..9dbce1920f 100644 --- a/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat +++ b/dev/build/windows/MakeCoq_84pl6_abs_ocaml.bat @@ -1,3 +1,16 @@ +@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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
call MakeCoq_MinGW.bat ^
@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^ -ocaml=Y ^
-make=Y ^
-coqver=8.4pl6 ^
- -destcyg=%ROOTPATH%\cygwin_coq64_84pl6_abs ^
- -destcoq=%ROOTPATH%\coq64_84pl6_abs
+ -destcyg="%ROOTPATH%\cygwin_coq64_84pl6_abs" ^
+ -destcoq="%ROOTPATH%\coq64_84pl6_abs"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_84pl6_abs_ocaml.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat index 2e4a692e9c..7faf3e9ce1 100644 --- a/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat +++ b/dev/build/windows/MakeCoq_85pl2_abs_ocaml.bat @@ -1,3 +1,16 @@ +@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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
call MakeCoq_MinGW.bat ^
@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^ -ocaml=Y ^
-make=Y ^
-coqver=8.5pl2 ^
- -destcyg=%ROOTPATH%\cygwin_coq64_85pl2_abs ^
- -destcoq=%ROOTPATH%\coq64_85pl2_abs
+ -destcyg="%ROOTPATH%\cygwin_coq64_85pl2_abs" ^
+ -destcoq="%ROOTPATH%\coq64_85pl2_abs"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_85pl2_abs_ocaml.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat index 6e4e440a2c..b719b14c53 100644 --- a/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat +++ b/dev/build/windows/MakeCoq_85pl3_abs_ocaml.bat @@ -1,3 +1,16 @@ +@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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
call MakeCoq_MinGW.bat ^
@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^ -ocaml=Y ^
-make=Y ^
-coqver=8.5pl3 ^
- -destcyg=%ROOTPATH%\cygwin_coq64_85pl3_abs ^
- -destcoq=%ROOTPATH%\coq64_85pl3_abs
+ -destcyg="%ROOTPATH%\cygwin_coq64_85pl3_abs" ^
+ -destcoq="%ROOTPATH%\coq64_85pl3_abs"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_85pl3_abs_ocaml.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_85pl3_installer.bat b/dev/build/windows/MakeCoq_85pl3_installer.bat index c305e2f52d..a9f4e2da2e 100644 --- a/dev/build/windows/MakeCoq_85pl3_installer.bat +++ b/dev/build/windows/MakeCoq_85pl3_installer.bat @@ -1,8 +1,26 @@ +@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 ========== BUILD COQ ==========
+
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
+ -destcyg="%ROOTPATH%\cygwin_coq64_85pl3_inst" ^
+ -destcoq="%ROOTPATH%\coq64_85pl3_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_85pl3_installer.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_85pl3_installer_32.bat b/dev/build/windows/MakeCoq_85pl3_installer_32.bat index d87ff59197..ef593cc63a 100644 --- a/dev/build/windows/MakeCoq_85pl3_installer_32.bat +++ b/dev/build/windows/MakeCoq_85pl3_installer_32.bat @@ -1,8 +1,26 @@ +@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 ========== BUILD COQ ==========
+
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
+ -destcyg="%ROOTPATH%\cygwin_coq32_85pl3_inst" ^
+ -destcoq="%ROOTPATH%\coq32_85pl3_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_85pl3_installer_32.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat index f1d855a028..99a1f156b0 100644 --- a/dev/build/windows/MakeCoq_86git_abs_ocaml.bat +++ b/dev/build/windows/MakeCoq_86git_abs_ocaml.bat @@ -1,3 +1,16 @@ +@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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
call MakeCoq_MinGW.bat ^
@@ -6,5 +19,10 @@ call MakeCoq_MinGW.bat ^ -ocaml=Y ^
-make=Y ^
-coqver=git-v8.6 ^
- -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs ^
- -destcoq=%ROOTPATH%\coq64_86git_abs
+ -destcyg="%ROOTPATH%\cygwin_coq64_86git_abs" ^
+ -destcoq="%ROOTPATH%\coq64_86git_abs"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_abs_ocaml.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat index 70ab42bc36..896d1cd633 100644 --- a/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat +++ b/dev/build/windows/MakeCoq_86git_abs_ocaml_gtksrc.bat @@ -1,3 +1,16 @@ +@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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
call MakeCoq_MinGW.bat ^
@@ -7,5 +20,10 @@ call MakeCoq_MinGW.bat ^ -make=Y ^
-gtksrc=Y ^
-coqver=git-v8.6 ^
- -destcyg=%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc ^
- -destcoq=%ROOTPATH%\coq64_86git_abs_gtksrc
+ -destcyg="%ROOTPATH%\cygwin_coq64_86git_abs_gtksrc" ^
+ -destcoq="%ROOTPATH%\coq64_86git_abs_gtksrc"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_abs_ocaml_gtksrc.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_86git_installer.bat b/dev/build/windows/MakeCoq_86git_installer.bat index 40506318e1..c4823103f1 100644 --- a/dev/build/windows/MakeCoq_86git_installer.bat +++ b/dev/build/windows/MakeCoq_86git_installer.bat @@ -1,8 +1,26 @@ +@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 ========== BUILD COQ ==========
+
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
+ -destcyg="%ROOTPATH%\cygwin_coq64_86git_inst" ^
+ -destcoq="%ROOTPATH%\coq64_86git_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_installer.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_86git_installer_32.bat b/dev/build/windows/MakeCoq_86git_installer_32.bat index b9127c9454..19146c96c9 100644 --- a/dev/build/windows/MakeCoq_86git_installer_32.bat +++ b/dev/build/windows/MakeCoq_86git_installer_32.bat @@ -1,8 +1,26 @@ +@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 ========== BUILD COQ ==========
+
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
+ -destcyg="%ROOTPATH%\cygwin_coq32_86git_inst" ^
+ -destcoq="%ROOTPATH%\coq32_86git_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_installer_32.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat b/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat new file mode 100755 index 0000000000..cf6cafaa02 --- /dev/null +++ b/dev/build/windows/MakeCoq_86git_installer_cyglocal.bat @@ -0,0 +1,27 @@ +@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 ========== BUILD COQ ==========
+
+call MakeCoq_SetRootPath
+
+call MakeCoq_MinGW.bat ^
+ -arch=64 ^
+ -installer=Y ^
+ -coqver=git-v8.6 ^
+ -cyglocal=Y ^
+ -destcyg="%ROOTPATH%\cygwin_coq64_86git_inst_cyglocal" ^
+ -destcoq="%ROOTPATH%\coq64_86git_inst_cyglocal"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_installer_cyglocal.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_MinGW.bat b/dev/build/windows/MakeCoq_MinGW.bat index 1e08cc5a3c..b2efe2ddd4 100644 --- a/dev/build/windows/MakeCoq_MinGW.bat +++ b/dev/build/windows/MakeCoq_MinGW.bat @@ -18,7 +18,7 @@ REM ========== DEFAULT VALUES FOR PARAMETERS ========== REM For a description of all parameters, see ReadMe.txt -SET BATCHFILE=%0 +SET BATCHFILE=%~0 SET BATCHDIR=%~dp0 REM see -arch in ReadMe.txt, but values are x86_64 or i686 (not 64 or 32) @@ -47,9 +47,11 @@ SET SETUP=setup-x86_64.exe REM see -proxy in ReadMe.txt IF DEFINED HTTP_PROXY ( - SET PROXY="%HTTP_PROXY:http://=%" + SET PROXY=%HTTP_PROXY:http://=% ) else ( - SET PROXY="" + REM One can't set a variable to empty in DOS, but you can set it to a space this way. + REM The quotes are just there to make the space visible and to protect from "remove trailing spaces". + SET "PROXY= " ) REM see -cygrepo in ReadMe.txt @@ -82,12 +84,12 @@ SHIFT :Parse -IF "%0" == "-arch" ( - IF "%1" == "32" ( +IF "%~0" == "-arch" ( + IF "%~1" == "32" ( SET ARCH=i686 SET SETUP=setup-x86.exe ) ELSE ( - IF "%1" == "64" ( + IF "%~1" == "64" ( SET ARCH=x86_64 SET SETUP=setup-x86_64.exe ) ELSE ( @@ -100,15 +102,15 @@ IF "%0" == "-arch" ( GOTO Parse ) -IF "%0" == "-mode" ( - IF "%1" == "mingwincygwin" ( - SET INSTALLMODE=%1 +IF "%~0" == "-mode" ( + IF "%~1" == "mingwincygwin" ( + SET INSTALLMODE=%~1 ) ELSE ( - IF "%1" == "absolute" ( - SET INSTALLMODE=%1 + IF "%~1" == "absolute" ( + SET INSTALLMODE=%~1 ) ELSE ( - IF "%1" == "relocatable" ( - SET INSTALLMODE=%1 + IF "%~1" == "relocatable" ( + SET INSTALLMODE=%~1 ) ELSE ( ECHO "Invalid -mode, valid are mingwincygwin, absolute and relocatable" GOTO :EOF @@ -120,118 +122,124 @@ IF "%0" == "-mode" ( GOTO Parse ) -IF "%0" == "-installer" ( - SET MAKEINSTALLER=%1 +IF "%~0" == "-installer" ( + SET MAKEINSTALLER=%~1 + CALL :CheckYN -installer %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-ocaml" ( - SET INSTALLOCAML=%1 +IF "%~0" == "-ocaml" ( + SET INSTALLOCAML=%~1 + CALL :CheckYN -installer %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-make" ( - SET INSTALLMAKE=%1 +IF "%~0" == "-make" ( + SET INSTALLMAKE=%~1 + CALL :CheckYN -installer %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-destcyg" ( - SET DESTCYG=%1 +IF "%~0" == "-destcyg" ( + SET DESTCYG=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-destcoq" ( - SET DESTCOQ=%1 +IF "%~0" == "-destcoq" ( + SET DESTCOQ=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-setup" ( - SET SETUP=%1 +IF "%~0" == "-setup" ( + SET SETUP=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-proxy" ( - SET PROXY="%1" +IF "%~0" == "-proxy" ( + SET PROXY=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-cygrepo" ( - SET CYGWIN_REPOSITORY="%1" +IF "%~0" == "-cygrepo" ( + SET CYGWIN_REPOSITORY=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-cygcache" ( - SET CYGWIN_LOCAL_CACHE_WFMT="%1" +IF "%~0" == "-cygcache" ( + SET CYGWIN_LOCAL_CACHE_WFMT=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-cyglocal" ( - SET CYGWIN_FROM_CACHE=%1 +IF "%~0" == "-cyglocal" ( + SET CYGWIN_FROM_CACHE=%~1 + CALL :CheckYN -cyglocal %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-cygquiet" ( - SET CYGWIN_QUIET=%1 +IF "%~0" == "-cygquiet" ( + SET CYGWIN_QUIET=%~1 + CALL :CheckYN -cygquiet %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-srccache" ( - SET SOURCE_LOCAL_CACHE_WFMT="%1" +IF "%~0" == "-srccache" ( + SET SOURCE_LOCAL_CACHE_WFMT=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-coqver" ( - SET COQ_VERSION=%1 +IF "%~0" == "-coqver" ( + SET COQ_VERSION=%~1 SHIFT SHIFT GOTO Parse ) -IF "%0" == "-gtksrc" ( - SET GTK_FROM_SOURCES=%1 +IF "%~0" == "-gtksrc" ( + SET GTK_FROM_SOURCES=%~1 + CALL :CheckYN -gtksrc %~1 || GOTO ErrorExit SHIFT SHIFT GOTO Parse ) -IF "%0" == "-threads" ( - SET MAKE_THREADS=%1 +IF "%~0" == "-threads" ( + SET MAKE_THREADS=%~1 SHIFT SHIFT GOTO Parse ) -IF NOT "%0" == "" ( +IF NOT "%~0" == "" ( ECHO Install cygwin and download, compile and install OCaml and Coq for MinGW - ECHO !!! Illegal parameter %0 + ECHO !!! Illegal parameter %~0 ECHO Usage: ECHO MakeCoq_MinGW CALL :PrintPars - goto :EOF + GOTO :EOF ) IF NOT EXIST %SETUP% ( @@ -255,7 +263,7 @@ 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) +IF "%COQREGTESTING%"=="Y" (GOTO DontAsk) SET /p ANSWER=Is this correct? y/n IF NOT "%ANSWER%"=="y" (GOTO :EOF) :DontAsk @@ -325,7 +333,7 @@ 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 +if exist "%LOGFILE%" GOTO logfileloop REM Run Cygwin Setup @@ -339,10 +347,10 @@ IF NOT "%CYGWIN_QUIET%" == "Y" ( IF "%RUNSETUP%"=="Y" ( %SETUP% ^ - --proxy %PROXY% ^ - --site %CYGWIN_REPOSITORY% ^ - --root %CYGWIN_INSTALLDIR_WFMT% ^ - --local-package-dir %CYGWIN_LOCAL_CACHE_WFMT% ^ + --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 ^ @@ -359,11 +367,11 @@ IF "%RUNSETUP%"=="Y" ( -P libtool,automake ^ -P intltool ^ > "%LOGFILE%" ^ - || GOTO :Error + || GOTO ErrorExit - MKDIR %CYGWIN_INSTALLDIR_WFMT%\build - MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs - MOVE "%LOGFILE%" %CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log || GOTO :Error + MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build" + MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build\buildlogs" + MOVE "%LOGFILE%" "%CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log" || GOTO ErrorExit ) @@ -377,18 +385,18 @@ IF NOT "%CYGWIN_QUIET%" == "Y" ( 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 +copy "%BATCHDIR%\configure_profile.sh" "%CYGWIN_INSTALLDIR_WFMT%\var\tmp" || GOTO ErrorExit +%BASH% --login "%CYGWIN_INSTALLDIR_CFMT%\var\tmp\configure_profile.sh" "%PROXY%" || GOTO ErrorExit ECHO ========== BUILD COQ ========== -MKDIR %CYGWIN_INSTALLDIR_WFMT%\build -MKDIR %CYGWIN_INSTALLDIR_WFMT%\build\patches +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 +COPY "%BATCHDIR%\makecoq_mingw.sh" "%CYGWIN_INSTALLDIR_WFMT%\build" || GOTO ErrorExit +COPY "%BATCHDIR%\patches_coq\*.*" "%CYGWIN_INSTALLDIR_WFMT%\build\patches" || GOTO ErrorExit -%BASH% --login %CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh || GOTO :Error +%BASH% --login "%CYGWIN_INSTALLDIR_CFMT%\build\makecoq_mingw.sh" || GOTO ErrorExit ECHO ========== FINISHED ========== @@ -440,6 +448,19 @@ ECHO ========== BATCH FUNCTIONS ========== ECHO -threads = %MAKE_THREADS% GOTO :EOF -:Error -ECHO Building Coq failed with error code %errorlevel% -EXIT /b %errorlevel% +:CheckYN + REM Reset errorlevel to 0 + CMD /c "EXIT /b 0" + IF "%2" == "Y" ( + REM OK Y + ) ELSE IF "%2" == "N" ( + REM OK N + ) ELSE ( + ECHO ERROR Parameter %1 must be Y or N, but is %2 + GOTO ErrorExit + ) + GOTO :EOF + +:ErrorExit + ECHO ERROR MakeCoq_MinGW.bat failed + EXIT /b 1 diff --git a/dev/build/windows/MakeCoq_SetRootPath.bat b/dev/build/windows/MakeCoq_SetRootPath.bat index 3a3711724f..bcb104772c 100644 --- a/dev/build/windows/MakeCoq_SetRootPath.bat +++ b/dev/build/windows/MakeCoq_SetRootPath.bat @@ -1,3 +1,14 @@ +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 ========== CHOOSE A SENSIBLE ROOT PATH ========== + @ ECHO OFF REM Figure out a root path for coq and cygwin diff --git a/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat b/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat new file mode 100755 index 0000000000..d7d3c5b9d3 --- /dev/null +++ b/dev/build/windows/MakeCoq_explicitcachefolders_installer.bat @@ -0,0 +1,28 @@ +@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 ========== BUILD COQ ==========
+
+call MakeCoq_SetRootPath
+
+call MakeCoq_MinGW.bat ^
+ -arch=64 ^
+ -installer=Y ^
+ -coqver=git-v8.6 ^
+ -destcyg="%ROOTPATH%\cygwin_coq64_cachefolder_inst" ^
+ -destcoq="%ROOTPATH%\coq64_cachefolder_inst" ^
+ -cygcache="%ROOTPATH%\cache\cygwin" ^
+ -srccache="%ROOTPATH%\cache\source"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_explicitcachefolders_installer.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_local_installer.bat b/dev/build/windows/MakeCoq_local_installer.bat new file mode 100755 index 0000000000..752b73c10a --- /dev/null +++ b/dev/build/windows/MakeCoq_local_installer.bat @@ -0,0 +1,26 @@ +@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 ========== BUILD COQ ==========
+
+call MakeCoq_SetRootPath
+
+call MakeCoq_MinGW.bat ^
+ -arch=64 ^
+ -installer=Y ^
+ -coqver=/cygdrive/d/coqgit/coq-8.6 ^
+ -destcyg="%ROOTPATH%\cygwin_coq64_local_inst" ^
+ -destcoq="%ROOTPATH%\coq64_local_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_local_installer.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/MakeCoq_regtest_noproxy.bat b/dev/build/windows/MakeCoq_regtest_noproxy.bat index 2b0b83fed5..7b17e721b3 100644 --- a/dev/build/windows/MakeCoq_regtest_noproxy.bat +++ b/dev/build/windows/MakeCoq_regtest_noproxy.bat @@ -1,7 +1,18 @@ +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 ========== BUILD COQ ==========
+
call MakeCoq_SetRootPath
SET HTTP_PROXY=
-EXPORT HTTP_PROXY=
+SET HTTPS_PROXY=
MKDIR C:\Temp\srccache
call MakeCoq_MinGW.bat ^
diff --git a/dev/build/windows/MakeCoq_regtests.bat b/dev/build/windows/MakeCoq_regtests.bat index 6e36d01404..74c26456b4 100644 --- a/dev/build/windows/MakeCoq_regtests.bat +++ b/dev/build/windows/MakeCoq_regtests.bat @@ -1,16 +1,36 @@ -SET COQREGTESTING=Y +REM ========== COPYRIGHT/COPYLEFT ========== -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 (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 ========== RUN REGRESSION TESTS FOR COQ BUILD SCRIPTS ========== + +SET COQREGTESTING=Y REM Current stable -call MakeCoq_85pl3_abs_ocaml.bat -call MakeCoq_85pl3_installer.bat -call MakeCoq_85pl3_installer_32.bat +call MakeCoq_86git_abs_ocaml.bat || GOTO Error +call MakeCoq_86git_installer.bat || GOTO Error +call MakeCoq_86git_installer_32.bat || GOTO Error REM Old but might still be used -call MakeCoq_85pl2_abs_ocaml.bat -call MakeCoq_84pl6_abs_ocaml.bat +call MakeCoq_85pl3_abs_ocaml.bat || GOTO Error +call MakeCoq_84pl6_abs_ocaml.bat || GOTO Error + +REM Special variants, e.g. for debugging +call MakeCoq_86git_abs_ocaml_gtksrc.bat || GOTO Error +call MakeCoq_local_installer.bat || GOTO Error +call MakeCoq_explicitcachefolders_installer.bat || GOTO Error + +REM Bleeding edge +call MakeCoq_trunk_installer.bat || GOTO Error + +ECHO MakeCoq_regtests.bat: All tests finished successfully +GOTO :EOF + +:Error +ECHO MakeCoq_regtests.bat failed with error code %ERRORLEVEL% +EXIT /b %ERRORLEVEL% diff --git a/dev/build/windows/MakeCoq_trunk_installer.bat b/dev/build/windows/MakeCoq_trunk_installer.bat new file mode 100755 index 0000000000..f4f5827328 --- /dev/null +++ b/dev/build/windows/MakeCoq_trunk_installer.bat @@ -0,0 +1,26 @@ +@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 ========== BUILD COQ ==========
+
+call MakeCoq_SetRootPath
+
+call MakeCoq_MinGW.bat ^
+ -arch=64 ^
+ -installer=Y ^
+ -coqver=git-trunk ^
+ -destcyg="%ROOTPATH%\cygwin_coq64_trunk_inst" ^
+ -destcoq="%ROOTPATH%\coq64_trunk_inst"
+
+IF %ERRORLEVEL% NEQ 0 (
+ ECHO MakeCoq_86git_installer.bat failed with error code %ERRORLEVEL%
+ EXIT /b %ERRORLEVEL%
+)
diff --git a/dev/build/windows/ReadMe.txt b/dev/build/windows/ReadMe.txt index 0faf5bc53f..a6d8e44622 100644 --- a/dev/build/windows/ReadMe.txt +++ b/dev/build/windows/ReadMe.txt @@ -1,3 +1,12 @@ +(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 + +This license also applies to all files in the patches_coq subfolder. + ==================== Purpose / Goal ==================== The main purpose of these scripts is to build Coq for Windows in a reproducible @@ -286,9 +295,16 @@ Default value: <folder of MakeCoq_MinGW.bat>\source_cache 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. +Possible values: 8.4pl6, 8.5pl2, 8.5pl3, 8.6 + (download from https://coq.inria.fr/distrib/V$COQ_VERSION/files/coq-<version>.tar.gz) + Others versions might work, but are untested. 8.4 is only tested in mode=absoloute + + git-v8.6, git-trunk + (download from https://github.com/coq/coq/archive/<version without git->.zip) + + /cygdrive/.... + Use local folder. The sources are archived as coq-local.tar.gz Default value: 8.5pl3 @@ -322,6 +338,8 @@ Possible values: 1..N. ==================== TODO ==================== +- Check for spaces in destination paths +- Check for = signs in all paths (DOS commands don't work with pathes with = in it, possibly even when quoted) - 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) diff --git a/dev/build/windows/appveyor.sh b/dev/build/windows/appveyor.sh new file mode 100644 index 0000000000..53f7a23466 --- /dev/null +++ b/dev/build/windows/appveyor.sh @@ -0,0 +1,8 @@ +#!/bin/bash +set -e -x +wget $opam_url +tar -xf opam64.tar.xz +bash opam64/install.sh +opam init -a mingw https://github.com/fdopen/opam-repository-mingw.git --comp 4.02.3+mingw64c --switch 4.02.3+mingw64c +eval $(opam config env) +opam install -y ocamlfind camlp5 diff --git a/dev/build/windows/configure_profile.sh b/dev/build/windows/configure_profile.sh index 09a9cf35a1..0b61a31e7f 100644 --- a/dev/build/windows/configure_profile.sh +++ b/dev/build/windows/configure_profile.sh @@ -1,5 +1,16 @@ #!/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 + +###################### CONFIGURE CYGWIN USER PROFILE FOR BUILDING COQ ###################### + rcfile=~/.bash_profile donefile=~/.bash_profile.upated @@ -7,7 +18,7 @@ if [ ! -f $donefile ] ; then echo >> $rcfile - if [ -n "$1" ]; then + if [ "$1" != "" -a "$1" != " " ]; then echo export http_proxy="http://$1" >> $rcfile echo export https_proxy="http://$1" >> $rcfile echo export ftp_proxy="http://$1" >> $rcfile diff --git a/dev/build/windows/difftar-folder.sh b/dev/build/windows/difftar-folder.sh index 65278d5c9c..cbcf14ec24 100644 --- a/dev/build/windows/difftar-folder.sh +++ b/dev/build/windows/difftar-folder.sh @@ -8,35 +8,28 @@ # 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 ###################### +###################### DIFF A TAR FILE AND A FOLDER ###################### set -o nounset # Print usage -if [ "$#" -lt 1 ] ; then +if [ "$#" -lt 2 ] ; then echo 'Diff a tar (or compressed tar) file with a folder' - echo 'difftar-folder.sh <tarfile> [<folder>] [strip]' - echo default for folder is . - echo default for strip is 0. - echo 'strip must be 0 or 1.' + echo 'difftar-folder.sh <tarfile> <folder> [strip]' + echo '<tarfile> is the name of the tar file do diff with (required)' + echo '<folder> is the name of the folder to diff with (required)' + echo '<strip> is the number of path components to strip from tar file (default is 0)' + echo 'All files in the tar file must have at least <strip> path components.' + echo 'This also adds new files from folder.new, if folder.new exists' exit 1 fi # Parse parameters tarfile=$1 - -if [ "$#" -ge 2 ] ; then - folder=$2 -else - folder=. -fi +folder=$2 if [ "$#" -ge 3 ] ; then strip=$3 @@ -47,27 +40,33 @@ fi # Get path prefix if --strip is used if [ "$strip" -gt 0 ] ; then - prefix=`tar -t -f $tarfile | head -1` + # Get the path/name of the first file from teh tar and extract the first $strip path components + # This assumes that the first file in the tar file has at least $strip many path components + prefix=$(tar -t -f $tarfile | head -1 | cut -d / -f -$strip)/ 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 +orig=$folder.orig mkdir -p "$orig" +# New amd empty filefolder + +new=$folder.new +empty=$folder.empty +mkdir -p "$empty" + +# Print information (this is ignored by patch) + +echo diff/patch file created on $(date) with: +echo difftar-folder.sh $@ +echo TARFILE= $tarfile +echo FOLDER= $folder +echo TARSTRIP= $strip +echo TARPREFIX= $prefix +echo ORIGFOLDER= $orig # Make sure tar uses english output (for Mod time differs) export LC_ALL=C @@ -83,4 +82,8 @@ tar --diff -a -f "$tarfile" --strip $strip --directory "$folder" | grep "Mod tim # Compute diff diff -u "$orig/$file" "$folder/$file" fi -done
\ No newline at end of file +done + +if [ -d "$new" ] ; then + diff -u -r --unidirectional-new-file $empty $new +fi diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh index 98e80c7652..e179239514 100644 --- a/dev/build/windows/makecoq_mingw.sh +++ b/dev/build/windows/makecoq_mingw.sh @@ -98,6 +98,8 @@ mkdir -p $TARBALLS mkdir -p $FILELISTS cd /build +# Create source cache folder +mkdir -p "$SOURCE_LOCAL_CACHE_CFMT" # sysroot prefix for the above /build/host/target combination PREFIX=$CYGWIN_INSTALLDIR_MFMT/usr/$TARGET_ARCH/sys-root/mingw @@ -112,9 +114,9 @@ else PREFIXOCAML=$PREFIX fi -mkdir -p $PREFIX/bin -mkdir -p $PREFIXCOQ/bin -mkdir -p $PREFIXOCAML/bin +mkdir -p "$PREFIX/bin" +mkdir -p "$PREFIXCOQ/bin" +mkdir -p "$PREFIXOCAML/bin" ###################### Copy Cygwin Setup Info ##################### @@ -128,7 +130,7 @@ 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 "$CYGWIN_LOCAL_CACHE_WFMT/$CYGWIN_REPO_FOLDER/$CYGWINARCH/setup.ini" $TARBALLS cp /etc/setup/installed.db $TARBALLS ###################### LOGGING ##################### @@ -158,6 +160,21 @@ logn() { "$@" > $LOGS/$LOGTARGET-$LOGTARGETEX.log 2> $LOGS/$LOGTARGET-$LOGTARGETEX.err } +###################### 'UNFIX' SED ##################### + +# In Cygwin SED used to do CR-LF to LF conversion, but since sed 4.4-1 this was changed +# We replace sed with a shell script which restores the old behavior for piped input + +#if [ -f /bin/sed.exe ] +#then +# mv /bin/sed.exe /bin/sed_orig.exe +#fi +#cat > /bin/sed << EOF +##!/bin/sh +#dos2unix | /bin/sed_orig.exe "$@" +#EOF +#chmod a+x /bin/sed + ###################### UTILITY FUNCTIONS ##################### # ------------------------------------------------------------------------------ @@ -202,8 +219,8 @@ function get_expand_source_tar { # 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 + 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 @@ -211,8 +228,8 @@ function get_expand_source_tar { 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 + if [ -d "$SOURCE_LOCAL_CACHE_CFMT" ] ; then + cp $TARBALLS/$name.$3 "$SOURCE_LOCAL_CACHE_CFMT" fi fi fi @@ -341,7 +358,7 @@ function build_post { 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}" + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix="$PREFIX" "${@:5}" log1 make $MAKE_OPT log2 make install log2 make clean @@ -388,7 +405,7 @@ function install_rec { function list_files { if [ ! -e "/build/filelists/$1" ] ; then - ( cd $PREFIXCOQ && find -type f | sort > /build/filelists/$1 ) + ( cd "$PREFIXCOQ" && find -type f | sort > /build/filelists/$1 ) fi } @@ -436,6 +453,18 @@ function files_to_nsis { ###################### MODULE BUILD FUNCTIONS ##################### +##### SED ##### + +function make_sed { + if build_prep https://ftp.gnu.org/gnu/sed/ sed-4.2.2 tar.gz ; then + logn configure ./configure + log1 make + log2 make install + log2 make clean + build_post + fi +} + ##### LIBPNG ##### function make_libpng { @@ -639,9 +668,9 @@ function make_libxml2 { # Note: latest release version 2.9.2 fails during configuring lzma, so using 2.9.1 # Note: python binding requires <sys/select.h> 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 + # ./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 + ./autogen.sh --build=$BUILD --host=$HOST --target=$TARGET --prefix="$PREFIX" --without-python log1 make $MAKE_OPT all log2 make install log2 make clean @@ -676,10 +705,10 @@ 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 + 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 + cp flexdll*_mingw64.o "$PREFIXOCAML/bin" else echo "Unknown target architecture" return 1 @@ -691,7 +720,7 @@ function install_flexdll { function install_flexlink { cp flexlink.exe /usr/$TARGET_ARCH/bin - cp flexlink.exe $PREFIXOCAML/bin + cp flexlink.exe "$PREFIXOCAML/bin" } # Get binary flexdll flexlink for building OCaml @@ -737,7 +766,7 @@ function make_ln { 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 + install -D ln.exe "$PREFIXCOQ/bin/ln.exe" cd .. touch flagfiles/myln.finished fi @@ -762,6 +791,7 @@ function make_ocaml { fi # Prefix is fixed in make file - replace it with the real one + # TODO: this might not work if PREFIX contains spaces 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 @@ -782,15 +812,15 @@ function make_ocaml { # Move license files and other into into special folder if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then - mkdir -p $PREFIXOCAML/license_readme/ocaml + 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 + 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 @@ -798,12 +828,28 @@ function make_ocaml { make_flex_dll_link } +##### OCAML EXTRA TOOLS ##### + +function make_ocaml_tools { + make_findlib + make_menhir + make_camlp5 +} + +##### OCAML EXTRA LIBRARIES ##### + +function make_ocaml_libs { + make_findlib + make_lablgtk + make_stdint +} + ##### 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 + logn configure ./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 @@ -824,9 +870,9 @@ function make_menhir { # 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 + log2 make all PREFIX="$PREFIXOCAML" + log2 make install PREFIX="$PREFIXOCAML" + mv "$PREFIXOCAML/bin/menhir" "$PREFIXOCAML/bin/menhir.exe" build_post fi } @@ -863,7 +909,7 @@ function make_camlp5 { 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/ + cp lib/gramlib.a "$PREFIXOCAML/libocaml/camlp5/" log2 make clean build_post fi @@ -878,11 +924,13 @@ function make_camlp5 { function make_lablgtk { make_ocaml make_findlib - make_camlp4 + make_camlp4 # required by lablgtk-2.18.3 and lablgtk-2.18.5 + make_gtk2 + make_gtk_sourceview2 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 + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix="$PREFIXOCAML" # lablgtk shows occasional errors with -j, so don't pass $MAKE_OPT @@ -920,7 +968,7 @@ function make_stdint { function copy_coq_dll { if [ "$INSTALLMODE" == "absolute" ] || [ "$INSTALLMODE" == "relocatable" ]; then - cp /usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1 $PREFIXCOQ/bin/$1 + cp /usr/${ARCH}-w64-mingw32/sys-root/mingw/bin/$1 "$PREFIXCOQ/bin/$1" fi } @@ -954,6 +1002,7 @@ function copy_coq_dlls { 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 libpcre-1.dll copy_coq_dll LIBPIXMAN-1-0.DLL copy_coq_dll LIBPNG16-16.DLL copy_coq_dll LIBXML2-2.DLL @@ -962,7 +1011,6 @@ function copy_coq_dlls { # 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 @@ -986,13 +1034,13 @@ function copy_coq_dlls { 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 + 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 } @@ -1000,23 +1048,23 @@ function copy_coq_objects { # 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 + 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 + 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 + 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 + mkdir -p "$PREFIXCOQ/ide" + mv "$PREFIXCOQ/share/coq/"*.png "$PREFIXCOQ/ide" + rmdir "$PREFIXCOQ/share/coq" fi } @@ -1024,16 +1072,17 @@ function copq_coq_gtk { 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.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 + 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" || true + 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 } @@ -1043,19 +1092,38 @@ function make_coq { make_ocaml make_lablgtk make_camlp5 - if + 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 ;; + # e.g. git-v8.6 => download from https://github.com/coq/coq/archive/v8.6.zip + # e.g. git-trunk => download from https://github.com/coq/coq/archive/trunk.zip + git-*) + COQ_BUILD_PATH=/build/coq-${COQ_VERSION} + build_prep https://github.com/coq/coq/archive ${COQ_VERSION##git-} zip 1 coq-${COQ_VERSION} + ;; + + # e.g. /cygdrive/d/coqgit + /*) + # Todo: --exclude-vcs-ignores doesn't work because tools/coqdoc/coqdoc.sty is excluded => fix .gitignore + # But this is not a big deal, only 2 files are removed with --exclude-vcs-ignores from a fresch clone + COQ_BUILD_PATH=/build/coq-local + tar -zcf $TARBALLS/coq-local.tar.gz --exclude-vcs -C "${COQ_VERSION%/*}" "${COQ_VERSION##*/}" + build_prep NEVER-DOWNLOADED coq-local tar.gz + ;; + + # e.g. 8.6 => https://coq.inria.fr/distrib/8.6/files/coq-8.6.tar.gz + *) + COQ_BUILD_PATH=/build/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 + 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 + logn configure ./configure -debug -with-doc no -prefix "$PREFIXCOQ" fi # The windows resource compiler binary name is hard coded @@ -1070,7 +1138,7 @@ function make_coq { fi if [ "$INSTALLMODE" == "relocatable" ]; then - ./configure -debug -with-doc no -prefix $PREFIXCOQ -libdir $PREFIXCOQ/lib -mandir $PREFIXCOQ/man + logn reconfigure ./configure -debug -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib" -mandir "$PREFIXCOQ/man" fi log2 make install @@ -1101,7 +1169,7 @@ function make_mingw_make { # 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 + cp GccRel/gnumake.exe "$PREFIXCOQ/bin/make.exe" build_post fi } @@ -1110,7 +1178,7 @@ function make_mingw_make { 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- + logn configure ./configure --build=$BUILD --host=$HOST --target=$TARGET --prefix="$PREFIXCOQ" --program-prefix=$TARGET- log1 make $MAKE_OPT log2 make install # log2 make clean @@ -1133,15 +1201,15 @@ function make_gcc { # 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 + 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 \ + --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 + # --with-sysroot="$PREFIX" results in configure error that this is not an absolute path log1 make $MAKE_OPT log2 make install # log2 make clean @@ -1176,14 +1244,14 @@ function get_cygwin_mingw_sources { # 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 + 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 + if [ -d "$SOURCE_LOCAL_CACHE_CFMT" ] ; then + cp $TARBALLS/$SOURCEFILE "$SOURCE_LOCAL_CACHE_CFMT" fi fi fi @@ -1199,7 +1267,7 @@ function get_cygwin_mingw_sources { function make_coq_installer { make_coq make_mingw_make - get_cygwin_mingw_sources + # 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 @@ -1230,14 +1298,14 @@ function make_coq_installer { NSIS=`pwd`/makensis.exe chmod u+x "$NSIS" # Change to Coq folder - cd ../coq-${COQ_VERSION} + cd $COQ_BUILD_PATH # 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` + VERSION=`grep '^VERSION=' config/Makefile | cut -d = -f 2 | tr -d '\r'` cd dev/nsis - logn nsis-installer "$NSIS" -DVERSION=$VERSION -DARCH=$ARCH -DCOQ_SRC_PATH=$PREFIXCOQ -DCOQ_ICON=..\\..\\ide\\coq.ico coq_new.nsi + logn nsis-installer "$NSIS" -DVERSION=$VERSION -DARCH=$ARCH -DCOQ_SRC_PATH="$PREFIXCOQ" -DCOQ_ICON=..\\..\\ide\\coq.ico coq_new.nsi build_post fi @@ -1245,17 +1313,13 @@ function make_coq_installer { ###################### TOP LEVEL BUILD ##################### -make_gtk2 -make_gtk_sourceview2 - +make_sed make_ocaml -make_findlib -make_lablgtk -make_camlp4 -make_camlp5 -make_menhir -make_stdint +make_ocaml_tools +make_ocaml_libs + list_files ocaml + make_coq if [ "$INSTALLMAKE" == "Y" ] ; then diff --git a/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch b/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch new file mode 100755 index 0000000000..d210a04153 --- /dev/null +++ b/dev/build/windows/patches_coq/sed-4.2.2-3.src.patch @@ -0,0 +1,1301 @@ +--- origsrc/sed-4.2.2/doc/sed.1 2012-12-22 15:27:13.000000000 +0100 ++++ src/sed-4.2.2/doc/sed.1 2013-06-27 18:10:47.974060492 +0200 +@@ -1,5 +1,5 @@ + .\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.28. +-.TH SED "1" "December 2012" "sed 4.2.2" "User Commands" ++.TH SED "1" "June 2013" "sed 4.2.2" "User Commands" + .SH NAME + sed \- stream editor for filtering and transforming text + .SH SYNOPSIS +@@ -40,6 +40,10 @@ follow symlinks when processing in place + .IP + edit files in place (makes backup if SUFFIX supplied) + .HP ++\fB\-b\fR, \fB\-\-binary\fR ++.IP ++open files in binary mode (CR+LFs are not processed specially) ++.HP + \fB\-l\fR N, \fB\-\-line\-length\fR=\fIN\fR + .IP + specify the desired line-wrap length for the `l' command +--- origsrc/sed-4.2.2/lib/regcomp.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regcomp.c 2013-06-27 18:05:27.044448044 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern, + size_t length, reg_syntax_t syntax); +@@ -95,20 +94,20 @@ static reg_errcode_t build_charclass (RE + bitset_t sbcset, + re_charset_t *mbcset, + Idx *char_class_alloc, +- const unsigned char *class_name, ++ const char *class_name, + reg_syntax_t syntax); + #else /* not RE_ENABLE_I18N */ + static reg_errcode_t build_equiv_class (bitset_t sbcset, + const unsigned char *name); + static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans, + bitset_t sbcset, +- const unsigned char *class_name, ++ const char *class_name, + reg_syntax_t syntax); + #endif /* not RE_ENABLE_I18N */ + static bin_tree_t *build_charclass_op (re_dfa_t *dfa, + RE_TRANSLATE_TYPE trans, +- const unsigned char *class_name, +- const unsigned char *extra, ++ const char *class_name, ++ const char *extra, + bool non_match, reg_errcode_t *err); + static bin_tree_t *create_tree (re_dfa_t *dfa, + bin_tree_t *left, bin_tree_t *right, +@@ -293,7 +292,7 @@ weak_alias (__re_compile_fastmap, re_com + #endif + + static inline void +-__attribute ((always_inline)) ++__attribute__ ((always_inline)) + re_set_fastmap (char *fastmap, bool icase, int ch) + { + fastmap[ch] = 1; +@@ -587,7 +586,7 @@ weak_alias (__regerror, regerror) + static const bitset_t utf8_sb_map = + { + /* Set the first 128 bits. */ +-# ifdef __GNUC__ ++# if defined __GNUC__ && !defined __STRICT_ANSI__ + [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX + # else + # if 4 * BITSET_WORD_BITS < ASCII_CHARS +@@ -664,7 +663,10 @@ regfree (preg) + { + re_dfa_t *dfa = preg->buffer; + if (BE (dfa != NULL, 1)) +- free_dfa_content (dfa); ++ { ++ lock_fini (dfa->lock); ++ free_dfa_content (dfa); ++ } + preg->buffer = NULL; + preg->allocated = 0; + +@@ -785,6 +787,8 @@ re_compile_internal (regex_t *preg, cons + preg->used = sizeof (re_dfa_t); + + err = init_dfa (dfa, length); ++ if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0)) ++ err = REG_ESPACE; + if (BE (err != REG_NOERROR, 0)) + { + free_dfa_content (dfa); +@@ -798,8 +802,6 @@ re_compile_internal (regex_t *preg, cons + strncpy (dfa->re_str, pattern, length + 1); + #endif + +- __libc_lock_init (dfa->lock); +- + err = re_string_construct (®exp, pattern, length, preg->translate, + (syntax & RE_ICASE) != 0, dfa); + if (BE (err != REG_NOERROR, 0)) +@@ -807,6 +809,7 @@ re_compile_internal (regex_t *preg, cons + re_compile_internal_free_return: + free_workarea_compile (preg); + re_string_destruct (®exp); ++ lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; +@@ -839,6 +842,7 @@ re_compile_internal (regex_t *preg, cons + + if (BE (err != REG_NOERROR, 0)) + { ++ lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; +@@ -954,10 +958,10 @@ static void + internal_function + init_word_char (re_dfa_t *dfa) + { +- dfa->word_ops_used = 1; + int i = 0; + int j; + int ch = 0; ++ dfa->word_ops_used = 1; + if (BE (dfa->map_notascii == 0, 1)) + { + bitset_word_t bits0 = 0x00000000; +@@ -2423,8 +2427,8 @@ parse_expression (re_string_t *regexp, r + case OP_WORD: + case OP_NOTWORD: + tree = build_charclass_op (dfa, regexp->trans, +- (const unsigned char *) "alnum", +- (const unsigned char *) "_", ++ "alnum", ++ "_", + token->type == OP_NOTWORD, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; +@@ -2432,8 +2436,8 @@ parse_expression (re_string_t *regexp, r + case OP_SPACE: + case OP_NOTSPACE: + tree = build_charclass_op (dfa, regexp->trans, +- (const unsigned char *) "space", +- (const unsigned char *) "", ++ "space", ++ "", + token->type == OP_NOTSPACE, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; +@@ -2713,7 +2717,6 @@ build_range_exp (const reg_syntax_t synt + wchar_t wc; + wint_t start_wc; + wint_t end_wc; +- wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'}; + + start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch + : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0] +@@ -2727,11 +2730,7 @@ build_range_exp (const reg_syntax_t synt + ? __btowc (end_ch) : end_elem->opr.wch); + if (start_wc == WEOF || end_wc == WEOF) + return REG_ECOLLATE; +- cmp_buf[0] = start_wc; +- cmp_buf[4] = end_wc; +- +- if (BE ((syntax & RE_NO_EMPTY_RANGES) +- && wcscoll (cmp_buf, cmp_buf + 4) > 0, 0)) ++ else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0)) + return REG_ERANGE; + + /* Got valid collation sequence values, add them as a new entry. +@@ -2772,9 +2771,7 @@ build_range_exp (const reg_syntax_t synt + /* Build the table for single byte characters. */ + for (wc = 0; wc < SBC_MAX; ++wc) + { +- cmp_buf[2] = wc; +- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0 +- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0) ++ if (start_wc <= wc && wc <= end_wc) + bitset_set (sbcset, wc); + } + } +@@ -2843,40 +2840,29 @@ parse_bracket_exp (re_string_t *regexp, + + /* Local function for parse_bracket_exp used in _LIBC environment. + Seek the collating symbol entry corresponding to NAME. +- Return the index of the symbol in the SYMB_TABLE. */ ++ Return the index of the symbol in the SYMB_TABLE, ++ or -1 if not found. */ + + auto inline int32_t +- __attribute ((always_inline)) +- seek_collating_symbol_entry (name, name_len) +- const unsigned char *name; +- size_t name_len; +- { +- int32_t hash = elem_hash ((const char *) name, name_len); +- int32_t elem = hash % table_size; +- if (symb_table[2 * elem] != 0) +- { +- int32_t second = hash % (table_size - 2) + 1; +- +- do +- { +- /* First compare the hashing value. */ +- if (symb_table[2 * elem] == hash +- /* Compare the length of the name. */ +- && name_len == extra[symb_table[2 * elem + 1]] +- /* Compare the name. */ +- && memcmp (name, &extra[symb_table[2 * elem + 1] + 1], +- name_len) == 0) +- { +- /* Yep, this is the entry. */ +- break; +- } ++ __attribute__ ((always_inline)) ++ seek_collating_symbol_entry (const unsigned char *name, size_t name_len) ++ { ++ int32_t elem; + +- /* Next entry. */ +- elem += second; +- } +- while (symb_table[2 * elem] != 0); +- } +- return elem; ++ for (elem = 0; elem < table_size; elem++) ++ if (symb_table[2 * elem] != 0) ++ { ++ int32_t idx = symb_table[2 * elem + 1]; ++ /* Skip the name of collating element name. */ ++ idx += 1 + extra[idx]; ++ if (/* Compare the length of the name. */ ++ name_len == extra[idx] ++ /* Compare the name. */ ++ && memcmp (name, &extra[idx + 1], name_len) == 0) ++ /* Yep, this is the entry. */ ++ return elem; ++ } ++ return -1; + } + + /* Local function for parse_bracket_exp used in _LIBC environment. +@@ -2884,9 +2870,8 @@ parse_bracket_exp (re_string_t *regexp, + Return the value if succeeded, UINT_MAX otherwise. */ + + auto inline unsigned int +- __attribute ((always_inline)) +- lookup_collation_sequence_value (br_elem) +- bracket_elem_t *br_elem; ++ __attribute__ ((always_inline)) ++ lookup_collation_sequence_value (bracket_elem_t *br_elem) + { + if (br_elem->type == SB_CHAR) + { +@@ -2914,7 +2899,7 @@ parse_bracket_exp (re_string_t *regexp, + int32_t elem, idx; + elem = seek_collating_symbol_entry (br_elem->opr.name, + sym_name_len); +- if (symb_table[2 * elem] != 0) ++ if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; +@@ -2932,7 +2917,7 @@ parse_bracket_exp (re_string_t *regexp, + /* Return the collation sequence value. */ + return *(unsigned int *) (extra + idx); + } +- else if (symb_table[2 * elem] == 0 && sym_name_len == 1) ++ else if (sym_name_len == 1) + { + /* No valid character. Match it as a single byte + character. */ +@@ -2953,12 +2938,9 @@ parse_bracket_exp (re_string_t *regexp, + update it. */ + + auto inline reg_errcode_t +- __attribute ((always_inline)) +- build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem) +- re_charset_t *mbcset; +- Idx *range_alloc; +- bitset_t sbcset; +- bracket_elem_t *start_elem, *end_elem; ++ __attribute__ ((always_inline)) ++ build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc, ++ bracket_elem_t *start_elem, bracket_elem_t *end_elem) + { + unsigned int ch; + uint32_t start_collseq; +@@ -2971,6 +2953,7 @@ parse_bracket_exp (re_string_t *regexp, + 0)) + return REG_ERANGE; + ++ /* FIXME: Implement rational ranges here, too. */ + start_collseq = lookup_collation_sequence_value (start_elem); + end_collseq = lookup_collation_sequence_value (end_elem); + /* Check start/end collation sequence values. */ +@@ -3036,26 +3019,23 @@ parse_bracket_exp (re_string_t *regexp, + pointer argument since we may update it. */ + + auto inline reg_errcode_t +- __attribute ((always_inline)) +- build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name) +- re_charset_t *mbcset; +- Idx *coll_sym_alloc; +- bitset_t sbcset; +- const unsigned char *name; ++ __attribute__ ((always_inline)) ++ build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset, ++ Idx *coll_sym_alloc, const unsigned char *name) + { + int32_t elem, idx; + size_t name_len = strlen ((const char *) name); + if (nrules != 0) + { + elem = seek_collating_symbol_entry (name, name_len); +- if (symb_table[2 * elem] != 0) ++ if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; + /* Skip the name of collating element name. */ + idx += 1 + extra[idx]; + } +- else if (symb_table[2 * elem] == 0 && name_len == 1) ++ else if (name_len == 1) + { + /* No valid character, treat it as a normal + character. */ +@@ -3298,7 +3278,8 @@ parse_bracket_exp (re_string_t *regexp, + #ifdef RE_ENABLE_I18N + mbcset, &char_class_alloc, + #endif /* RE_ENABLE_I18N */ +- start_elem.opr.name, syntax); ++ (const char *) start_elem.opr.name, ++ syntax); + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + break; +@@ -3578,14 +3559,14 @@ static reg_errcode_t + #ifdef RE_ENABLE_I18N + build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, + re_charset_t *mbcset, Idx *char_class_alloc, +- const unsigned char *class_name, reg_syntax_t syntax) ++ const char *class_name, reg_syntax_t syntax) + #else /* not RE_ENABLE_I18N */ + build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, +- const unsigned char *class_name, reg_syntax_t syntax) ++ const char *class_name, reg_syntax_t syntax) + #endif /* not RE_ENABLE_I18N */ + { + int i; +- const char *name = (const char *) class_name; ++ const char *name = class_name; + + /* In case of REG_ICASE "upper" and "lower" match the both of + upper and lower cases. */ +@@ -3659,8 +3640,8 @@ build_charclass (RE_TRANSLATE_TYPE trans + + static bin_tree_t * + build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, +- const unsigned char *class_name, +- const unsigned char *extra, bool non_match, ++ const char *class_name, ++ const char *extra, bool non_match, + reg_errcode_t *err) + { + re_bitset_ptr_t sbcset; +--- origsrc/sed-4.2.2/lib/regex-quote.c 1970-01-01 01:00:00.000000000 +0100 ++++ src/sed-4.2.2/lib/regex-quote.c 2013-06-27 18:05:27.081447884 +0200 +@@ -0,0 +1,216 @@ ++/* Construct a regular expression from a literal string. ++ Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc. ++ Written by Bruno Haible <haible@clisp.cons.org>, 2010. ++ ++ This program is free software: you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see <http://www.gnu.org/licenses/>. */ ++ ++#include <config.h> ++ ++/* Specification. */ ++#include "regex-quote.h" ++ ++#include <string.h> ++ ++#include "mbuiter.h" ++#include "xalloc.h" ++ ++/* Characters that are special in a BRE. */ ++static const char bre_special[] = "$^.*[]\\"; ++ ++/* Characters that are special in an ERE. */ ++static const char ere_special[] = "$^.*[]\\+?{}()|"; ++ ++struct regex_quote_spec ++regex_quote_spec_posix (int cflags, bool anchored) ++{ ++ struct regex_quote_spec result; ++ ++ strcpy (result.special, cflags != 0 ? ere_special : bre_special); ++ result.multibyte = true; ++ result.anchored = anchored; ++ ++ return result; ++} ++ ++/* Syntax bit values, defined in GNU <regex.h>. We don't include it here, ++ otherwise this module would need to depend on gnulib module 'regex'. */ ++#define RE_BK_PLUS_QM 0x00000002 ++#define RE_INTERVALS 0x00000200 ++#define RE_LIMITED_OPS 0x00000400 ++#define RE_NEWLINE_ALT 0x00000800 ++#define RE_NO_BK_BRACES 0x00001000 ++#define RE_NO_BK_PARENS 0x00002000 ++#define RE_NO_BK_VBAR 0x00008000 ++ ++struct regex_quote_spec ++regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored) ++{ ++ struct regex_quote_spec result; ++ char *p; ++ ++ p = result.special; ++ memcpy (p, bre_special, sizeof (bre_special) - 1); ++ p += sizeof (bre_special) - 1; ++ if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_BK_PLUS_QM) == 0) ++ { ++ *p++ = '+'; ++ *p++ = '?'; ++ } ++ if ((syntax & RE_INTERVALS) != 0 && (syntax & RE_NO_BK_BRACES) != 0) ++ { ++ *p++ = '{'; ++ *p++ = '}'; ++ } ++ if ((syntax & RE_NO_BK_PARENS) != 0) ++ { ++ *p++ = '('; ++ *p++ = ')'; ++ } ++ if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_NO_BK_VBAR) != 0) ++ *p++ = '|'; ++ if ((syntax & RE_NEWLINE_ALT) != 0) ++ *p++ = '\n'; ++ *p = '\0'; ++ ++ result.multibyte = true; ++ result.anchored = anchored; ++ ++ return result; ++} ++ ++/* Characters that are special in a PCRE. */ ++static const char pcre_special[] = "$^.*[]\\+?{}()|"; ++ ++/* Options bit values, defined in <pcre.h>. We don't include it here, because ++ it is not a standard header. */ ++#define PCRE_ANCHORED 0x00000010 ++#define PCRE_EXTENDED 0x00000008 ++ ++struct regex_quote_spec ++regex_quote_spec_pcre (int options, bool anchored) ++{ ++ struct regex_quote_spec result; ++ char *p; ++ ++ p = result.special; ++ memcpy (p, bre_special, sizeof (pcre_special) - 1); ++ p += sizeof (pcre_special) - 1; ++ if (options & PCRE_EXTENDED) ++ { ++ *p++ = ' '; ++ *p++ = '\t'; ++ *p++ = '\n'; ++ *p++ = '\v'; ++ *p++ = '\f'; ++ *p++ = '\r'; ++ *p++ = '#'; ++ } ++ *p = '\0'; ++ ++ /* PCRE regular expressions consist of UTF-8 characters of options contains ++ PCRE_UTF8 and of single bytes otherwise. */ ++ result.multibyte = false; ++ /* If options contains PCRE_ANCHORED, the anchoring is implicit. */ ++ result.anchored = (options & PCRE_ANCHORED ? 0 : anchored); ++ ++ return result; ++} ++ ++size_t ++regex_quote_length (const char *string, const struct regex_quote_spec *spec) ++{ ++ const char *special = spec->special; ++ size_t length; ++ ++ length = 0; ++ if (spec->anchored) ++ length += 2; /* for '^' at the beginning and '$' at the end */ ++ if (spec->multibyte) ++ { ++ mbui_iterator_t iter; ++ ++ for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter)) ++ { ++ /* We know that special contains only ASCII characters. */ ++ if (mb_len (mbui_cur (iter)) == 1 ++ && strchr (special, * mbui_cur_ptr (iter))) ++ length += 1; ++ length += mb_len (mbui_cur (iter)); ++ } ++ } ++ else ++ { ++ const char *iter; ++ ++ for (iter = string; *iter != '\0'; iter++) ++ { ++ if (strchr (special, *iter)) ++ length += 1; ++ length += 1; ++ } ++ } ++ ++ return length; ++} ++ ++char * ++regex_quote_copy (char *p, const char *string, const struct regex_quote_spec *spec) ++{ ++ const char *special = spec->special; ++ ++ if (spec->anchored) ++ *p++ = '^'; ++ if (spec->multibyte) ++ { ++ mbui_iterator_t iter; ++ ++ for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter)) ++ { ++ /* We know that special contains only ASCII characters. */ ++ if (mb_len (mbui_cur (iter)) == 1 ++ && strchr (special, * mbui_cur_ptr (iter))) ++ *p++ = '\\'; ++ memcpy (p, mbui_cur_ptr (iter), mb_len (mbui_cur (iter))); ++ p += mb_len (mbui_cur (iter)); ++ } ++ } ++ else ++ { ++ const char *iter; ++ ++ for (iter = string; *iter != '\0'; iter++) ++ { ++ if (strchr (special, *iter)) ++ *p++ = '\\'; ++ *p++ = *iter++; ++ } ++ } ++ if (spec->anchored) ++ *p++ = '$'; ++ ++ return p; ++} ++ ++char * ++regex_quote (const char *string, const struct regex_quote_spec *spec) ++{ ++ size_t length = regex_quote_length (string, spec); ++ char *result = XNMALLOC (length + 1, char); ++ char *p; ++ ++ p = result; ++ p = regex_quote_copy (p, string, spec); ++ *p = '\0'; ++ return result; ++} +--- origsrc/sed-4.2.2/lib/regex-quote.h 1970-01-01 01:00:00.000000000 +0100 ++++ src/sed-4.2.2/lib/regex-quote.h 2013-06-27 18:05:27.112447751 +0200 +@@ -0,0 +1,88 @@ ++/* Construct a regular expression from a literal string. ++ Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc. ++ Written by Bruno Haible <haible@clisp.cons.org>, 2010. ++ ++ This program is free software: you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see <http://www.gnu.org/licenses/>. */ ++ ++#ifndef _REGEX_QUOTE_H ++#define _REGEX_QUOTE_H ++ ++#include <stddef.h> ++#include <stdbool.h> ++ ++ ++/* Specifies a quotation task for converting a fixed string to a regular ++ expression pattern. */ ++struct regex_quote_spec ++{ ++ /* True if the regular expression pattern consists of multibyte characters ++ (in the encoding given by the LC_CTYPE category of the locale), ++ false if it consists of single bytes or UTF-8 characters. */ ++ unsigned int /*bool*/ multibyte : 1; ++ /* True if the regular expression pattern shall match only entire lines. */ ++ unsigned int /*bool*/ anchored : 1; ++ /* Set of characters that need to be escaped (all ASCII), as a ++ NUL-terminated string. */ ++ char special[30 + 1]; ++}; ++ ++ ++/* Creates a quotation task that produces a POSIX regular expression, that is, ++ a pattern that can be compiled with regcomp(). ++ CFLAGS can be 0 or REG_EXTENDED. ++ If it is 0, the result is a Basic Regular Expression (BRE) ++ <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_03>. ++ If it is REG_EXTENDED, the result is an Extended Regular Expression (ERE) ++ <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_04>. ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_posix (int cflags, bool anchored); ++ ++/* Creates a quotation task that produces a regular expression that can be ++ compiled with the GNU API function re_compile_pattern(). ++ SYNTAX describes the syntax of the regular expression (such as ++ RE_SYNTAX_POSIX_BASIC, RE_SYNTAX_POSIX_EXTENDED, RE_SYNTAX_EMACS, all ++ defined in <regex.h>). It must be the same value as 're_syntax_options' ++ at the moment of the re_compile_pattern() call. ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored); ++ ++/* Creates a quotation task that produces a PCRE regular expression, that is, ++ a pattern that can be compiled with pcre_compile(). ++ OPTIONS is the same value as the second argument passed to pcre_compile(). ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_pcre (int options, bool anchored); ++ ++ ++/* Returns the number of bytes needed for the quoted string. */ ++extern size_t ++ regex_quote_length (const char *string, const struct regex_quote_spec *spec); ++ ++/* Copies the quoted string to p and returns the incremented p. ++ There must be room for regex_quote_length (string, spec) + 1 bytes at p. */ ++extern char * ++ regex_quote_copy (char *p, ++ const char *string, const struct regex_quote_spec *spec); ++ ++/* Returns the freshly allocated quoted string. */ ++extern char * ++ regex_quote (const char *string, const struct regex_quote_spec *spec); ++ ++ ++#endif /* _REGEX_QUOTE_H */ +--- origsrc/sed-4.2.2/lib/regex.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regex.c 2013-06-27 18:05:27.138447639 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _LIBC + # include <config.h> +@@ -25,6 +24,7 @@ + # pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" + # endif + # if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__ ++# pragma GCC diagnostic ignored "-Wold-style-definition" + # pragma GCC diagnostic ignored "-Wtype-limits" + # endif + #endif +--- origsrc/sed-4.2.2/lib/regex.h 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regex.h 2013-06-27 18:05:27.168447509 +0200 +@@ -1,23 +1,22 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Definitions for data structures and routines for the regular + expression library. +- Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2012 +- Free Software Foundation, Inc. ++ Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 Free Software ++ Foundation, Inc. + This file is part of the GNU C Library. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _REGEX_H + #define _REGEX_H 1 +--- origsrc/sed-4.2.2/lib/regex_internal.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regex_internal.c 2013-06-27 18:05:27.199447375 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static void re_string_construct_common (const char *str, Idx len, + re_string_t *pstr, +@@ -835,7 +834,7 @@ re_string_reconstruct (re_string_t *pstr + } + + static unsigned char +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_string_peek_byte_case (const re_string_t *pstr, Idx idx) + { + int ch; +@@ -975,7 +974,7 @@ re_node_set_alloc (re_node_set *set, Idx + set->alloc = size; + set->nelem = 0; + set->elems = re_malloc (Idx, size); +- if (BE (set->elems == NULL, 0)) ++ if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0)) + return REG_ESPACE; + return REG_NOERROR; + } +@@ -1355,7 +1354,7 @@ re_node_set_insert_last (re_node_set *se + Return true if SET1 and SET2 are equivalent. */ + + static bool +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_node_set_compare (const re_node_set *set1, const re_node_set *set2) + { + Idx i; +@@ -1370,7 +1369,7 @@ re_node_set_compare (const re_node_set * + /* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise. */ + + static Idx +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_node_set_contains (const re_node_set *set, Idx elem) + { + __re_size_t idx, right, mid; +@@ -1444,11 +1443,9 @@ re_dfa_add_node (re_dfa_t *dfa, re_token + dfa->nodes[dfa->nodes_len] = token; + dfa->nodes[dfa->nodes_len].constraint = 0; + #ifdef RE_ENABLE_I18N +- { +- int type = token.type; + dfa->nodes[dfa->nodes_len].accept_mb = +- (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET; +- } ++ ((token.type == OP_PERIOD && dfa->mb_cur_max > 1) ++ || token.type == COMPLEX_BRACKET); + #endif + dfa->nexts[dfa->nodes_len] = REG_MISSING; + re_node_set_init_empty (dfa->edests + dfa->nodes_len); +--- origsrc/sed-4.2.2/lib/regex_internal.h 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regex_internal.h 2013-06-27 18:05:27.230447242 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _REGEX_INTERNAL_H + #define _REGEX_INTERNAL_H 1 +@@ -28,21 +27,54 @@ + #include <string.h> + + #include <langinfo.h> +-#ifndef _LIBC +-# include "localcharset.h" +-#endif + #include <locale.h> + #include <wchar.h> + #include <wctype.h> + #include <stdbool.h> + #include <stdint.h> +-#if defined _LIBC ++ ++#ifdef _LIBC + # include <bits/libc-lock.h> ++# define lock_define(name) __libc_lock_define (, name) ++# define lock_init(lock) (__libc_lock_init (lock), 0) ++# define lock_fini(lock) 0 ++# define lock_lock(lock) __libc_lock_lock (lock) ++# define lock_unlock(lock) __libc_lock_unlock (lock) ++#elif defined GNULIB_LOCK ++# include "glthread/lock.h" ++ /* Use gl_lock_define if empty macro arguments are known to work. ++ Otherwise, fall back on less-portable substitutes. */ ++# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \ ++ || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__)) ++# define lock_define(name) gl_lock_define (, name) ++# elif USE_POSIX_THREADS ++# define lock_define(name) pthread_mutex_t name; ++# elif USE_PTH_THREADS ++# define lock_define(name) pth_mutex_t name; ++# elif USE_SOLARIS_THREADS ++# define lock_define(name) mutex_t name; ++# elif USE_WINDOWS_THREADS ++# define lock_define(name) gl_lock_t name; ++# else ++# define lock_define(name) ++# endif ++# define lock_init(lock) glthread_lock_init (&(lock)) ++# define lock_fini(lock) glthread_lock_destroy (&(lock)) ++# define lock_lock(lock) glthread_lock_lock (&(lock)) ++# define lock_unlock(lock) glthread_lock_unlock (&(lock)) ++#elif defined GNULIB_PTHREAD ++# include <pthread.h> ++# define lock_define(name) pthread_mutex_t name; ++# define lock_init(lock) pthread_mutex_init (&(lock), 0) ++# define lock_fini(lock) pthread_mutex_destroy (&(lock)) ++# define lock_lock(lock) pthread_mutex_lock (&(lock)) ++# define lock_unlock(lock) pthread_mutex_unlock (&(lock)) + #else +-# define __libc_lock_define(CLASS,NAME) +-# define __libc_lock_init(NAME) do { } while (0) +-# define __libc_lock_lock(NAME) do { } while (0) +-# define __libc_lock_unlock(NAME) do { } while (0) ++# define lock_define(name) ++# define lock_init(lock) 0 ++# define lock_fini(lock) 0 ++# define lock_lock(lock) ((void) 0) ++# define lock_unlock(lock) ((void) 0) + #endif + + /* In case that the system doesn't have isblank(). */ +@@ -65,7 +97,7 @@ + # ifdef _LIBC + # undef gettext + # define gettext(msgid) \ +- INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES) ++ __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES) + # endif + #else + # define gettext(msgid) (msgid) +@@ -101,6 +133,8 @@ + + /* Rename to standard API for using out of glibc. */ + #ifndef _LIBC ++# undef __wctype ++# undef __iswctype + # define __wctype wctype + # define __iswctype iswctype + # define __btowc btowc +@@ -110,10 +144,8 @@ + # define attribute_hidden + #endif /* not _LIBC */ + +-#if __GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1) +-# define __attribute(arg) __attribute__ (arg) +-#else +-# define __attribute(arg) ++#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1) ++# define __attribute__(arg) + #endif + + typedef __re_idx_t Idx; +@@ -429,7 +461,7 @@ static void build_upper_buffer (re_strin + static void re_string_translate_buffer (re_string_t *pstr) internal_function; + static unsigned int re_string_context_at (const re_string_t *input, Idx idx, + int eflags) +- internal_function __attribute ((pure)); ++ internal_function __attribute__ ((pure)); + #endif + #define re_string_peek_byte(pstr, offset) \ + ((pstr)->mbs[(pstr)->cur_idx + offset]) +@@ -448,7 +480,9 @@ static unsigned int re_string_context_at + #define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx)) + #define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx)) + +-#include <alloca.h> ++#if defined _LIBC || HAVE_ALLOCA ++# include <alloca.h> ++#endif + + #ifndef _LIBC + # if HAVE_ALLOCA +@@ -465,6 +499,12 @@ static unsigned int re_string_context_at + # endif + #endif + ++#ifdef _LIBC ++# define MALLOC_0_IS_NONNULL 1 ++#elif !defined MALLOC_0_IS_NONNULL ++# define MALLOC_0_IS_NONNULL 0 ++#endif ++ + #ifndef MAX + # define MAX(a,b) ((a) < (b) ? (b) : (a)) + #endif +@@ -695,7 +735,7 @@ struct re_dfa_t + #ifdef DEBUG + char* re_str; + #endif +- __libc_lock_define (, lock) ++ lock_define (lock) + }; + + #define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set)) +@@ -767,7 +807,7 @@ bitset_copy (bitset_t dest, const bitset + memcpy (dest, src, sizeof (bitset_t)); + } + +-static void ++static void __attribute__ ((unused)) + bitset_not (bitset_t set) + { + int bitset_i; +@@ -779,7 +819,7 @@ bitset_not (bitset_t set) + & ~set[BITSET_WORDS - 1]); + } + +-static void ++static void __attribute__ ((unused)) + bitset_merge (bitset_t dest, const bitset_t src) + { + int bitset_i; +@@ -787,7 +827,7 @@ bitset_merge (bitset_t dest, const bitse + dest[bitset_i] |= src[bitset_i]; + } + +-static void ++static void __attribute__ ((unused)) + bitset_mask (bitset_t dest, const bitset_t src) + { + int bitset_i; +@@ -798,7 +838,7 @@ bitset_mask (bitset_t dest, const bitset + #ifdef RE_ENABLE_I18N + /* Functions for re_string. */ + static int +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_char_size_at (const re_string_t *pstr, Idx idx) + { + int byte_idx; +@@ -811,7 +851,7 @@ re_string_char_size_at (const re_string_ + } + + static wint_t +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_wchar_at (const re_string_t *pstr, Idx idx) + { + if (pstr->mb_cur_max == 1) +@@ -821,7 +861,7 @@ re_string_wchar_at (const re_string_t *p + + # ifndef NOT_IN_libc + static int +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_elem_size_at (const re_string_t *pstr, Idx idx) + { + # ifdef _LIBC +--- origsrc/sed-4.2.2/lib/regexec.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/sed-4.2.2/lib/regexec.c 2013-06-27 18:05:27.268447078 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags, + Idx n) internal_function; +@@ -200,7 +199,7 @@ static Idx group_nodes_into_DFAstates (c + static bool check_node_accept (const re_match_context_t *mctx, + const re_token_t *node, Idx idx) + internal_function; +-static reg_errcode_t extend_buffers (re_match_context_t *mctx) ++static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len) + internal_function; + + /* Entry point for POSIX code. */ +@@ -229,9 +228,7 @@ regexec (preg, string, nmatch, pmatch, e + { + reg_errcode_t err; + Idx start, length; +-#ifdef _LIBC + re_dfa_t *dfa = preg->buffer; +-#endif + + if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND)) + return REG_BADPAT; +@@ -247,14 +244,14 @@ regexec (preg, string, nmatch, pmatch, e + length = strlen (string); + } + +- __libc_lock_lock (dfa->lock); ++ lock_lock (dfa->lock); + if (preg->no_sub) + err = re_search_internal (preg, string, length, start, length, + length, 0, NULL, eflags); + else + err = re_search_internal (preg, string, length, start, length, + length, nmatch, pmatch, eflags); +- __libc_lock_unlock (dfa->lock); ++ lock_unlock (dfa->lock); + return err != REG_NOERROR; + } + +@@ -422,9 +419,7 @@ re_search_stub (struct re_pattern_buffer + Idx nregs; + regoff_t rval; + int eflags = 0; +-#ifdef _LIBC + re_dfa_t *dfa = bufp->buffer; +-#endif + Idx last_start = start + range; + + /* Check for out-of-range. */ +@@ -435,7 +430,7 @@ re_search_stub (struct re_pattern_buffer + else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0)) + last_start = 0; + +- __libc_lock_lock (dfa->lock); ++ lock_lock (dfa->lock); + + eflags |= (bufp->not_bol) ? REG_NOTBOL : 0; + eflags |= (bufp->not_eol) ? REG_NOTEOL : 0; +@@ -499,7 +494,7 @@ re_search_stub (struct re_pattern_buffer + } + re_free (pmatch); + out: +- __libc_lock_unlock (dfa->lock); ++ lock_unlock (dfa->lock); + return rval; + } + +@@ -1065,7 +1060,7 @@ prune_impossible_nodes (re_match_context + since initial states may have constraints like "\<", "^", etc.. */ + + static inline re_dfastate_t * +-__attribute ((always_inline)) internal_function ++__attribute__ ((always_inline)) internal_function + acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx, + Idx idx) + { +@@ -1177,7 +1172,7 @@ check_matching (re_match_context_t *mctx + || (BE (next_char_idx >= mctx->input.valid_len, 0) + && mctx->input.valid_len < mctx->input.len)) + { +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, next_char_idx + 1); + if (BE (err != REG_NOERROR, 0)) + { + assert (err == REG_ESPACE); +@@ -1757,7 +1752,7 @@ clean_state_log_if_needed (re_match_cont + && mctx->input.valid_len < mctx->input.len)) + { + reg_errcode_t err; +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, next_state_log_idx + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + } +@@ -2814,7 +2809,7 @@ get_subexp (re_match_context_t *mctx, Id + if (bkref_str_off >= mctx->input.len) + break; + +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, bkref_str_off + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + +@@ -3937,6 +3932,7 @@ check_node_accept_bytes (const re_dfa_t + in_collseq = find_collation_sequence_value (pin, elem_len); + } + /* match with range expression? */ ++ /* FIXME: Implement rational ranges here, too. */ + for (i = 0; i < cset->nranges; ++i) + if (cset->range_starts[i] <= in_collseq + && in_collseq <= cset->range_ends[i]) +@@ -3988,18 +3984,9 @@ check_node_accept_bytes (const re_dfa_t + # endif /* _LIBC */ + { + /* match with range expression? */ +-#if __GNUC__ >= 2 && ! (__STDC_VERSION__ < 199901L && defined __STRICT_ANSI__) +- wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'}; +-#else +- wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'}; +- cmp_buf[2] = wc; +-#endif + for (i = 0; i < cset->nranges; ++i) + { +- cmp_buf[0] = cset->range_starts[i]; +- cmp_buf[4] = cset->range_ends[i]; +- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0 +- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0) ++ if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i]) + { + match_len = char_len; + goto check_node_accept_bytes_match; +@@ -4137,7 +4124,7 @@ check_node_accept (const re_match_contex + + static reg_errcode_t + internal_function __attribute_warn_unused_result__ +-extend_buffers (re_match_context_t *mctx) ++extend_buffers (re_match_context_t *mctx, int min_len) + { + reg_errcode_t ret; + re_string_t *pstr = &mctx->input; +@@ -4147,8 +4134,10 @@ extend_buffers (re_match_context_t *mctx + <= pstr->bufs_len, 0)) + return REG_ESPACE; + +- /* Double the lengths of the buffers. */ +- ret = re_string_realloc_buffers (pstr, MIN (pstr->len, pstr->bufs_len * 2)); ++ /* Double the lengths of the buffers, but allocate at least MIN_LEN. */ ++ ret = re_string_realloc_buffers (pstr, ++ MAX (min_len, ++ MIN (pstr->len, pstr->bufs_len * 2))); + if (BE (ret != REG_NOERROR, 0)) + return ret; + +--- origsrc/sed-4.2.2/sed/sed.c 2012-03-16 10:13:31.000000000 +0100 ++++ src/sed-4.2.2/sed/sed.c 2013-06-27 18:06:25.592195456 +0200 +@@ -57,7 +57,11 @@ bool follow_symlinks = false; + char *in_place_extension = NULL; + + /* The mode to use to read/write files, either "r"/"w" or "rb"/"wb". */ ++#ifdef HAVE_FOPEN_RT ++char *read_mode = "rt"; ++#else + char *read_mode = "r"; ++#endif + char *write_mode = "w"; + + /* Do we need to be pedantically POSIX compliant? */ diff --git a/dev/build/windows/patches_coq/sed-4.2.2.patch b/dev/build/windows/patches_coq/sed-4.2.2.patch new file mode 100755 index 0000000000..c7ccd53c7f --- /dev/null +++ b/dev/build/windows/patches_coq/sed-4.2.2.patch @@ -0,0 +1,1301 @@ +--- origsrc/doc/sed.1 2012-12-22 15:27:13.000000000 +0100 ++++ src/doc/sed.1 2013-06-27 18:10:47.974060492 +0200 +@@ -1,5 +1,5 @@ + .\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.28. +-.TH SED "1" "December 2012" "sed 4.2.2" "User Commands" ++.TH SED "1" "June 2013" "sed 4.2.2" "User Commands" + .SH NAME + sed \- stream editor for filtering and transforming text + .SH SYNOPSIS +@@ -40,6 +40,10 @@ follow symlinks when processing in place + .IP + edit files in place (makes backup if SUFFIX supplied) + .HP ++\fB\-b\fR, \fB\-\-binary\fR ++.IP ++open files in binary mode (CR+LFs are not processed specially) ++.HP + \fB\-l\fR N, \fB\-\-line\-length\fR=\fIN\fR + .IP + specify the desired line-wrap length for the `l' command +--- origsrc/lib/regcomp.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regcomp.c 2013-06-27 18:05:27.044448044 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static reg_errcode_t re_compile_internal (regex_t *preg, const char * pattern, + size_t length, reg_syntax_t syntax); +@@ -95,20 +94,20 @@ static reg_errcode_t build_charclass (RE + bitset_t sbcset, + re_charset_t *mbcset, + Idx *char_class_alloc, +- const unsigned char *class_name, ++ const char *class_name, + reg_syntax_t syntax); + #else /* not RE_ENABLE_I18N */ + static reg_errcode_t build_equiv_class (bitset_t sbcset, + const unsigned char *name); + static reg_errcode_t build_charclass (RE_TRANSLATE_TYPE trans, + bitset_t sbcset, +- const unsigned char *class_name, ++ const char *class_name, + reg_syntax_t syntax); + #endif /* not RE_ENABLE_I18N */ + static bin_tree_t *build_charclass_op (re_dfa_t *dfa, + RE_TRANSLATE_TYPE trans, +- const unsigned char *class_name, +- const unsigned char *extra, ++ const char *class_name, ++ const char *extra, + bool non_match, reg_errcode_t *err); + static bin_tree_t *create_tree (re_dfa_t *dfa, + bin_tree_t *left, bin_tree_t *right, +@@ -293,7 +292,7 @@ weak_alias (__re_compile_fastmap, re_com + #endif + + static inline void +-__attribute ((always_inline)) ++__attribute__ ((always_inline)) + re_set_fastmap (char *fastmap, bool icase, int ch) + { + fastmap[ch] = 1; +@@ -587,7 +586,7 @@ weak_alias (__regerror, regerror) + static const bitset_t utf8_sb_map = + { + /* Set the first 128 bits. */ +-# ifdef __GNUC__ ++# if defined __GNUC__ && !defined __STRICT_ANSI__ + [0 ... 0x80 / BITSET_WORD_BITS - 1] = BITSET_WORD_MAX + # else + # if 4 * BITSET_WORD_BITS < ASCII_CHARS +@@ -664,7 +663,10 @@ regfree (preg) + { + re_dfa_t *dfa = preg->buffer; + if (BE (dfa != NULL, 1)) +- free_dfa_content (dfa); ++ { ++ lock_fini (dfa->lock); ++ free_dfa_content (dfa); ++ } + preg->buffer = NULL; + preg->allocated = 0; + +@@ -785,6 +787,8 @@ re_compile_internal (regex_t *preg, cons + preg->used = sizeof (re_dfa_t); + + err = init_dfa (dfa, length); ++ if (BE (err == REG_NOERROR && lock_init (dfa->lock) != 0, 0)) ++ err = REG_ESPACE; + if (BE (err != REG_NOERROR, 0)) + { + free_dfa_content (dfa); +@@ -798,8 +802,6 @@ re_compile_internal (regex_t *preg, cons + strncpy (dfa->re_str, pattern, length + 1); + #endif + +- __libc_lock_init (dfa->lock); +- + err = re_string_construct (®exp, pattern, length, preg->translate, + (syntax & RE_ICASE) != 0, dfa); + if (BE (err != REG_NOERROR, 0)) +@@ -807,6 +809,7 @@ re_compile_internal (regex_t *preg, cons + re_compile_internal_free_return: + free_workarea_compile (preg); + re_string_destruct (®exp); ++ lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; +@@ -839,6 +842,7 @@ re_compile_internal (regex_t *preg, cons + + if (BE (err != REG_NOERROR, 0)) + { ++ lock_fini (dfa->lock); + free_dfa_content (dfa); + preg->buffer = NULL; + preg->allocated = 0; +@@ -954,10 +958,10 @@ static void + internal_function + init_word_char (re_dfa_t *dfa) + { +- dfa->word_ops_used = 1; + int i = 0; + int j; + int ch = 0; ++ dfa->word_ops_used = 1; + if (BE (dfa->map_notascii == 0, 1)) + { + bitset_word_t bits0 = 0x00000000; +@@ -2423,8 +2427,8 @@ parse_expression (re_string_t *regexp, r + case OP_WORD: + case OP_NOTWORD: + tree = build_charclass_op (dfa, regexp->trans, +- (const unsigned char *) "alnum", +- (const unsigned char *) "_", ++ "alnum", ++ "_", + token->type == OP_NOTWORD, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; +@@ -2432,8 +2436,8 @@ parse_expression (re_string_t *regexp, r + case OP_SPACE: + case OP_NOTSPACE: + tree = build_charclass_op (dfa, regexp->trans, +- (const unsigned char *) "space", +- (const unsigned char *) "", ++ "space", ++ "", + token->type == OP_NOTSPACE, err); + if (BE (*err != REG_NOERROR && tree == NULL, 0)) + return NULL; +@@ -2713,7 +2717,6 @@ build_range_exp (const reg_syntax_t synt + wchar_t wc; + wint_t start_wc; + wint_t end_wc; +- wchar_t cmp_buf[6] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'}; + + start_ch = ((start_elem->type == SB_CHAR) ? start_elem->opr.ch + : ((start_elem->type == COLL_SYM) ? start_elem->opr.name[0] +@@ -2727,11 +2730,7 @@ build_range_exp (const reg_syntax_t synt + ? __btowc (end_ch) : end_elem->opr.wch); + if (start_wc == WEOF || end_wc == WEOF) + return REG_ECOLLATE; +- cmp_buf[0] = start_wc; +- cmp_buf[4] = end_wc; +- +- if (BE ((syntax & RE_NO_EMPTY_RANGES) +- && wcscoll (cmp_buf, cmp_buf + 4) > 0, 0)) ++ else if (BE ((syntax & RE_NO_EMPTY_RANGES) && start_wc > end_wc, 0)) + return REG_ERANGE; + + /* Got valid collation sequence values, add them as a new entry. +@@ -2772,9 +2771,7 @@ build_range_exp (const reg_syntax_t synt + /* Build the table for single byte characters. */ + for (wc = 0; wc < SBC_MAX; ++wc) + { +- cmp_buf[2] = wc; +- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0 +- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0) ++ if (start_wc <= wc && wc <= end_wc) + bitset_set (sbcset, wc); + } + } +@@ -2843,40 +2840,29 @@ parse_bracket_exp (re_string_t *regexp, + + /* Local function for parse_bracket_exp used in _LIBC environment. + Seek the collating symbol entry corresponding to NAME. +- Return the index of the symbol in the SYMB_TABLE. */ ++ Return the index of the symbol in the SYMB_TABLE, ++ or -1 if not found. */ + + auto inline int32_t +- __attribute ((always_inline)) +- seek_collating_symbol_entry (name, name_len) +- const unsigned char *name; +- size_t name_len; +- { +- int32_t hash = elem_hash ((const char *) name, name_len); +- int32_t elem = hash % table_size; +- if (symb_table[2 * elem] != 0) +- { +- int32_t second = hash % (table_size - 2) + 1; +- +- do +- { +- /* First compare the hashing value. */ +- if (symb_table[2 * elem] == hash +- /* Compare the length of the name. */ +- && name_len == extra[symb_table[2 * elem + 1]] +- /* Compare the name. */ +- && memcmp (name, &extra[symb_table[2 * elem + 1] + 1], +- name_len) == 0) +- { +- /* Yep, this is the entry. */ +- break; +- } ++ __attribute__ ((always_inline)) ++ seek_collating_symbol_entry (const unsigned char *name, size_t name_len) ++ { ++ int32_t elem; + +- /* Next entry. */ +- elem += second; +- } +- while (symb_table[2 * elem] != 0); +- } +- return elem; ++ for (elem = 0; elem < table_size; elem++) ++ if (symb_table[2 * elem] != 0) ++ { ++ int32_t idx = symb_table[2 * elem + 1]; ++ /* Skip the name of collating element name. */ ++ idx += 1 + extra[idx]; ++ if (/* Compare the length of the name. */ ++ name_len == extra[idx] ++ /* Compare the name. */ ++ && memcmp (name, &extra[idx + 1], name_len) == 0) ++ /* Yep, this is the entry. */ ++ return elem; ++ } ++ return -1; + } + + /* Local function for parse_bracket_exp used in _LIBC environment. +@@ -2884,9 +2870,8 @@ parse_bracket_exp (re_string_t *regexp, + Return the value if succeeded, UINT_MAX otherwise. */ + + auto inline unsigned int +- __attribute ((always_inline)) +- lookup_collation_sequence_value (br_elem) +- bracket_elem_t *br_elem; ++ __attribute__ ((always_inline)) ++ lookup_collation_sequence_value (bracket_elem_t *br_elem) + { + if (br_elem->type == SB_CHAR) + { +@@ -2914,7 +2899,7 @@ parse_bracket_exp (re_string_t *regexp, + int32_t elem, idx; + elem = seek_collating_symbol_entry (br_elem->opr.name, + sym_name_len); +- if (symb_table[2 * elem] != 0) ++ if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; +@@ -2932,7 +2917,7 @@ parse_bracket_exp (re_string_t *regexp, + /* Return the collation sequence value. */ + return *(unsigned int *) (extra + idx); + } +- else if (symb_table[2 * elem] == 0 && sym_name_len == 1) ++ else if (sym_name_len == 1) + { + /* No valid character. Match it as a single byte + character. */ +@@ -2953,12 +2938,9 @@ parse_bracket_exp (re_string_t *regexp, + update it. */ + + auto inline reg_errcode_t +- __attribute ((always_inline)) +- build_range_exp (sbcset, mbcset, range_alloc, start_elem, end_elem) +- re_charset_t *mbcset; +- Idx *range_alloc; +- bitset_t sbcset; +- bracket_elem_t *start_elem, *end_elem; ++ __attribute__ ((always_inline)) ++ build_range_exp (bitset_t sbcset, re_charset_t *mbcset, int *range_alloc, ++ bracket_elem_t *start_elem, bracket_elem_t *end_elem) + { + unsigned int ch; + uint32_t start_collseq; +@@ -2971,6 +2953,7 @@ parse_bracket_exp (re_string_t *regexp, + 0)) + return REG_ERANGE; + ++ /* FIXME: Implement rational ranges here, too. */ + start_collseq = lookup_collation_sequence_value (start_elem); + end_collseq = lookup_collation_sequence_value (end_elem); + /* Check start/end collation sequence values. */ +@@ -3036,26 +3019,23 @@ parse_bracket_exp (re_string_t *regexp, + pointer argument since we may update it. */ + + auto inline reg_errcode_t +- __attribute ((always_inline)) +- build_collating_symbol (sbcset, mbcset, coll_sym_alloc, name) +- re_charset_t *mbcset; +- Idx *coll_sym_alloc; +- bitset_t sbcset; +- const unsigned char *name; ++ __attribute__ ((always_inline)) ++ build_collating_symbol (bitset_t sbcset, re_charset_t *mbcset, ++ Idx *coll_sym_alloc, const unsigned char *name) + { + int32_t elem, idx; + size_t name_len = strlen ((const char *) name); + if (nrules != 0) + { + elem = seek_collating_symbol_entry (name, name_len); +- if (symb_table[2 * elem] != 0) ++ if (elem != -1) + { + /* We found the entry. */ + idx = symb_table[2 * elem + 1]; + /* Skip the name of collating element name. */ + idx += 1 + extra[idx]; + } +- else if (symb_table[2 * elem] == 0 && name_len == 1) ++ else if (name_len == 1) + { + /* No valid character, treat it as a normal + character. */ +@@ -3298,7 +3278,8 @@ parse_bracket_exp (re_string_t *regexp, + #ifdef RE_ENABLE_I18N + mbcset, &char_class_alloc, + #endif /* RE_ENABLE_I18N */ +- start_elem.opr.name, syntax); ++ (const char *) start_elem.opr.name, ++ syntax); + if (BE (*err != REG_NOERROR, 0)) + goto parse_bracket_exp_free_return; + break; +@@ -3578,14 +3559,14 @@ static reg_errcode_t + #ifdef RE_ENABLE_I18N + build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, + re_charset_t *mbcset, Idx *char_class_alloc, +- const unsigned char *class_name, reg_syntax_t syntax) ++ const char *class_name, reg_syntax_t syntax) + #else /* not RE_ENABLE_I18N */ + build_charclass (RE_TRANSLATE_TYPE trans, bitset_t sbcset, +- const unsigned char *class_name, reg_syntax_t syntax) ++ const char *class_name, reg_syntax_t syntax) + #endif /* not RE_ENABLE_I18N */ + { + int i; +- const char *name = (const char *) class_name; ++ const char *name = class_name; + + /* In case of REG_ICASE "upper" and "lower" match the both of + upper and lower cases. */ +@@ -3659,8 +3640,8 @@ build_charclass (RE_TRANSLATE_TYPE trans + + static bin_tree_t * + build_charclass_op (re_dfa_t *dfa, RE_TRANSLATE_TYPE trans, +- const unsigned char *class_name, +- const unsigned char *extra, bool non_match, ++ const char *class_name, ++ const char *extra, bool non_match, + reg_errcode_t *err) + { + re_bitset_ptr_t sbcset; +--- origsrc/lib/regex-quote.c 1970-01-01 01:00:00.000000000 +0100 ++++ src/lib/regex-quote.c 2013-06-27 18:05:27.081447884 +0200 +@@ -0,0 +1,216 @@ ++/* Construct a regular expression from a literal string. ++ Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc. ++ Written by Bruno Haible <haible@clisp.cons.org>, 2010. ++ ++ This program is free software: you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see <http://www.gnu.org/licenses/>. */ ++ ++#include <config.h> ++ ++/* Specification. */ ++#include "regex-quote.h" ++ ++#include <string.h> ++ ++#include "mbuiter.h" ++#include "xalloc.h" ++ ++/* Characters that are special in a BRE. */ ++static const char bre_special[] = "$^.*[]\\"; ++ ++/* Characters that are special in an ERE. */ ++static const char ere_special[] = "$^.*[]\\+?{}()|"; ++ ++struct regex_quote_spec ++regex_quote_spec_posix (int cflags, bool anchored) ++{ ++ struct regex_quote_spec result; ++ ++ strcpy (result.special, cflags != 0 ? ere_special : bre_special); ++ result.multibyte = true; ++ result.anchored = anchored; ++ ++ return result; ++} ++ ++/* Syntax bit values, defined in GNU <regex.h>. We don't include it here, ++ otherwise this module would need to depend on gnulib module 'regex'. */ ++#define RE_BK_PLUS_QM 0x00000002 ++#define RE_INTERVALS 0x00000200 ++#define RE_LIMITED_OPS 0x00000400 ++#define RE_NEWLINE_ALT 0x00000800 ++#define RE_NO_BK_BRACES 0x00001000 ++#define RE_NO_BK_PARENS 0x00002000 ++#define RE_NO_BK_VBAR 0x00008000 ++ ++struct regex_quote_spec ++regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored) ++{ ++ struct regex_quote_spec result; ++ char *p; ++ ++ p = result.special; ++ memcpy (p, bre_special, sizeof (bre_special) - 1); ++ p += sizeof (bre_special) - 1; ++ if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_BK_PLUS_QM) == 0) ++ { ++ *p++ = '+'; ++ *p++ = '?'; ++ } ++ if ((syntax & RE_INTERVALS) != 0 && (syntax & RE_NO_BK_BRACES) != 0) ++ { ++ *p++ = '{'; ++ *p++ = '}'; ++ } ++ if ((syntax & RE_NO_BK_PARENS) != 0) ++ { ++ *p++ = '('; ++ *p++ = ')'; ++ } ++ if ((syntax & RE_LIMITED_OPS) == 0 && (syntax & RE_NO_BK_VBAR) != 0) ++ *p++ = '|'; ++ if ((syntax & RE_NEWLINE_ALT) != 0) ++ *p++ = '\n'; ++ *p = '\0'; ++ ++ result.multibyte = true; ++ result.anchored = anchored; ++ ++ return result; ++} ++ ++/* Characters that are special in a PCRE. */ ++static const char pcre_special[] = "$^.*[]\\+?{}()|"; ++ ++/* Options bit values, defined in <pcre.h>. We don't include it here, because ++ it is not a standard header. */ ++#define PCRE_ANCHORED 0x00000010 ++#define PCRE_EXTENDED 0x00000008 ++ ++struct regex_quote_spec ++regex_quote_spec_pcre (int options, bool anchored) ++{ ++ struct regex_quote_spec result; ++ char *p; ++ ++ p = result.special; ++ memcpy (p, bre_special, sizeof (pcre_special) - 1); ++ p += sizeof (pcre_special) - 1; ++ if (options & PCRE_EXTENDED) ++ { ++ *p++ = ' '; ++ *p++ = '\t'; ++ *p++ = '\n'; ++ *p++ = '\v'; ++ *p++ = '\f'; ++ *p++ = '\r'; ++ *p++ = '#'; ++ } ++ *p = '\0'; ++ ++ /* PCRE regular expressions consist of UTF-8 characters of options contains ++ PCRE_UTF8 and of single bytes otherwise. */ ++ result.multibyte = false; ++ /* If options contains PCRE_ANCHORED, the anchoring is implicit. */ ++ result.anchored = (options & PCRE_ANCHORED ? 0 : anchored); ++ ++ return result; ++} ++ ++size_t ++regex_quote_length (const char *string, const struct regex_quote_spec *spec) ++{ ++ const char *special = spec->special; ++ size_t length; ++ ++ length = 0; ++ if (spec->anchored) ++ length += 2; /* for '^' at the beginning and '$' at the end */ ++ if (spec->multibyte) ++ { ++ mbui_iterator_t iter; ++ ++ for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter)) ++ { ++ /* We know that special contains only ASCII characters. */ ++ if (mb_len (mbui_cur (iter)) == 1 ++ && strchr (special, * mbui_cur_ptr (iter))) ++ length += 1; ++ length += mb_len (mbui_cur (iter)); ++ } ++ } ++ else ++ { ++ const char *iter; ++ ++ for (iter = string; *iter != '\0'; iter++) ++ { ++ if (strchr (special, *iter)) ++ length += 1; ++ length += 1; ++ } ++ } ++ ++ return length; ++} ++ ++char * ++regex_quote_copy (char *p, const char *string, const struct regex_quote_spec *spec) ++{ ++ const char *special = spec->special; ++ ++ if (spec->anchored) ++ *p++ = '^'; ++ if (spec->multibyte) ++ { ++ mbui_iterator_t iter; ++ ++ for (mbui_init (iter, string); mbui_avail (iter); mbui_advance (iter)) ++ { ++ /* We know that special contains only ASCII characters. */ ++ if (mb_len (mbui_cur (iter)) == 1 ++ && strchr (special, * mbui_cur_ptr (iter))) ++ *p++ = '\\'; ++ memcpy (p, mbui_cur_ptr (iter), mb_len (mbui_cur (iter))); ++ p += mb_len (mbui_cur (iter)); ++ } ++ } ++ else ++ { ++ const char *iter; ++ ++ for (iter = string; *iter != '\0'; iter++) ++ { ++ if (strchr (special, *iter)) ++ *p++ = '\\'; ++ *p++ = *iter++; ++ } ++ } ++ if (spec->anchored) ++ *p++ = '$'; ++ ++ return p; ++} ++ ++char * ++regex_quote (const char *string, const struct regex_quote_spec *spec) ++{ ++ size_t length = regex_quote_length (string, spec); ++ char *result = XNMALLOC (length + 1, char); ++ char *p; ++ ++ p = result; ++ p = regex_quote_copy (p, string, spec); ++ *p = '\0'; ++ return result; ++} +--- origsrc/lib/regex-quote.h 1970-01-01 01:00:00.000000000 +0100 ++++ src/lib/regex-quote.h 2013-06-27 18:05:27.112447751 +0200 +@@ -0,0 +1,88 @@ ++/* Construct a regular expression from a literal string. ++ Copyright (C) 1995, 2010-2013 Free Software Foundation, Inc. ++ Written by Bruno Haible <haible@clisp.cons.org>, 2010. ++ ++ This program is free software: you can redistribute it and/or modify ++ it under the terms of the GNU General Public License as published by ++ the Free Software Foundation; either version 3 of the License, or ++ (at your option) any later version. ++ ++ This program is distributed in the hope that it will be useful, ++ but WITHOUT ANY WARRANTY; without even the implied warranty of ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ++ GNU General Public License for more details. ++ ++ You should have received a copy of the GNU General Public License ++ along with this program. If not, see <http://www.gnu.org/licenses/>. */ ++ ++#ifndef _REGEX_QUOTE_H ++#define _REGEX_QUOTE_H ++ ++#include <stddef.h> ++#include <stdbool.h> ++ ++ ++/* Specifies a quotation task for converting a fixed string to a regular ++ expression pattern. */ ++struct regex_quote_spec ++{ ++ /* True if the regular expression pattern consists of multibyte characters ++ (in the encoding given by the LC_CTYPE category of the locale), ++ false if it consists of single bytes or UTF-8 characters. */ ++ unsigned int /*bool*/ multibyte : 1; ++ /* True if the regular expression pattern shall match only entire lines. */ ++ unsigned int /*bool*/ anchored : 1; ++ /* Set of characters that need to be escaped (all ASCII), as a ++ NUL-terminated string. */ ++ char special[30 + 1]; ++}; ++ ++ ++/* Creates a quotation task that produces a POSIX regular expression, that is, ++ a pattern that can be compiled with regcomp(). ++ CFLAGS can be 0 or REG_EXTENDED. ++ If it is 0, the result is a Basic Regular Expression (BRE) ++ <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_03>. ++ If it is REG_EXTENDED, the result is an Extended Regular Expression (ERE) ++ <http://www.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap09.html#tag_09_04>. ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_posix (int cflags, bool anchored); ++ ++/* Creates a quotation task that produces a regular expression that can be ++ compiled with the GNU API function re_compile_pattern(). ++ SYNTAX describes the syntax of the regular expression (such as ++ RE_SYNTAX_POSIX_BASIC, RE_SYNTAX_POSIX_EXTENDED, RE_SYNTAX_EMACS, all ++ defined in <regex.h>). It must be the same value as 're_syntax_options' ++ at the moment of the re_compile_pattern() call. ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_gnu (unsigned long /*reg_syntax_t*/ syntax, bool anchored); ++ ++/* Creates a quotation task that produces a PCRE regular expression, that is, ++ a pattern that can be compiled with pcre_compile(). ++ OPTIONS is the same value as the second argument passed to pcre_compile(). ++ If ANCHORED is false, the regular expression will match substrings of lines. ++ If ANCHORED is true, it will match only complete lines, */ ++extern struct regex_quote_spec ++ regex_quote_spec_pcre (int options, bool anchored); ++ ++ ++/* Returns the number of bytes needed for the quoted string. */ ++extern size_t ++ regex_quote_length (const char *string, const struct regex_quote_spec *spec); ++ ++/* Copies the quoted string to p and returns the incremented p. ++ There must be room for regex_quote_length (string, spec) + 1 bytes at p. */ ++extern char * ++ regex_quote_copy (char *p, ++ const char *string, const struct regex_quote_spec *spec); ++ ++/* Returns the freshly allocated quoted string. */ ++extern char * ++ regex_quote (const char *string, const struct regex_quote_spec *spec); ++ ++ ++#endif /* _REGEX_QUOTE_H */ +--- origsrc/lib/regex.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regex.c 2013-06-27 18:05:27.138447639 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2003, 2005-2006, 2009-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _LIBC + # include <config.h> +@@ -25,6 +24,7 @@ + # pragma GCC diagnostic ignored "-Wsuggest-attribute=pure" + # endif + # if (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) || 4 < __GNUC__ ++# pragma GCC diagnostic ignored "-Wold-style-definition" + # pragma GCC diagnostic ignored "-Wtype-limits" + # endif + #endif +--- origsrc/lib/regex.h 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regex.h 2013-06-27 18:05:27.168447509 +0200 +@@ -1,23 +1,22 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Definitions for data structures and routines for the regular + expression library. +- Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2012 +- Free Software Foundation, Inc. ++ Copyright (C) 1985, 1989-1993, 1995-1998, 2000-2003, 2005-2013 Free Software ++ Foundation, Inc. + This file is part of the GNU C Library. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _REGEX_H + #define _REGEX_H 1 +--- origsrc/lib/regex_internal.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regex_internal.c 2013-06-27 18:05:27.199447375 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static void re_string_construct_common (const char *str, Idx len, + re_string_t *pstr, +@@ -835,7 +834,7 @@ re_string_reconstruct (re_string_t *pstr + } + + static unsigned char +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_string_peek_byte_case (const re_string_t *pstr, Idx idx) + { + int ch; +@@ -975,7 +974,7 @@ re_node_set_alloc (re_node_set *set, Idx + set->alloc = size; + set->nelem = 0; + set->elems = re_malloc (Idx, size); +- if (BE (set->elems == NULL, 0)) ++ if (BE (set->elems == NULL, 0) && (MALLOC_0_IS_NONNULL || size != 0)) + return REG_ESPACE; + return REG_NOERROR; + } +@@ -1355,7 +1354,7 @@ re_node_set_insert_last (re_node_set *se + Return true if SET1 and SET2 are equivalent. */ + + static bool +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_node_set_compare (const re_node_set *set1, const re_node_set *set2) + { + Idx i; +@@ -1370,7 +1369,7 @@ re_node_set_compare (const re_node_set * + /* Return (idx + 1) if SET contains the element ELEM, return 0 otherwise. */ + + static Idx +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure)) + re_node_set_contains (const re_node_set *set, Idx elem) + { + __re_size_t idx, right, mid; +@@ -1444,11 +1443,9 @@ re_dfa_add_node (re_dfa_t *dfa, re_token + dfa->nodes[dfa->nodes_len] = token; + dfa->nodes[dfa->nodes_len].constraint = 0; + #ifdef RE_ENABLE_I18N +- { +- int type = token.type; + dfa->nodes[dfa->nodes_len].accept_mb = +- (type == OP_PERIOD && dfa->mb_cur_max > 1) || type == COMPLEX_BRACKET; +- } ++ ((token.type == OP_PERIOD && dfa->mb_cur_max > 1) ++ || token.type == COMPLEX_BRACKET); + #endif + dfa->nexts[dfa->nodes_len] = REG_MISSING; + re_node_set_init_empty (dfa->edests + dfa->nodes_len); +--- origsrc/lib/regex_internal.h 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regex_internal.h 2013-06-27 18:05:27.230447242 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + #ifndef _REGEX_INTERNAL_H + #define _REGEX_INTERNAL_H 1 +@@ -28,21 +27,54 @@ + #include <string.h> + + #include <langinfo.h> +-#ifndef _LIBC +-# include "localcharset.h" +-#endif + #include <locale.h> + #include <wchar.h> + #include <wctype.h> + #include <stdbool.h> + #include <stdint.h> +-#if defined _LIBC ++ ++#ifdef _LIBC + # include <bits/libc-lock.h> ++# define lock_define(name) __libc_lock_define (, name) ++# define lock_init(lock) (__libc_lock_init (lock), 0) ++# define lock_fini(lock) 0 ++# define lock_lock(lock) __libc_lock_lock (lock) ++# define lock_unlock(lock) __libc_lock_unlock (lock) ++#elif defined GNULIB_LOCK ++# include "glthread/lock.h" ++ /* Use gl_lock_define if empty macro arguments are known to work. ++ Otherwise, fall back on less-portable substitutes. */ ++# if ((defined __GNUC__ && !defined __STRICT_ANSI__) \ ++ || (defined __STDC_VERSION__ && 199901L <= __STDC_VERSION__)) ++# define lock_define(name) gl_lock_define (, name) ++# elif USE_POSIX_THREADS ++# define lock_define(name) pthread_mutex_t name; ++# elif USE_PTH_THREADS ++# define lock_define(name) pth_mutex_t name; ++# elif USE_SOLARIS_THREADS ++# define lock_define(name) mutex_t name; ++# elif USE_WINDOWS_THREADS ++# define lock_define(name) gl_lock_t name; ++# else ++# define lock_define(name) ++# endif ++# define lock_init(lock) glthread_lock_init (&(lock)) ++# define lock_fini(lock) glthread_lock_destroy (&(lock)) ++# define lock_lock(lock) glthread_lock_lock (&(lock)) ++# define lock_unlock(lock) glthread_lock_unlock (&(lock)) ++#elif defined GNULIB_PTHREAD ++# include <pthread.h> ++# define lock_define(name) pthread_mutex_t name; ++# define lock_init(lock) pthread_mutex_init (&(lock), 0) ++# define lock_fini(lock) pthread_mutex_destroy (&(lock)) ++# define lock_lock(lock) pthread_mutex_lock (&(lock)) ++# define lock_unlock(lock) pthread_mutex_unlock (&(lock)) + #else +-# define __libc_lock_define(CLASS,NAME) +-# define __libc_lock_init(NAME) do { } while (0) +-# define __libc_lock_lock(NAME) do { } while (0) +-# define __libc_lock_unlock(NAME) do { } while (0) ++# define lock_define(name) ++# define lock_init(lock) 0 ++# define lock_fini(lock) 0 ++# define lock_lock(lock) ((void) 0) ++# define lock_unlock(lock) ((void) 0) + #endif + + /* In case that the system doesn't have isblank(). */ +@@ -65,7 +97,7 @@ + # ifdef _LIBC + # undef gettext + # define gettext(msgid) \ +- INTUSE(__dcgettext) (_libc_intl_domainname, msgid, LC_MESSAGES) ++ __dcgettext (_libc_intl_domainname, msgid, LC_MESSAGES) + # endif + #else + # define gettext(msgid) (msgid) +@@ -101,6 +133,8 @@ + + /* Rename to standard API for using out of glibc. */ + #ifndef _LIBC ++# undef __wctype ++# undef __iswctype + # define __wctype wctype + # define __iswctype iswctype + # define __btowc btowc +@@ -110,10 +144,8 @@ + # define attribute_hidden + #endif /* not _LIBC */ + +-#if __GNUC__ >= 4 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1) +-# define __attribute(arg) __attribute__ (arg) +-#else +-# define __attribute(arg) ++#if __GNUC__ < 3 + (__GNUC_MINOR__ < 1) ++# define __attribute__(arg) + #endif + + typedef __re_idx_t Idx; +@@ -429,7 +461,7 @@ static void build_upper_buffer (re_strin + static void re_string_translate_buffer (re_string_t *pstr) internal_function; + static unsigned int re_string_context_at (const re_string_t *input, Idx idx, + int eflags) +- internal_function __attribute ((pure)); ++ internal_function __attribute__ ((pure)); + #endif + #define re_string_peek_byte(pstr, offset) \ + ((pstr)->mbs[(pstr)->cur_idx + offset]) +@@ -448,7 +480,9 @@ static unsigned int re_string_context_at + #define re_string_skip_bytes(pstr,idx) ((pstr)->cur_idx += (idx)) + #define re_string_set_index(pstr,idx) ((pstr)->cur_idx = (idx)) + +-#include <alloca.h> ++#if defined _LIBC || HAVE_ALLOCA ++# include <alloca.h> ++#endif + + #ifndef _LIBC + # if HAVE_ALLOCA +@@ -465,6 +499,12 @@ static unsigned int re_string_context_at + # endif + #endif + ++#ifdef _LIBC ++# define MALLOC_0_IS_NONNULL 1 ++#elif !defined MALLOC_0_IS_NONNULL ++# define MALLOC_0_IS_NONNULL 0 ++#endif ++ + #ifndef MAX + # define MAX(a,b) ((a) < (b) ? (b) : (a)) + #endif +@@ -695,7 +735,7 @@ struct re_dfa_t + #ifdef DEBUG + char* re_str; + #endif +- __libc_lock_define (, lock) ++ lock_define (lock) + }; + + #define re_node_set_init_empty(set) memset (set, '\0', sizeof (re_node_set)) +@@ -767,7 +807,7 @@ bitset_copy (bitset_t dest, const bitset + memcpy (dest, src, sizeof (bitset_t)); + } + +-static void ++static void __attribute__ ((unused)) + bitset_not (bitset_t set) + { + int bitset_i; +@@ -779,7 +819,7 @@ bitset_not (bitset_t set) + & ~set[BITSET_WORDS - 1]); + } + +-static void ++static void __attribute__ ((unused)) + bitset_merge (bitset_t dest, const bitset_t src) + { + int bitset_i; +@@ -787,7 +827,7 @@ bitset_merge (bitset_t dest, const bitse + dest[bitset_i] |= src[bitset_i]; + } + +-static void ++static void __attribute__ ((unused)) + bitset_mask (bitset_t dest, const bitset_t src) + { + int bitset_i; +@@ -798,7 +838,7 @@ bitset_mask (bitset_t dest, const bitset + #ifdef RE_ENABLE_I18N + /* Functions for re_string. */ + static int +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_char_size_at (const re_string_t *pstr, Idx idx) + { + int byte_idx; +@@ -811,7 +851,7 @@ re_string_char_size_at (const re_string_ + } + + static wint_t +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_wchar_at (const re_string_t *pstr, Idx idx) + { + if (pstr->mb_cur_max == 1) +@@ -821,7 +861,7 @@ re_string_wchar_at (const re_string_t *p + + # ifndef NOT_IN_libc + static int +-internal_function __attribute ((pure)) ++internal_function __attribute__ ((pure, unused)) + re_string_elem_size_at (const re_string_t *pstr, Idx idx) + { + # ifdef _LIBC +--- origsrc/lib/regexec.c 2012-12-22 14:21:52.000000000 +0100 ++++ src/lib/regexec.c 2013-06-27 18:05:27.268447078 +0200 +@@ -1,22 +1,21 @@ +-/* -*- buffer-read-only: t -*- vi: set ro: */ +-/* DO NOT EDIT! GENERATED AUTOMATICALLY! */ + /* Extended regular expression matching and search library. +- Copyright (C) 2002-2012 Free Software Foundation, Inc. ++ Copyright (C) 2002-2013 Free Software Foundation, Inc. + This file is part of the GNU C Library. + Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>. + +- This program is free software; you can redistribute it and/or modify +- it under the terms of the GNU General Public License as published by +- the Free Software Foundation; either version 3, or (at your option) +- any later version. ++ The GNU C Library is free software; you can redistribute it and/or ++ modify it under the terms of the GNU Lesser General Public ++ License as published by the Free Software Foundation; either ++ version 2.1 of the License, or (at your option) any later version. + +- This program is distributed in the hope that it will be useful, ++ The GNU C Library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of +- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +- GNU General Public License for more details. ++ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ++ Lesser General Public License for more details. + +- You should have received a copy of the GNU General Public License along +- with this program; if not, see <http://www.gnu.org/licenses/>. */ ++ You should have received a copy of the GNU Lesser General Public ++ License along with the GNU C Library; if not, see ++ <http://www.gnu.org/licenses/>. */ + + static reg_errcode_t match_ctx_init (re_match_context_t *cache, int eflags, + Idx n) internal_function; +@@ -200,7 +199,7 @@ static Idx group_nodes_into_DFAstates (c + static bool check_node_accept (const re_match_context_t *mctx, + const re_token_t *node, Idx idx) + internal_function; +-static reg_errcode_t extend_buffers (re_match_context_t *mctx) ++static reg_errcode_t extend_buffers (re_match_context_t *mctx, int min_len) + internal_function; + + /* Entry point for POSIX code. */ +@@ -229,9 +228,7 @@ regexec (preg, string, nmatch, pmatch, e + { + reg_errcode_t err; + Idx start, length; +-#ifdef _LIBC + re_dfa_t *dfa = preg->buffer; +-#endif + + if (eflags & ~(REG_NOTBOL | REG_NOTEOL | REG_STARTEND)) + return REG_BADPAT; +@@ -247,14 +244,14 @@ regexec (preg, string, nmatch, pmatch, e + length = strlen (string); + } + +- __libc_lock_lock (dfa->lock); ++ lock_lock (dfa->lock); + if (preg->no_sub) + err = re_search_internal (preg, string, length, start, length, + length, 0, NULL, eflags); + else + err = re_search_internal (preg, string, length, start, length, + length, nmatch, pmatch, eflags); +- __libc_lock_unlock (dfa->lock); ++ lock_unlock (dfa->lock); + return err != REG_NOERROR; + } + +@@ -422,9 +419,7 @@ re_search_stub (struct re_pattern_buffer + Idx nregs; + regoff_t rval; + int eflags = 0; +-#ifdef _LIBC + re_dfa_t *dfa = bufp->buffer; +-#endif + Idx last_start = start + range; + + /* Check for out-of-range. */ +@@ -435,7 +430,7 @@ re_search_stub (struct re_pattern_buffer + else if (BE (last_start < 0 || (range < 0 && start <= last_start), 0)) + last_start = 0; + +- __libc_lock_lock (dfa->lock); ++ lock_lock (dfa->lock); + + eflags |= (bufp->not_bol) ? REG_NOTBOL : 0; + eflags |= (bufp->not_eol) ? REG_NOTEOL : 0; +@@ -499,7 +494,7 @@ re_search_stub (struct re_pattern_buffer + } + re_free (pmatch); + out: +- __libc_lock_unlock (dfa->lock); ++ lock_unlock (dfa->lock); + return rval; + } + +@@ -1065,7 +1060,7 @@ prune_impossible_nodes (re_match_context + since initial states may have constraints like "\<", "^", etc.. */ + + static inline re_dfastate_t * +-__attribute ((always_inline)) internal_function ++__attribute__ ((always_inline)) internal_function + acquire_init_state_context (reg_errcode_t *err, const re_match_context_t *mctx, + Idx idx) + { +@@ -1177,7 +1172,7 @@ check_matching (re_match_context_t *mctx + || (BE (next_char_idx >= mctx->input.valid_len, 0) + && mctx->input.valid_len < mctx->input.len)) + { +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, next_char_idx + 1); + if (BE (err != REG_NOERROR, 0)) + { + assert (err == REG_ESPACE); +@@ -1757,7 +1752,7 @@ clean_state_log_if_needed (re_match_cont + && mctx->input.valid_len < mctx->input.len)) + { + reg_errcode_t err; +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, next_state_log_idx + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + } +@@ -2814,7 +2809,7 @@ get_subexp (re_match_context_t *mctx, Id + if (bkref_str_off >= mctx->input.len) + break; + +- err = extend_buffers (mctx); ++ err = extend_buffers (mctx, bkref_str_off + 1); + if (BE (err != REG_NOERROR, 0)) + return err; + +@@ -3937,6 +3932,7 @@ check_node_accept_bytes (const re_dfa_t + in_collseq = find_collation_sequence_value (pin, elem_len); + } + /* match with range expression? */ ++ /* FIXME: Implement rational ranges here, too. */ + for (i = 0; i < cset->nranges; ++i) + if (cset->range_starts[i] <= in_collseq + && in_collseq <= cset->range_ends[i]) +@@ -3988,18 +3984,9 @@ check_node_accept_bytes (const re_dfa_t + # endif /* _LIBC */ + { + /* match with range expression? */ +-#if __GNUC__ >= 2 && ! (__STDC_VERSION__ < 199901L && defined __STRICT_ANSI__) +- wchar_t cmp_buf[] = {L'\0', L'\0', wc, L'\0', L'\0', L'\0'}; +-#else +- wchar_t cmp_buf[] = {L'\0', L'\0', L'\0', L'\0', L'\0', L'\0'}; +- cmp_buf[2] = wc; +-#endif + for (i = 0; i < cset->nranges; ++i) + { +- cmp_buf[0] = cset->range_starts[i]; +- cmp_buf[4] = cset->range_ends[i]; +- if (wcscoll (cmp_buf, cmp_buf + 2) <= 0 +- && wcscoll (cmp_buf + 2, cmp_buf + 4) <= 0) ++ if (cset->range_starts[i] <= wc && wc <= cset->range_ends[i]) + { + match_len = char_len; + goto check_node_accept_bytes_match; +@@ -4137,7 +4124,7 @@ check_node_accept (const re_match_contex + + static reg_errcode_t + internal_function __attribute_warn_unused_result__ +-extend_buffers (re_match_context_t *mctx) ++extend_buffers (re_match_context_t *mctx, int min_len) + { + reg_errcode_t ret; + re_string_t *pstr = &mctx->input; +@@ -4147,8 +4134,10 @@ extend_buffers (re_match_context_t *mctx + <= pstr->bufs_len, 0)) + return REG_ESPACE; + +- /* Double the lengths of the buffers. */ +- ret = re_string_realloc_buffers (pstr, MIN (pstr->len, pstr->bufs_len * 2)); ++ /* Double the lengths of the buffers, but allocate at least MIN_LEN. */ ++ ret = re_string_realloc_buffers (pstr, ++ MAX (min_len, ++ MIN (pstr->len, pstr->bufs_len * 2))); + if (BE (ret != REG_NOERROR, 0)) + return ret; + +--- origsrc/sed/sed.c 2012-03-16 10:13:31.000000000 +0100 ++++ src/sed/sed.c 2013-06-27 18:06:25.592195456 +0200 +@@ -57,7 +57,11 @@ bool follow_symlinks = false; + char *in_place_extension = NULL; + + /* The mode to use to read/write files, either "r"/"w" or "rb"/"wb". */ ++#ifdef HAVE_FOPEN_RT ++char *read_mode = "rt"; ++#else + char *read_mode = "r"; ++#endif + char *write_mode = "w"; + + /* Do we need to be pedantically POSIX compliant? */ diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh index 99ec43e412..4b3b44875f 100644 --- a/dev/ci/ci-basic-overlay.sh +++ b/dev/ci/ci-basic-overlay.sh @@ -79,20 +79,20 @@ ######################################################################## # VST ######################################################################## -: ${VST_CI_BRANCH:=less_init_plugins} -: ${VST_CI_GITURL:=https://github.com/letouzey/VST.git} +: ${VST_CI_BRANCH:=master} +: ${VST_CI_GITURL:=https://github.com/Zimmi48/VST.git} ######################################################################## # fiat_parsers ######################################################################## -: ${fiat_parsers_CI_BRANCH:=trunk__API} -: ${fiat_parsers_CI_GITURL:=https://github.com/matejkosik/fiat.git} +: ${fiat_parsers_CI_BRANCH:=master} +: ${fiat_parsers_CI_GITURL:=https://github.com/mit-plv/fiat.git} ######################################################################## # fiat_crypto ######################################################################## -: ${fiat_crypto_CI_BRANCH:=less_init_plugins} -: ${fiat_crypto_CI_GITURL:=https://github.com/letouzey/fiat-crypto.git} +: ${fiat_crypto_CI_BRANCH:=master} +: ${fiat_crypto_CI_GITURL:=https://github.com/mit-plv/fiat-crypto.git} ######################################################################## # formal-topology diff --git a/dev/ci/ci-color.sh b/dev/ci/ci-color.sh index a0a4e0749d..309050057c 100755 --- a/dev/ci/ci-color.sh +++ b/dev/ci/ci-color.sh @@ -32,4 +32,4 @@ sed -i -e "21i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/List/ListUt sed -i -e "17i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/Multiset/MultisetOrder.v sed -i -e "13i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/Set/SetUtil.v -( cd ${Color_CI_DIR} && make -j ${NJOBS} ) +( cd ${Color_CI_DIR} && make ) diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh index 5435e95885..238960948d 100644 --- a/dev/ci/ci-common.sh +++ b/dev/ci/ci-common.sh @@ -68,7 +68,7 @@ install_ssreflect() sed -i.bak '/field/d' Make && \ sed -i.bak '/fingroup/d' Make && \ sed -i.bak '/algebra/d' Make && \ - make Makefile.coq && make -f Makefile.coq -j ${NJOBS} all && make install ) + make Makefile.coq && make -f Makefile.coq all && make install ) echo -en 'travis_fold:end:ssr.install\\r' diff --git a/dev/ci/ci-compcert.sh b/dev/ci/ci-compcert.sh index c78ffdc2c0..4cfe0911b6 100755 --- a/dev/ci/ci-compcert.sh +++ b/dev/ci/ci-compcert.sh @@ -9,4 +9,5 @@ opam install -j ${NJOBS} -y menhir git_checkout ${CompCert_CI_BRANCH} ${CompCert_CI_GITURL} ${CompCert_CI_DIR} # Patch to avoid the upper version limit -( cd ${CompCert_CI_DIR} && sed -i.bak 's/8.6)/8.6|trunk)/' configure && ./configure x86_32-linux && make -j ${NJOBS} ) +( cd ${CompCert_CI_DIR} && ./configure -ignore-coq-version x86_32-linux && make ) + diff --git a/dev/ci/ci-cpdt.sh b/dev/ci/ci-cpdt.sh index 0e791ebbfd..8b725f6fec 100755 --- a/dev/ci/ci-cpdt.sh +++ b/dev/ci/ci-cpdt.sh @@ -6,5 +6,5 @@ source ${ci_dir}/ci-common.sh wget http://adam.chlipala.net/cpdt/cpdt.tgz tar xvfz cpdt.tgz -( cd cpdt && make clean && make -j ${NJOBS} ) +( cd cpdt && make clean && make ) diff --git a/dev/ci/ci-fiat-crypto.sh b/dev/ci/ci-fiat-crypto.sh index c6df45a1d4..5ca3ac47fc 100755 --- a/dev/ci/ci-fiat-crypto.sh +++ b/dev/ci/ci-fiat-crypto.sh @@ -6,5 +6,6 @@ source ${ci_dir}/ci-common.sh fiat_crypto_CI_DIR=${CI_BUILD_DIR}/fiat-crypto git_checkout ${fiat_crypto_CI_BRANCH} ${fiat_crypto_CI_GITURL} ${fiat_crypto_CI_DIR} +( cd ${fiat_crypto_CI_DIR} && git submodule update --init --recursive ) -( cd ${fiat_crypto_CI_DIR} && make -j ${NJOBS} lite ) +( cd ${fiat_crypto_CI_DIR} && make lite ) diff --git a/dev/ci/ci-fiat-parsers.sh b/dev/ci/ci-fiat-parsers.sh index 2095245eb8..292331b813 100755 --- a/dev/ci/ci-fiat-parsers.sh +++ b/dev/ci/ci-fiat-parsers.sh @@ -7,4 +7,4 @@ fiat_parsers_CI_DIR=${CI_BUILD_DIR}/fiat git_checkout ${fiat_parsers_CI_BRANCH} ${fiat_parsers_CI_GITURL} ${fiat_parsers_CI_DIR} -( cd ${fiat_parsers_CI_DIR} && make -j ${NJOBS} parsers parsers-examples && make -j ${NJOBS} fiat-core ) +( cd ${fiat_parsers_CI_DIR} && make parsers parsers-examples && make fiat-core ) diff --git a/dev/ci/ci-formal-topology.sh b/dev/ci/ci-formal-topology.sh index 64b78c0396..2556f84a55 100755 --- a/dev/ci/ci-formal-topology.sh +++ b/dev/ci/ci-formal-topology.sh @@ -17,16 +17,16 @@ source ${ci_dir}/ci-bignums.sh git_checkout ${math_classes_CI_BRANCH} ${math_classes_CI_GITURL} ${math_classes_CI_DIR} -( cd ${math_classes_CI_DIR} && make -j ${NJOBS} && make install ) +( cd ${math_classes_CI_DIR} && make && make install ) # Setup Corn git_checkout ${Corn_CI_BRANCH} ${Corn_CI_GITURL} ${Corn_CI_DIR} -( cd ${Corn_CI_DIR} && make -j ${NJOBS} && make install ) +( cd ${Corn_CI_DIR} && make && make install ) # Setup formal-topology git_checkout ${formal_topology_CI_BRANCH} ${formal_topology_CI_GITURL} ${formal_topology_CI_DIR} -( cd ${formal_topology_CI_DIR} && make -j ${NJOBS} ) +( cd ${formal_topology_CI_DIR} && make ) diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh index 4e5aa2687b..eadeb7c38c 100755 --- a/dev/ci/ci-geocoq.sh +++ b/dev/ci/ci-geocoq.sh @@ -13,4 +13,4 @@ git_checkout ${GeoCoq_CI_BRANCH} ${GeoCoq_CI_GITURL} ${GeoCoq_CI_DIR} sed -i.bak '/Elements\/Book_1\.v/d' Make && \ sed -i.bak '/Elements\/Book_3\.v/d' Make && \ coq_makefile -f Make -o Makefile && \ - make -j ${NJOBS} ) + make ) diff --git a/dev/ci/ci-iris-coq.sh b/dev/ci/ci-iris-coq.sh index 262dd6fa01..2d127ddc1b 100755 --- a/dev/ci/ci-iris-coq.sh +++ b/dev/ci/ci-iris-coq.sh @@ -20,7 +20,7 @@ stdpp_CI_COMMIT=${IRIS_DEP[2]} git_checkout ${stdpp_CI_BRANCH} ${stdpp_CI_GITURL} ${stdpp_CI_DIR} ${stdpp_CI_COMMIT} -( cd ${stdpp_CI_DIR} && make -j ${NJOBS} && make install ) +( cd ${stdpp_CI_DIR} && make && make install ) # Build iris now -( cd ${Iris_CI_DIR} && make -j ${NJOBS} ) +( cd ${Iris_CI_DIR} && make ) diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math-classes.sh index 46581c6381..2837dee963 100755 --- a/dev/ci/ci-math-classes.sh +++ b/dev/ci/ci-math-classes.sh @@ -15,10 +15,10 @@ source ${ci_dir}/ci-bignums.sh git_checkout ${math_classes_CI_BRANCH} ${math_classes_CI_GITURL} ${math_classes_CI_DIR} -( cd ${math_classes_CI_DIR} && make -j ${NJOBS} && make install ) +( cd ${math_classes_CI_DIR} && make && make install ) # Setup Corn git_checkout ${Corn_CI_BRANCH} ${Corn_CI_GITURL} ${Corn_CI_DIR} -( cd ${Corn_CI_DIR} && make -j ${NJOBS} ) +( cd ${Corn_CI_DIR} && make ) diff --git a/dev/ci/ci-math-comp.sh b/dev/ci/ci-math-comp.sh index bb8188da4e..701403f2cf 100755 --- a/dev/ci/ci-math-comp.sh +++ b/dev/ci/ci-math-comp.sh @@ -12,4 +12,4 @@ checkout_mathcomp ${mathcomp_CI_DIR} ( cd ${mathcomp_CI_DIR}/mathcomp && \ sed -i.bak '/PFsection/d' Make && \ sed -i.bak '/stripped_odd_order_theorem/d' Make && \ - make Makefile.coq && make -f Makefile.coq -j ${NJOBS} all ) + make Makefile.coq && make -f Makefile.coq all ) diff --git a/dev/ci/ci-metacoq.sh b/dev/ci/ci-metacoq.sh index e31691179e..c813b1fe99 100755 --- a/dev/ci/ci-metacoq.sh +++ b/dev/ci/ci-metacoq.sh @@ -10,10 +10,10 @@ metacoq_CI_DIR=${CI_BUILD_DIR}/MetaCoq git_checkout ${unicoq_CI_BRANCH} ${unicoq_CI_GITURL} ${unicoq_CI_DIR} -( cd ${unicoq_CI_DIR} && coq_makefile -f Make -o Makefile && make -j ${NJOBS} && make install ) +( cd ${unicoq_CI_DIR} && coq_makefile -f Make -o Makefile && make && make install ) # Setup MetaCoq git_checkout ${metacoq_CI_BRANCH} ${metacoq_CI_GITURL} ${metacoq_CI_DIR} -( cd ${metacoq_CI_DIR} && coq_makefile -f _CoqProject -o Makefile && make -j ${NJOBS} ) +( cd ${metacoq_CI_DIR} && coq_makefile -f _CoqProject -o Makefile && make ) diff --git a/dev/ci/ci-sf.sh b/dev/ci/ci-sf.sh index 23ef41d2dd..6e6c7012b7 100755 --- a/dev/ci/ci-sf.sh +++ b/dev/ci/ci-sf.sh @@ -9,6 +9,6 @@ tar xvfz sf.tgz sed -i.bak '15i From Coq Require Extraction.' sf/Extraction.v -( cd sf && sed -i.bak 's/(K,N)/((K,N))/' LibTactics.v && make clean && make -j ${NJOBS} ) +( cd sf && sed -i.bak 's/(K,N)/((K,N))/' LibTactics.v && make clean && make ) diff --git a/dev/ci/ci-template.sh b/dev/ci/ci-template.sh index 700105aed4..25da01a822 100755 --- a/dev/ci/ci-template.sh +++ b/dev/ci/ci-template.sh @@ -9,4 +9,4 @@ Template_CI_DIR=${CI_BUILD_DIR}/Template git_checkout ${Template_CI_BRANCH} ${Template_CI_GITURL} ${Template_CI_DIR} -( cd ${Template_CI_DIR} && make -j ${NJOBS} ) +( cd ${Template_CI_DIR} && make ) diff --git a/dev/ci/ci-tlc.sh b/dev/ci/ci-tlc.sh index ce26399378..8ecd8c441d 100755 --- a/dev/ci/ci-tlc.sh +++ b/dev/ci/ci-tlc.sh @@ -7,4 +7,4 @@ tlc_CI_DIR=${CI_BUILD_DIR}/tlc git_checkout ${tlc_CI_BRANCH} ${tlc_CI_GITURL} ${tlc_CI_DIR} -( cd ${tlc_CI_DIR} && make -j ${NJOBS} ) +( cd ${tlc_CI_DIR} && make ) diff --git a/dev/ci/ci-unimath.sh b/dev/ci/ci-unimath.sh index 175b82b5f9..66b56add77 100755 --- a/dev/ci/ci-unimath.sh +++ b/dev/ci/ci-unimath.sh @@ -10,5 +10,5 @@ git_checkout ${UniMath_CI_BRANCH} ${UniMath_CI_GITURL} ${UniMath_CI_DIR} ( cd ${UniMath_CI_DIR} && \ sed -i.bak '/Folds/d' Makefile && \ sed -i.bak '/HomologicalAlgebra/d' Makefile && \ - make -j ${NJOBS} BUILD_COQ=no ) + make BUILD_COQ=no ) diff --git a/dev/ci/ci-vst.sh b/dev/ci/ci-vst.sh index c111951852..5bfc408e96 100755 --- a/dev/ci/ci-vst.sh +++ b/dev/ci/ci-vst.sh @@ -10,4 +10,4 @@ git_checkout ${VST_CI_BRANCH} ${VST_CI_GITURL} ${VST_CI_DIR} # Targets are: msl veric floyd # Patch to avoid the upper version limit -( cd ${VST_CI_DIR} && sed -i.bak 's/8.6$/8.6 or-else trunk/' Makefile && make -j ${NJOBS} ) +( cd ${VST_CI_DIR} && make IGNORECOQVERSION=true ) @@ -32,6 +32,16 @@ install_printer Top_printers.ppeconstr install_printer Top_printers.ppuni install_printer Top_printers.ppuniverses install_printer Top_printers.ppconstraints +install_printer Top_printers.ppuniverse_set +install_printer Top_printers.ppuniverse_instance +install_printer Top_printers.ppuniverse_context +install_printer Top_printers.ppuniverse_context_set +install_printer Top_printers.ppuniverse_subst +install_printer Top_printers.ppuniverse_opt_subst +install_printer Top_printers.ppuniverse_level_subst +install_printer Top_printers.ppevar_universe_context +install_printer Top_printers.ppcumulativity_info +install_printer Top_printers.ppabstract_cumulativity_info install_printer Top_printers.pptype install_printer Top_printers.ppj install_printer Top_printers.ppenv diff --git a/dev/db_printers.ml b/dev/db_printers.ml index 500595085e..f4b4a425e2 100644 --- a/dev/db_printers.ml +++ b/dev/db_printers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/dev/doc/build-system.dev.txt b/dev/doc/build-system.dev.txt index fefcb0937a..f3fc13e969 100644 --- a/dev/doc/build-system.dev.txt +++ b/dev/doc/build-system.dev.txt @@ -74,25 +74,25 @@ The Makefile is separated in several files : - Makefile.doc : specific rules for compiling the documentation. -FIND_VCS_CLAUSE +FIND_SKIP_DIRS --------------- -The recommended style of using FIND_VCS_CLAUSE is for example +The recommended style of using FIND_SKIP_DIRS is for example - find . $(FIND_VCS_CLAUSE) '(' -name '*.example' ')' -print - find . $(FIND_VCS_CLAUSE) '(' -name '*.example' -or -name '*.foo' ')' -print + find . $(FIND_SKIP_DIRS) '(' -name '*.example' ')' -print + find . $(FIND_SKIP_DIRS) '(' -name '*.example' -or -name '*.foo' ')' -print 1) The parentheses even in the one-criteria case is so that if one adds other conditions, e.g. change the first example to the second - find . $(FIND_VCS_CLAUSE) '(' -name '*.example' -and -not -name '*.bak.example' ')' -print + find . $(FIND_SKIP_DIRS) '(' -name '*.example' -and -not -name '*.bak.example' ')' -print one is not tempted to write - find . $(FIND_VCS_CLAUSE) -name '*.example' -and -not -name '*.bak.example' -print + find . $(FIND_SKIP_DIRS) -name '*.example' -and -not -name '*.bak.example' -print -because this will not necessarily work as expected; $(FIND_VCS_CLAUSE) +because this will not necessarily work as expected; $(FIND_SKIP_DIRS) ends with an -or, and how it combines with what comes later depends on operator precedence and all that. Much safer to override it with parentheses. @@ -105,13 +105,13 @@ As to the -print at the end, yes it is necessary. Here's why. You are used to write: find . -name '*.example' and it works fine. But the following will not: - find . $(FIND_VCS_CLAUSE) -name '*.example' -it will also list things directly matched by FIND_VCS_CLAUSE + find . $(FIND_SKIP_DIRS) -name '*.example' +it will also list things directly matched by FIND_SKIP_DIRS (directories we want to prune, in which we don't want to find anything). C'est subtil... Il y a effectivement un -print implicite à la fin, qui fait que la commande habituelle sans print fonctionne bien, mais dès que l'on introduit d'autres commandes dans le lot (le --prune de FIND_VCS_CLAUSE), ça se corse à cause d'histoires de +-prune de FIND_SKIP_DIRS), ça se corse à cause d'histoires de parenthèses du -print implicite par rapport au parenthésage dans la forme recommandée d'utilisation: diff --git a/dev/doc/changes.txt b/dev/doc/changes.txt index 159be9a582..a48c491d33 100644 --- a/dev/doc/changes.txt +++ b/dev/doc/changes.txt @@ -1,4 +1,28 @@ ========================================= += CHANGES BETWEEN COQ V8.7 AND COQ V8.8 = +========================================= + +* ML API * + +We removed the following functions: + +- Universes.unsafe_constr_of_global: use Global.constr_of_global_in_context + instead. The returned term contains De Bruijn universe variables. If you don't + depend on universes being instantiated, simply drop the context. +- Universes.unsafe_type_of_global: same as above with + Global.type_of_global_in_context + +We changed the type of the following functions: + +- Global.body_of_constant_body: now also returns the abstract universe context. + The returned term contains De Bruijn universe variables. +- Global.body_of_constant: same as above. + +We renamed the following datatypes: + + Pp.std_ppcmds -> Pp.t + +========================================= = CHANGES BETWEEN COQ V8.6 AND COQ V8.7 = ========================================= @@ -8,6 +32,16 @@ Coq is compiled with -safe-string enabled and requires plugins to do the same. This means that code using `String` in an imperative way will fail to compile now. They should switch to `Bytes.t` +* Plugin API * + +Coq 8.7 offers a new module overlay containing a proposed plugin API +in `API/API.ml`; this overlay is enabled by adding the `-open API` +flag to the OCaml compiler; this happens automatically for +developments in the `plugin` folder and `coq_makefile`. + +However, `coq_makefile` can be instructed not to enable this flag by +passing `-bypass-API`. + * ML API * Added two functions for declaring hooks to be executed in reduction diff --git a/dev/doc/debugging.txt b/dev/doc/debugging.txt index 79cde48849..3e2b435b3e 100644 --- a/dev/doc/debugging.txt +++ b/dev/doc/debugging.txt @@ -1,7 +1,7 @@ Debugging from Coq toplevel using Caml trace mechanism ====================================================== - 1. Launch bytecode version of Coq (coqtop.byte or coqtop -byte) + 1. Launch bytecode version of Coq (coqtop.byte) 2. Access Ocaml toplevel using vernacular command 'Drop.' 3. Install load paths and pretty printers for terms, idents, ... using Ocaml command '#use "base_include";;' (use '#use "include";;' for diff --git a/dev/doc/naming-conventions.tex b/dev/doc/naming-conventions.tex index 349164948d..337b9226df 100644 --- a/dev/doc/naming-conventions.tex +++ b/dev/doc/naming-conventions.tex @@ -267,7 +267,7 @@ If the conclusion is in the other way than listed below, add suffix {forall x y:D, op (op' x y) = op' x (op y)} \itemrule{Idempotency of binary operator {\op} on domain {\D}}{Dop\_idempotent} -{forall x:D, op x n = x} +{forall x:D, op x x = x} \itemrule{Idempotency of unary operator {\op} on domain {\D}}{Dop\_idempotent} {forall x:D, op (op x) = op x} diff --git a/dev/header b/dev/header index 4132051791..bf7bdc1699 100644 --- a/dev/header +++ b/dev/header @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/dev/include b/dev/include index 31ae5da71a..0d34595f4f 100644 --- a/dev/include +++ b/dev/include @@ -31,6 +31,7 @@ #install_printer (* glob_constr *) ppglob_constr;; #install_printer (* open constr *) ppopenconstr;; #install_printer (* constr *) ppconstr;; +#install_printer (* econstr *) ppeconstr;; #install_printer (* constr_substituted *) ppsconstr;; #install_printer (* constraints *) ppconstraints;; #install_printer (* univ constraints *) ppuniverseconstraints;; diff --git a/dev/top_printers.ml b/dev/top_printers.ml index 1be72759c9..ffa8fffdf5 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -229,7 +229,7 @@ let ppenvwithcst e = pp str "[" ++ pr_rel_context e Evd.empty (rel_context e) ++ str "]" ++ spc() ++ str "{" ++ Cmap_env.fold (fun a _ s -> pr_con a ++ spc () ++ s) (Obj.magic e).Pre_env.env_globals.Pre_env.env_constants (mt ()) ++ str "}") -let pptac = (fun x -> pp(Ltac_plugin.Pptactic.pr_glob_tactic (Global.env()) x)) +let pptac = (fun x -> pp(Ltac_plugin.Pptactic.pr_glob_tactic (API.Global.env()) x)) let ppobj obj = Format.print_string (Libobject.object_tag obj) @@ -494,7 +494,6 @@ VERNAC COMMAND EXTEND PrintConstr END *) -open Grammar_API open Genarg open Stdarg open Egramml diff --git a/doc/refman/AsyncProofs.tex b/doc/refman/AsyncProofs.tex index 7ffe252253..1609e4a041 100644 --- a/doc/refman/AsyncProofs.tex +++ b/doc/refman/AsyncProofs.tex @@ -6,7 +6,7 @@ This chapter explains how proofs can be asynchronously processed by Coq. This feature improves the reactivity of the system when used in interactive -mode via CoqIDE. In addition to that, it allows Coq to take advantage of +mode via CoqIDE. In addition, it allows Coq to take advantage of parallel hardware when used as a batch compiler by decoupling the checking of statements and definitions from the construction and checking of proofs objects. @@ -22,7 +22,12 @@ For example, in interactive mode, some errors coming from the kernel of Coq are signaled late. The type of errors belonging to this category are universe inconsistencies. -Last, at the time of writing, only opaque proofs (ending with \texttt{Qed} or \texttt{Admitted}) can be processed asynchronously. +At the time of writing, only opaque proofs (ending with \texttt{Qed} or \texttt{Admitted}) can be processed asynchronously. + +Finally, asynchronous processing is disabled when running CoqIDE in Windows. The +current implementation of the feature is not stable on Windows. It can be +enabled, as described below at \ref{interactivecaveats}, though doing so is not +recommended. \section{Proof annotations} @@ -46,6 +51,12 @@ proof does not begin with \texttt{Proof using}, the system records in an auxiliary file, produced along with the \texttt{.vo} file, the list of section variables used. +\subsubsection{Automatic suggestion of proof annotations} + +The command \texttt{Set Suggest Proof Using} makes Coq suggest, when a +\texttt{Qed} command is processed, a correct proof annotation. It is up +to the user to modify the proof script accordingly. + \section{Proof blocks and error resilience} Coq 8.6 introduces a mechanism for error resiliency: in interactive mode Coq @@ -81,13 +92,7 @@ CoqIDE one of the following options: \texttt{-async-proofs-tactic-error-resilience off}, \texttt{-async-proofs-tactic-error-resilience all}, \texttt{-async-proofs-tactic-error-resilience $blocktype_1$,..., $blocktype_n$}. -Valid proof block types are: ``curly'', ``par'', ``indent'', ``bullet''. - -\subsubsection{Automatic suggestion of proof annotations} - -The command \texttt{Set Suggest Proof Using} makes Coq suggest, when a -\texttt{Qed} command is processed, a correct proof annotation. It is up -to the user to modify the proof script accordingly. +Valid proof block types are: ``curly'', ``par'', ``indent'', ``bullet''. \section{Interactive mode} @@ -112,6 +117,7 @@ the kernel to check all the proof objects, one has to click the button with the gears. Only then are all the universe constraints checked. \subsubsection{Caveats} +\label{interactivecaveats} The number of worker processes can be increased by passing CoqIDE the \texttt{-async-proofs-j $n$} flag. Note that the memory consumption @@ -120,7 +126,8 @@ the master process. Also note that increasing the number of workers may reduce the reactivity of the master process to user commands. To disable this feature, one can pass the \texttt{-async-proofs off} flag to -CoqIDE. +CoqIDE. Conversely, on Windows, where the feature is disabled by default, +pass the \texttt{-async-proofs on} flag to enable it. Proofs that are known to take little time to process are not delegated to a worker process. The threshold can be configure with \texttt{-async-proofs-delegation-threshold}. Default is 0.03 seconds. diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex index acfc4bea93..7e07868a38 100644 --- a/doc/refman/Classes.tex +++ b/doc/refman/Classes.tex @@ -486,15 +486,17 @@ where there is a hole in that place. \subsection{\tt Set Typeclasses Legacy Resolution} \optindex{Typeclasses Legacy Resolution} +\emph{Deprecated since 8.7} 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} +\emph{Deprecated since 8.7} This option allows eta-conversion for functions and records during -unification of type-classes. This option is now unsupported in 8.6 with +unification of type-classes. This option is unsupported since 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 @@ -505,7 +507,7 @@ 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 +This option (on by default) 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 @@ -554,7 +556,7 @@ 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}]} +\subsection{\tt Typeclasses eauto := [debug] [(dfs) | (bfs)] [\emph{depth}]} \comindex{Typeclasses eauto} \label{TypeclassesEauto} diff --git a/doc/refman/Extraction.tex b/doc/refman/Extraction.tex index fa3d61b1cd..499239b6f3 100644 --- a/doc/refman/Extraction.tex +++ b/doc/refman/Extraction.tex @@ -21,9 +21,14 @@ be used (abusively) to refer to any of the three. Before using any of the commands or options described in this chapter, the extraction framework should first be loaded explicitly -via {\tt Require Extraction}. Note that in earlier versions of Coq, these -commands and options were directly available without any preliminary -{\tt Require}. +via {\tt Require Extraction}, or via the more robust +{\tt From Coq Require Extraction}. +Note that in earlier versions of Coq, these commands and options were +directly available without any preliminary {\tt Require}. + +\begin{coq_example} +Require Extraction. +\end{coq_example} \asection{Generating ML code} \comindex{Extraction} @@ -82,9 +87,20 @@ one monolithic file or one file per \Coq\ library. using prefixes \verb!coq_! or \verb!Coq_!. \end{description} -\noindent The list of globals \qualid$_i$ does not need to be -exhaustive: it is automatically completed into a complete and minimal -environment. +\noindent The following command is meant to help automatic testing of + the extraction, see for instance the {\tt test-suite} directory + in the \Coq\ sources. + +\begin{description} +\item {\tt Extraction TestCompile} \qualid$_1$ \dots\ \qualid$_n$. ~\par + All the globals (or modules) \qualid$_1$ \dots\ \qualid$_n$ and all + their dependencies are extracted to a temporary Ocaml file, just as in + {\tt Extraction "{\em file}"}. Then this temporary file and its + signature are compiled with the same Ocaml compiler used to built + \Coq. This command succeeds only if the extraction and the Ocaml + compilation succeed (and it fails if the current target language + of the extraction is not Ocaml). +\end{description} \asection{Extraction options} @@ -365,6 +381,9 @@ some specific {\tt Extract Constant} when primitive counterparts exist. \Example Typical examples are the following: +\begin{coq_eval} +Require Extraction. +\end{coq_eval} \begin{coq_example} Extract Inductive unit => "unit" [ "()" ]. Extract Inductive bool => "bool" [ "true" "false" ]. diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex index 2fc1c8764a..f60908da6c 100644 --- a/doc/refman/Program.tex +++ b/doc/refman/Program.tex @@ -278,7 +278,8 @@ tactic is replaced by the default one if not specified. as implicit arguments of the special constant \texttt{Program.Tactics.obligation}. \item {\tt Set Shrink Obligations}\optindex{Shrink Obligations} - Control whether obligations should have their +\emph{Deprecated since 8.7} + This option (on by default) controls whether obligations should have their context minimized to the set of variables used in the proof of the obligation, to avoid unnecessary dependencies. \end{itemize} diff --git a/doc/refman/RefMan-cic.tex b/doc/refman/RefMan-cic.tex index 96fb1eb752..7a71d69086 100644 --- a/doc/refman/RefMan-cic.tex +++ b/doc/refman/RefMan-cic.tex @@ -1425,6 +1425,9 @@ If there is an hypothesis $h:a=b$ in the local context, it can be used for rewriting not only in logical propositions but also in any type. % In that case, the term \verb!eq_rec! which was defined as an axiom, is % now a term of the calculus. +\begin{coq_eval} +Require Extraction. +\end{coq_eval} \begin{coq_example} Print eq_rec. Extraction eq_rec. diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex index 939fc87a6e..713f344cbe 100644 --- a/doc/refman/RefMan-ext.tex +++ b/doc/refman/RefMan-ext.tex @@ -38,21 +38,19 @@ construction allows defining ``signatures''. \end{figure} \noindent In the expression - -\smallskip -{\tt Record} {\ident} {\params} \texttt{:} - {\sort} := {\ident$_0$} \verb+{+ - {\ident$_1$} \binders$_1$ \texttt{:} {\term$_1$}; - \dots - {\ident$_n$} \binders$_n$ \texttt{:} {\term$_n$} \verb+}+. -\smallskip - +\begin{quote} +{\tt Record {\ident} {\params} : {\sort} := {\ident$_0$} \{ \\ + {\ident$_1$} \binders$_1$ : {\term$_1$} ; ... ; \\ + {\ident$_n$} \binders$_n$ : {\term$_n$} \}.} +\end{quote} \noindent the identifier {\ident} is the name of the defined record and {\sort} is its type. The identifier {\ident$_0$} is the name of its constructor. If {\ident$_0$} is omitted, the default name {\tt -Build\_{\ident}} is used. If {\sort} is omitted, the default sort is ``{\Type}''. -The identifiers {\ident$_1$}, .., -{\ident$_n$} are the names of fields and {\tt forall} \binders$_1${\tt ,} {\term$_1$}, ..., {\tt forall} \binders$_n${\tt ,} {\term$_n$} +Build\_{\ident}} is used. +If {\sort} is omitted, the default sort is {\Type}. +The identifiers {\ident$_1$}, \dots, {\ident$_n$} are the names of +fields and {\tt forall {\binders$_1$}, {\term$_1$}}, \dots, +{\tt forall {\binders$_n$}, {\term$_n$}} their respective types. Remark that the type of {\ident$_i$} may depend on the previous {\ident$_j$} (for $j<i$). Thus the order of the fields is important. Finally, {\params} are the parameters of the @@ -82,26 +80,15 @@ Record Rat : Set := mkRat forall x y z:nat, (x * y) = top /\ (x * z) = bottom -> x = 1}. \end{coq_example} -Remark here that the field -\verb+Rat_cond+ depends on the field \verb+bottom+. - -%Let us now see the work done by the {\tt Record} macro. -%First the macro generates an inductive definition -%with just one constructor: -% -%\medskip -%\noindent -%{\tt Inductive {\ident} \zeroone{\binders} : {\sort} := \\ -%\mbox{}\hspace{0.4cm} {\ident$_0$} : forall ({\ident$_1$}:{\term$_1$}) .. -%({\ident$_n$}:{\term$_n$}), {\ident} {\rm\sl params}.} -%\medskip +Remark here that the field \verb+Rat_bottom_cond+ depends +on the field \verb+bottom+ and \verb+Rat_irred_cond+ depends +on both \verb+top+ and \verb+bottom+. Let us now see the work done by the {\tt Record} macro. First the macro generates a variant type definition with just one constructor: \begin{quote} -{\tt Variant {\ident} {\params} :{\sort} :=} \\ -\qquad {\tt - {\ident$_0$} ({\ident$_1$}:{\term$_1$}) .. ({\ident$_n$}:{\term$_n$}).} +{\tt Variant {\ident} {\params} : {\sort} := \\ + {\ident$_0$} ({\ident$_1$} : {\term$_1$}) ... ({\ident$_n$} : {\term$_n$}).} \end{quote} To build an object of type {\ident}, one should provide the constructor {\ident$_0$} with $n$ terms filling the fields of @@ -109,28 +96,9 @@ the record. As an example, let us define the rational $1/2$: \begin{coq_example*} -Require Import Arith. Theorem one_two_irred : forall x y z:nat, x * y = 1 /\ x * z = 2 -> x = 1. -\end{coq_example*} -\begin{coq_eval} -Lemma mult_m_n_eq_m_1 : forall m n:nat, m * n = 1 -> m = 1. -destruct m; trivial. -intros; apply f_equal with (f := S). -destruct m; trivial. -destruct n; simpl in H. - rewrite <- mult_n_O in H. - discriminate. - rewrite <- plus_n_Sm in H. - discriminate. -Qed. - -intros x y z [H1 H2]. - apply mult_m_n_eq_m_1 with (n := y); trivial. -\end{coq_eval} -\ldots -\begin{coq_example*} -Qed. +Admitted. \end{coq_example*} \begin{coq_example} Definition half := mkRat true 1 2 (O_S 1) one_two_irred. @@ -139,80 +107,6 @@ Definition half := mkRat true 1 2 (O_S 1) one_two_irred. Check half. \end{coq_example} -The macro generates also, when it is possible, the projection -functions for destructuring an object of type {\ident}. These -projection functions have the same name that the corresponding -fields. If a field is named ``\verb=_='' then no projection is built -for it. In our example: - -\begin{coq_example} -Eval compute in half.(top). -Eval compute in half.(bottom). -Eval compute in half.(Rat_bottom_cond). -\end{coq_example} -\begin{coq_eval} -Reset Initial. -\end{coq_eval} - -Records defined with the {\tt Record} keyword are not allowed to be -recursive (references to the record's name in the type of its field -raises an error). To define recursive records, one can use the {\tt - Inductive} and {\tt CoInductive} keywords, resulting in an inductive -or co-inductive record. A \emph{caveat}, however, is that records -cannot appear in mutually inductive (or co-inductive) definitions. -Induction schemes are automatically generated for inductive records. -Automatic generation of induction schemes for non-recursive records -defined with the {\tt Record} keyword can be activated with the -{\tt Nonrecursive Elimination Schemes} option -(see~\ref{set-nonrecursive-elimination-schemes}). - -\begin{Warnings} -\item {\tt {\ident$_i$} cannot be defined.} - - It can happen that the definition of a projection is impossible. - This message is followed by an explanation of this impossibility. - There may be three reasons: - \begin{enumerate} - \item The name {\ident$_i$} already exists in the environment (see - Section~\ref{Axiom}). - \item The body of {\ident$_i$} uses an incorrect elimination for - {\ident} (see Sections~\ref{Fixpoint} and~\ref{Caseexpr}). - \item The type of the projections {\ident$_i$} depends on previous - projections which themselves could not be defined. - \end{enumerate} -\end{Warnings} - -\begin{ErrMsgs} - -\item \errindex{Records declared with the keyword Record or Structure cannot be recursive.} - - The record name {\ident} appears in the type of its fields, but uses - the keyword {\tt Record}. Use the keyword {\tt Inductive} or {\tt - CoInductive} instead. -\item \errindex{Cannot handle mutually (co)inductive records.} - - Records cannot be defined as part of mutually inductive (or - co-inductive) definitions, whether with records only or mixed with - standard definitions. -\item During the definition of the one-constructor inductive - definition, all the errors of inductive definitions, as described in - Section~\ref{gal-Inductive-Definitions}, may also occur. - -\end{ErrMsgs} - -\SeeAlso Coercions and records in Section~\ref{Coercions-and-records} -of the chapter devoted to coercions. - -\Rem {\tt Structure} is a synonym of the keyword {\tt Record}. - -\Rem Creation of an object of record type can be done by calling {\ident$_0$} -and passing arguments in the correct order. - -\begin{coq_example} -Record point := { x : nat; y : nat }. -Definition a := Build_point 5 3. -\end{coq_example} - \begin{figure}[t] \begin{centerframe} \begin{tabular}{lcl} @@ -226,15 +120,17 @@ Definition a := Build_point 5 3. \label{fig:fieldsyntax} \end{figure} -A syntax is available for creating objects by using named fields, as +Alternatively, the following syntax allows creating objects by using named fields, as shown on Figure~\ref{fig:fieldsyntax}. The fields do not have to be in any particular order, nor do they have to be all present if the missing ones can be inferred or prompted for (see Section~\ref{Program}). \begin{coq_example} -Definition b := {| x := 5; y := 3 |}. -Definition c := {| y := 3; x := 5 |}. +Definition half' := + {| sign := true; + Rat_bottom_cond := O_S 1; + Rat_irred_cond := one_two_irred |}. \end{coq_example} This syntax can be disabled globally for printing by @@ -256,23 +152,52 @@ This syntax can also be used for pattern matching. \begin{coq_example} Eval compute in ( - match b with - | {| y := S n |} => n + match half with + | {| sign := true; top := n |} => n | _ => 0 end). \end{coq_example} -\begin{coq_eval} -Reset Initial. -\end{coq_eval} +The macro generates also, when it is possible, the projection +functions for destructuring an object of type {\ident}. These +projection functions are given the names of the corresponding +fields. If a field is named ``\verb=_='' then no projection is built +for it. In our example: + +\begin{coq_example} +Eval compute in top half. +Eval compute in bottom half. +Eval compute in Rat_bottom_cond half. +\end{coq_example} + +An alternative syntax for projections based on a dot notation is +available: + +\begin{coq_example} +Eval compute in half.(top). +\end{coq_example} -\Rem A syntax for projections based on a dot notation is -available. The command to activate it is +It can be activated for printing with the command \optindex{Printing Projections} \begin{quote} {\tt Set Printing Projections.} \end{quote} +\begin{coq_example} +Set Printing Projections. +Check top half. +\end{coq_example} + +The corresponding grammar rules are given in Figure~\ref{fig:projsyntax}. +When {\qualid} denotes a projection, the syntax {\tt + {\term}.({\qualid})} is equivalent to {\qualid~\term}, the syntax +{\term}{\tt .(}{\qualid}~{\termarg}$_1$ {\ldots} {\termarg}$_n${\tt )} to +{\qualid~{\termarg}$_1$ {\ldots} {\termarg}$_n$~\term}, and the syntax +{\term}{\tt .(@}{\qualid}~{\term}$_1$~\ldots~{\term}$_n${\tt )} to +{@\qualid~{\term}$_1$ {\ldots} {\term}$_n$~\term}. In each case, {\term} +is the object projected and the other arguments are the parameters of +the inductive type. + \begin{figure}[t] \begin{centerframe} \begin{tabular}{lcl} @@ -285,18 +210,66 @@ available. The command to activate it is \label{fig:projsyntax} \end{figure} -The corresponding grammar rules are given Figure~\ref{fig:projsyntax}. -When {\qualid} denotes a projection, the syntax {\tt - {\term}.({\qualid})} is equivalent to {\qualid~\term}, the syntax -{\term}{\tt .(}{\qualid}~{\termarg}$_1$ {\ldots} {\termarg}$_n${\tt )} to -{\qualid~{\termarg}$_1$ {\ldots} {\termarg}$_n$~\term}, and the syntax -{\term}{\tt .(@}{\qualid}~{\term}$_1$~\ldots~{\term}$_n${\tt )} to -{@\qualid~{\term}$_1$ {\ldots} {\term}$_n$~\term}. In each case, {\term} -is the object projected and the other arguments are the parameters of -the inductive type. +\begin{coq_eval} +Reset Initial. +\end{coq_eval} + +\begin{Remarks} + +\item Records defined with the {\tt Record} keyword are not allowed to be +recursive (references to the record's name in the type of its field +raises an error). To define recursive records, one can use the {\tt +Inductive} and {\tt CoInductive} keywords, resulting in an inductive +or co-inductive record. +A \emph{caveat}, however, is that records +cannot appear in mutually inductive (or co-inductive) definitions. + +\item Induction schemes are automatically generated for inductive records. +Automatic generation of induction schemes for non-recursive records +defined with the {\tt Record} keyword can be activated with the +{\tt Nonrecursive Elimination Schemes} option +(see~\ref{set-nonrecursive-elimination-schemes}). + +\item {\tt Structure} is a synonym of the keyword {\tt Record}. -To deactivate the printing of projections, use -{\tt Unset Printing Projections}. +\end{Remarks} + +\begin{Warnings} +\item {\tt {\ident$_i$} cannot be defined.} + + It can happen that the definition of a projection is impossible. + This message is followed by an explanation of this impossibility. + There may be three reasons: + \begin{enumerate} + \item The name {\ident$_i$} already exists in the environment (see + Section~\ref{Axiom}). + \item The body of {\ident$_i$} uses an incorrect elimination for + {\ident} (see Sections~\ref{Fixpoint} and~\ref{Caseexpr}). + \item The type of the projections {\ident$_i$} depends on previous + projections which themselves could not be defined. + \end{enumerate} +\end{Warnings} + +\begin{ErrMsgs} + +\item \errindex{Records declared with the keyword Record or Structure cannot be recursive.} + + The record name {\ident} appears in the type of its fields, but uses + the keyword {\tt Record}. Use the keyword {\tt Inductive} or {\tt + CoInductive} instead. +\item \errindex{Cannot handle mutually (co)inductive records.} + + Records cannot be defined as part of mutually inductive (or + co-inductive) definitions, whether with records only or mixed with + standard definitions. +\item During the definition of the one-constructor inductive + definition, all the errors of inductive definitions, as described in + Section~\ref{gal-Inductive-Definitions}, may also occur. + +\end{ErrMsgs} + +\SeeAlso Coercions and records in Section~\ref{Coercions-and-records} +of the chapter devoted to coercions. \subsection{Primitive Projections} \optindex{Primitive Projections} @@ -732,20 +705,20 @@ when the {\tt FunInd} library has been loaded via {\tt Require Import FunInd}: This command can be seen as a generalization of {\tt Fixpoint}. It is actually a wrapper for several ways of defining a function \emph{and other useful related objects}, namely: an induction principle that reflects the -recursive structure of the function (see \ref{FunInduction}), and its +recursive structure of the function (see \ref{FunInduction}) and its fixpoint equality. The meaning of this declaration is to define a function {\it ident}, similarly to {\tt Fixpoint}. Like in {\tt Fixpoint}, the decreasing argument must be -given (unless the function is not recursive), but it must not -necessary be \emph{structurally} decreasing. The point of the {\tt +given (unless the function is not recursive), but it might not +necessarily be \emph{structurally} decreasing. The point of the {\tt \{\}} annotation is to name the decreasing argument \emph{and} to describe which kind of decreasing criteria must be used to ensure termination of recursive calls. -The {\tt Function} construction enjoys also the {\tt with} extension +The {\tt Function} construction also enjoys the {\tt with} extension to define mutually recursive definitions. However, this feature does -not work for non structural recursive functions. % VRAI?? +not work for non structurally recursive functions. % VRAI?? See the documentation of {\tt functional induction} (see Section~\ref{FunInduction}) and {\tt Functional Scheme} @@ -776,7 +749,7 @@ Function plus (n m : nat) {struct n} : nat := \end{coq_example*} \paragraph[Limitations]{Limitations\label{sec:Function-limitations}} -\term$_0$ must be build as a \emph{pure pattern-matching tree} +\term$_0$ must be built as a \emph{pure pattern-matching tree} (\texttt{match...with}) with applications only \emph{at the end} of each branch. @@ -803,7 +776,7 @@ For now dependent cases are not treated for non structurally terminating functio The generation of the graph relation \texttt{(R\_\ident)} used to compute the induction scheme of \ident\ raised a typing error. Only - the ident is defined, the induction scheme will not be generated. + the ident is defined; the induction scheme will not be generated. This error happens generally when: @@ -875,14 +848,14 @@ the following: being the decreasing argument and \term$_1$ being a function from type of \ident$_0$ to \texttt{nat} for which value on the decreasing argument decreases (for the {\tt lt} order on {\tt - nat}) at each recursive call of \term$_0$, parameters of the + nat}) at each recursive call of \term$_0$. Parameters of the function are bound in \term$_0$; \item {\tt \{wf} \term$_1$ \ident$_0${\tt\}} with \ident$_0$ being the decreasing argument and \term$_1$ an ordering relation on the type of \ident$_0$ (i.e. of type T$_{\ident_0}$ $\to$ T$_{\ident_0}$ $\to$ {\tt Prop}) for which the decreasing argument decreases at each recursive call of - \term$_0$. The order must be well founded. parameters of the + \term$_0$. The order must be well founded. Parameters of the function are bound in \term$_0$. \end{itemize} @@ -2011,6 +1984,11 @@ Check (fun x y => _) 0 1. Unset Printing Existential Instances. \end{coq_eval} +Existential variables can be named by the user upon creation using +the syntax {\tt ?[\ident]}. This is useful when the existential +variable needs to be explicitly handled later in the script (e.g. +with a named-goal selector, see~\ref{ltac:selector}). + \subsection{Explicit displaying of existential instances for pretty-printing \label{SetPrintingExistentialInstances} \optindex{Printing Existential Instances}} diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex index 3814e4403a..ef12fe416a 100644 --- a/doc/refman/RefMan-gal.tex +++ b/doc/refman/RefMan-gal.tex @@ -3,7 +3,7 @@ \label{BNF-syntax} % Used referred to as a chapter label This chapter describes \gallina, the specification language of {\Coq}. -It allows developing mathematical theories and to prove specifications +It allows developing mathematical theories and proofs of specifications of programs. The theories are built from axioms, hypotheses, parameters, lemmas, theorems and definitions of constants, functions, predicates and sets. The syntax of logical objects involved in @@ -37,7 +37,7 @@ Similarly, the notation ``\nelist{\entry}{}'' stands for a non empty sequence of expressions parsed by the ``{\entry}'' entry, without any separator between. -At the end, the notation ``\sequence{\entry}{\tt sep}'' stands for a +Finally, the notation ``\sequence{\entry}{\tt sep}'' stands for a possibly empty sequence of expressions parsed by the ``{\entry}'' entry, separated by the literal ``{\tt sep}''. diff --git a/doc/refman/RefMan-ind.tex b/doc/refman/RefMan-ind.tex deleted file mode 100644 index 43bd2419f0..0000000000 --- a/doc/refman/RefMan-ind.tex +++ /dev/null @@ -1,510 +0,0 @@ - -%\documentstyle[11pt]{article} -%\input{title} - -%\include{macros} -%\makeindex - -%\begin{document} -%\coverpage{The module {\tt Equality}}{Cristina CORNES} - -%\tableofcontents - -\chapter[Tactics for inductive types and families]{Tactics for inductive types and families\label{Addoc-equality}} - -This chapter details a few special tactics useful for inferring facts -from inductive hypotheses. They can be considered as tools that -macro-generate complicated uses of the basic elimination tactics for -inductive types. - -Sections \ref{inversion_introduction} to \ref{inversion_using} present -inversion tactics and Section~\ref{scheme} describes -a command {\tt Scheme} for automatic generation of induction schemes -for mutual inductive types. - -%\end{document} -%\documentstyle[11pt]{article} -%\input{title} - -%\begin{document} -%\coverpage{Module Inv: Inversion Tactics}{Cristina CORNES} - -\section[Generalities about inversion]{Generalities about inversion\label{inversion_introduction}} -When working with (co)inductive predicates, we are very often faced to -some of these situations: -\begin{itemize} -\item we have an inconsistent instance of an inductive predicate in the - local context of hypotheses. Thus, the current goal can be trivially - proved by absurdity. - -\item we have a hypothesis that is an instance of an inductive - predicate, and the instance has some variables whose constraints we - would like to derive. -\end{itemize} - -The inversion tactics are very useful to simplify the work in these -cases. Inversion tools can be classified in three groups: -\begin{enumerate} -\item tactics for inverting an instance without stocking the inversion - lemma in the context: - (\texttt{Dependent}) \texttt{Inversion} and - (\texttt{Dependent}) \texttt{Inversion\_clear}. -\item commands for generating and stocking in the context the inversion - lemma corresponding to an instance: \texttt{Derive} - (\texttt{Dependent}) \texttt{Inversion}, \texttt{Derive} - (\texttt{Dependent}) \texttt{Inversion\_clear}. -\item tactics for inverting an instance using an already defined - inversion lemma: \texttt{Inversion \ldots using}. -\end{enumerate} - -These tactics work for inductive types of arity $(\vec{x}:\vec{T})s$ -where $s \in \{Prop,Set,Type\}$. Sections \ref{inversion_primitive}, -\ref{inversion_derivation} and \ref{inversion_using} -describe respectively each group of tools. - -As inversion proofs may be large in size, we recommend the user to -stock the lemmas whenever the same instance needs to be inverted -several times.\\ - -Let's consider the relation \texttt{Le} over natural numbers and the -following variables: - -\begin{coq_eval} -Restore State "Initial". -\end{coq_eval} - -\begin{coq_example*} -Inductive Le : nat -> nat -> Set := - | LeO : forall n:nat, Le 0%N n - | LeS : forall n m:nat, Le n m -> Le (S n) (S m). -Variable P : nat -> nat -> Prop. -Variable Q : forall n m:nat, Le n m -> Prop. -\end{coq_example*} - -For example purposes we defined \verb+Le: nat->nat->Set+ - but we may have defined -it \texttt{Le} of type \verb+nat->nat->Prop+ or \verb+nat->nat->Type+. - - -\section[Inverting an instance]{Inverting an instance\label{inversion_primitive}} -\subsection{The non dependent case} -\begin{itemize} - -\item \texttt{Inversion\_clear} \ident~\\ -\index{Inversion-clear@{\tt Inversion\_clear}} - Let the type of \ident~ in the local context be $(I~\vec{t})$, - where $I$ is a (co)inductive predicate. Then, - \texttt{Inversion} applied to \ident~ derives for each possible - constructor $c_i$ of $(I~\vec{t})$, {\bf all} the necessary - conditions that should hold for the instance $(I~\vec{t})$ to be - proved by $c_i$. Finally it erases \ident~ from the context. - - - -For example, consider the goal: -\begin{coq_eval} -Lemma ex : forall n m:nat, Le (S n) m -> P n m. -intros. -\end{coq_eval} - -\begin{coq_example} -Show. -\end{coq_example} - -To prove the goal we may need to reason by cases on \texttt{H} and to - derive that \texttt{m} is necessarily of -the form $(S~m_0)$ for certain $m_0$ and that $(Le~n~m_0)$. -Deriving these conditions corresponds to prove that the -only possible constructor of \texttt{(Le (S n) m)} is -\texttt{LeS} and that we can invert the -\texttt{->} in the type of \texttt{LeS}. -This inversion is possible because \texttt{Le} is the smallest set closed by -the constructors \texttt{LeO} and \texttt{LeS}. - - -\begin{coq_example} -inversion_clear H. -\end{coq_example} - -Note that \texttt{m} has been substituted in the goal for \texttt{(S m0)} -and that the hypothesis \texttt{(Le n m0)} has been added to the -context. - -\item \texttt{Inversion} \ident~\\ -\index{Inversion@{\tt Inversion}} - This tactic differs from {\tt Inversion\_clear} in the fact that - it adds the equality constraints in the context and - it does not erase the hypothesis \ident. - - -In the previous example, {\tt Inversion\_clear} -has substituted \texttt{m} by \texttt{(S m0)}. Sometimes it is -interesting to have the equality \texttt{m=(S m0)} in the -context to use it after. In that case we can use \texttt{Inversion} that -does not clear the equalities: - -\begin{coq_example*} -Undo. -\end{coq_example*} -\begin{coq_example} -inversion H. -\end{coq_example} - -\begin{coq_eval} -Undo. -\end{coq_eval} - -Note that the hypothesis \texttt{(S m0)=m} has been deduced and -\texttt{H} has not been cleared from the context. - -\end{itemize} - -\begin{Variants} - -\item \texttt{Inversion\_clear } \ident~ \texttt{in} \ident$_1$ \ldots - \ident$_n$\\ -\index{Inversion_clear...in@{\tt Inversion\_clear...in}} - Let \ident$_1$ \ldots \ident$_n$, be identifiers in the local context. This - tactic behaves as generalizing \ident$_1$ \ldots \ident$_n$, and then performing - {\tt Inversion\_clear}. - -\item \texttt{Inversion } \ident~ \texttt{in} \ident$_1$ \ldots \ident$_n$\\ -\index{Inversion ... in@{\tt Inversion ... in}} - Let \ident$_1$ \ldots \ident$_n$, be identifiers in the local context. This - tactic behaves as generalizing \ident$_1$ \ldots \ident$_n$, and then performing - \texttt{Inversion}. - - -\item \texttt{Simple Inversion} \ident~ \\ -\index{Simple Inversion@{\tt Simple Inversion}} - It is a very primitive inversion tactic that derives all the necessary - equalities but it does not simplify - the constraints as \texttt{Inversion} and - {\tt Inversion\_clear} do. - -\end{Variants} - - -\subsection{The dependent case} -\begin{itemize} -\item \texttt{Dependent Inversion\_clear} \ident~\\ -\index{Dependent Inversion-clear@{\tt Dependent Inversion\_clear}} - Let the type of \ident~ in the local context be $(I~\vec{t})$, - where $I$ is a (co)inductive predicate, and let the goal depend both on - $\vec{t}$ and \ident. Then, - \texttt{Dependent Inversion\_clear} applied to \ident~ derives - for each possible constructor $c_i$ of $(I~\vec{t})$, {\bf all} the - necessary conditions that should hold for the instance $(I~\vec{t})$ to be - proved by $c_i$. It also substitutes \ident~ for the corresponding - term in the goal and it erases \ident~ from the context. - - -For example, consider the goal: -\begin{coq_eval} -Lemma ex_dep : forall (n m:nat) (H:Le (S n) m), Q (S n) m H. -intros. -\end{coq_eval} - -\begin{coq_example} -Show. -\end{coq_example} - -As \texttt{H} occurs in the goal, we may want to reason by cases on its -structure and so, we would like inversion tactics to -substitute \texttt{H} by the corresponding term in constructor form. -Neither \texttt{Inversion} nor {\tt Inversion\_clear} make such a -substitution. To have such a behavior we use the dependent inversion tactics: - -\begin{coq_example} -dependent inversion_clear H. -\end{coq_example} - -Note that \texttt{H} has been substituted by \texttt{(LeS n m0 l)} and -\texttt{m} by \texttt{(S m0)}. - - -\end{itemize} - -\begin{Variants} - -\item \texttt{Dependent Inversion\_clear } \ident~ \texttt{ with } \term\\ -\index{Dependent Inversion_clear...with@{\tt Dependent Inversion\_clear...with}} - \noindent Behaves as \texttt{Dependent Inversion\_clear} but allows giving - explicitly the good generalization of the goal. It is useful when - the system fails to generalize the goal automatically. If - \ident~ has type $(I~\vec{t})$ and $I$ has type - $(\vec{x}:\vec{T})s$, then \term~ must be of type - $I:(\vec{x}:\vec{T})(I~\vec{x})\rightarrow s'$ where $s'$ is the - type of the goal. - - - -\item \texttt{Dependent Inversion} \ident~\\ -\index{Dependent Inversion@{\tt Dependent Inversion}} - This tactic differs from \texttt{Dependent Inversion\_clear} in the fact that - it also adds the equality constraints in the context and - it does not erase the hypothesis \ident~. - -\item \texttt{Dependent Inversion } \ident~ \texttt{ with } \term \\ -\index{Dependent Inversion...with@{\tt Dependent Inversion...with}} - Analogous to \texttt{Dependent Inversion\_clear .. with..} above. -\end{Variants} - - - -\section[Deriving the inversion lemmas]{Deriving the inversion lemmas\label{inversion_derivation}} -\subsection{The non dependent case} - -The tactics (\texttt{Dependent}) \texttt{Inversion} and (\texttt{Dependent}) -{\tt Inversion\_clear} work on a -certain instance $(I~\vec{t})$ of an inductive predicate. At each -application, they inspect the given instance and derive the -corresponding inversion lemma. If we have to invert the same -instance several times it is recommended to stock the lemma in the -context and to reuse it whenever we need it. - -The families of commands \texttt{Derive Inversion}, \texttt{Derive -Dependent Inversion}, \texttt{Derive} \\ {\tt Inversion\_clear} and \texttt{Derive Dependent Inversion\_clear} -allow to generate inversion lemmas for given instances and sorts. Next -section describes the tactic \texttt{Inversion}$\ldots$\texttt{using} that refines the -goal with a specified inversion lemma. - -\begin{itemize} - -\item \texttt{Derive Inversion\_clear} \ident~ \texttt{with} - $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ -\index{Derive Inversion_clear...with@{\tt Derive Inversion\_clear...with}} - Let $I$ be an inductive predicate and $\vec{x}$ the variables - occurring in $\vec{t}$. This command generates and stocks - the inversion lemma for the sort \sort~ corresponding to the instance - $(\vec{x}:\vec{T})(I~\vec{t})$ with the name \ident~ in the {\bf - global} environment. When applied it is equivalent to have - inverted the instance with the tactic {\tt Inversion\_clear}. - - - For example, to generate the inversion lemma for the instance - \texttt{(Le (S n) m)} and the sort \texttt{Prop} we do: -\begin{coq_example} -Derive Inversion_clear leminv with (forall n m:nat, Le (S n) m) Sort - Prop. -\end{coq_example} - -Let us inspect the type of the generated lemma: -\begin{coq_example} -Check leminv. -\end{coq_example} - - - -\end{itemize} - -%\variants -%\begin{enumerate} -%\item \verb+Derive Inversion_clear+ \ident$_1$ \ident$_2$ \\ -%\index{Derive Inversion_clear@{\tt Derive Inversion\_clear}} -% Let \ident$_1$ have type $(I~\vec{t})$ in the local context ($I$ -% an inductive predicate). Then, this command has the same semantics -% as \verb+Derive Inversion_clear+ \ident$_2$~ \verb+with+ -% $(\vec{x}:\vec{T})(I~\vec{t})$ \verb+Sort Prop+ where $\vec{x}$ are the free -% variables of $(I~\vec{t})$ declared in the local context (variables -% of the global context are considered as constants). -%\item \verb+Derive Inversion+ \ident$_1$~ \ident$_2$~\\ -%\index{Derive Inversion@{\tt Derive Inversion}} -% Analogous to the previous command. -%\item \verb+Derive Inversion+ $num$ \ident~ \ident~ \\ -%\index{Derive Inversion@{\tt Derive Inversion}} -% This command behaves as \verb+Derive Inversion+ \ident~ {\it -% namehyp} performed on the goal number $num$. -% -%\item \verb+Derive Inversion_clear+ $num$ \ident~ \ident~ \\ -%\index{Derive Inversion_clear@{\tt Derive Inversion\_clear}} -% This command behaves as \verb+Derive Inversion_clear+ \ident~ -% \ident~ performed on the goal number $num$. -%\end{enumerate} - - - -A derived inversion lemma is adequate for inverting the instance -with which it was generated, \texttt{Derive} applied to -different instances yields different lemmas. In general, if we generate -the inversion lemma with -an instance $(\vec{x}:\vec{T})(I~\vec{t})$ and a sort $s$, the inversion lemma will -expect a predicate of type $(\vec{x}:\vec{T})s$ as first argument. \\ - -\begin{Variant} -\item \texttt{Derive Inversion} \ident~ \texttt{with} - $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort\\ -\index{Derive Inversion...with@{\tt Derive Inversion...with}} - Analogous of \texttt{Derive Inversion\_clear .. with ..} but - when applied it is equivalent to having - inverted the instance with the tactic \texttt{Inversion}. -\end{Variant} - -\subsection{The dependent case} -\begin{itemize} -\item \texttt{Derive Dependent Inversion\_clear} \ident~ \texttt{with} - $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ -\index{Derive Dependent Inversion\_clear...with@{\tt Derive Dependent Inversion\_clear...with}} - Let $I$ be an inductive predicate. This command generates and stocks - the dependent inversion lemma for the sort \sort~ corresponding to the instance - $(\vec{x}:\vec{T})(I~\vec{t})$ with the name \ident~ in the {\bf - global} environment. When applied it is equivalent to having - inverted the instance with the tactic \texttt{Dependent Inversion\_clear}. -\end{itemize} - -\begin{coq_example} -Derive Dependent Inversion_clear leminv_dep with - (forall n m:nat, Le (S n) m) Sort Prop. -\end{coq_example} - -\begin{coq_example} -Check leminv_dep. -\end{coq_example} - -\begin{Variants} -\item \texttt{Derive Dependent Inversion} \ident~ \texttt{with} - $(\vec{x}:\vec{T})(I~\vec{t})$ \texttt{Sort} \sort~ \\ -\index{Derive Dependent Inversion...with@{\tt Derive Dependent Inversion...with}} - Analogous to \texttt{Derive Dependent Inversion\_clear}, but when - applied it is equivalent to having - inverted the instance with the tactic \texttt{Dependent Inversion}. - -\end{Variants} - -\section[Using already defined inversion lemmas]{Using already defined inversion lemmas\label{inversion_using}} -\begin{itemize} -\item \texttt{Inversion} \ident \texttt{ using} \ident$'$ \\ -\index{Inversion...using@{\tt Inversion...using}} - Let \ident~ have type $(I~\vec{t})$ ($I$ an inductive - predicate) in the local context, and \ident$'$ be a (dependent) inversion - lemma. Then, this tactic refines the current goal with the specified - lemma. - - -\begin{coq_eval} -Abort. -\end{coq_eval} - -\begin{coq_example} -Show. -\end{coq_example} -\begin{coq_example} -inversion H using leminv. -\end{coq_example} - - -\end{itemize} -\variant -\begin{enumerate} -\item \texttt{Inversion} \ident~ \texttt{using} \ident$'$ \texttt{in} \ident$_1$\ldots \ident$_n$\\ -\index{Inversion...using...in@{\tt Inversion...using...in}} -This tactic behaves as generalizing \ident$_1$\ldots \ident$_n$, -then doing \texttt{Use Inversion} \ident~\ident$'$. -\end{enumerate} - -\section[\tt Scheme ...]{\tt Scheme ...\index{Scheme@{\tt Scheme}}\label{Scheme} -\label{scheme}} -The {\tt Scheme} command is a high-level tool for generating -automatically (possibly mutual) induction principles for given types -and sorts. Its syntax follows the schema : - -\noindent -{\tt Scheme {\ident$_1$} := Induction for \term$_1$ Sort {\sort$_1$} \\ - with\\ - \mbox{}\hspace{0.1cm} .. \\ - with {\ident$_m$} := Induction for {\term$_m$} Sort - {\sort$_m$}}\\ -\term$_1$ \ldots \term$_m$ are different inductive types belonging to -the same package of mutual inductive definitions. This command -generates {\ident$_1$}\ldots{\ident$_m$} to be mutually recursive -definitions. Each term {\ident$_i$} proves a general principle -of mutual induction for objects in type {\term$_i$}. - -\Example -The definition of principle of mutual induction for {\tt tree} and -{\tt forest} over the sort {\tt Set} is defined by the command: -\begin{coq_eval} -Restore State "Initial". -Variables A B : Set. -Inductive tree : Set := - node : A -> forest -> tree -with forest : Set := - | leaf : B -> forest - | cons : tree -> forest -> forest. -\end{coq_eval} -\begin{coq_example*} -Scheme tree_forest_rec := Induction for tree - Sort Set - with forest_tree_rec := Induction for forest Sort Set. -\end{coq_example*} -You may now look at the type of {\tt tree\_forest\_rec} : -\begin{coq_example} -Check tree_forest_rec. -\end{coq_example} -This principle involves two different predicates for {\tt trees} and -{\tt forests}; it also has three premises each one corresponding to a -constructor of one of the inductive definitions. - -The principle {\tt tree\_forest\_rec} shares exactly the same -premises, only the conclusion now refers to the property of forests. -\begin{coq_example} -Check forest_tree_rec. -\end{coq_example} - -\begin{Variant} -\item {\tt Scheme {\ident$_1$} := Minimality for \term$_1$ Sort {\sort$_1$} \\ - with\\ - \mbox{}\hspace{0.1cm} .. \\ - with {\ident$_m$} := Minimality for {\term$_m$} Sort - {\sort$_m$}}\\ -Same as before but defines a non-dependent elimination principle more -natural in case of inductively defined relations. -\end{Variant} - -\Example -With the predicates {\tt odd} and {\tt even} inductively defined as: -% \begin{coq_eval} -% Restore State "Initial". -% \end{coq_eval} -\begin{coq_example*} -Inductive odd : nat -> Prop := - oddS : forall n:nat, even n -> odd (S n) -with even : nat -> Prop := - | evenO : even 0%N - | evenS : forall n:nat, odd n -> even (S n). -\end{coq_example*} -The following command generates a powerful elimination -principle: -\begin{coq_example*} -Scheme odd_even := Minimality for odd Sort Prop - with even_odd := Minimality for even Sort Prop. -\end{coq_example*} -The type of {\tt odd\_even} for instance will be: -\begin{coq_example} -Check odd_even. -\end{coq_example} -The type of {\tt even\_odd} shares the same premises but the -conclusion is {\tt (n:nat)(even n)->(Q n)}. - -\subsection[\tt Combined Scheme ...]{\tt Combined Scheme ...\index{CombinedScheme@{\tt Combined Scheme}}\label{CombinedScheme} -\label{combinedscheme}} -The {\tt Combined Scheme} command is a tool for combining -induction principles generated by the {\tt Scheme} command. -Its syntax follows the schema : - -\noindent -{\tt Combined Scheme {\ident$_0$} from {\ident$_1$}, .., {\ident$_n$}}\\ -\ident$_1$ \ldots \ident$_n$ are different inductive principles that must belong to -the same package of mutual inductive principle definitions. This command -generates {\ident$_0$} to be the conjunction of the principles: it is -build from the common premises of the principles and concluded by the -conjunction of their conclusions. For exemple, we can combine the -induction principles for trees and forests: - -\begin{coq_example*} -Combined Scheme tree_forest_mutind from tree_ind, forest_ind. -Check tree_forest_mutind. -\end{coq_example*} - -%\end{document} - diff --git a/doc/refman/RefMan-int.tex b/doc/refman/RefMan-int.tex index fbeccb664d..2b9e4e6051 100644 --- a/doc/refman/RefMan-int.tex +++ b/doc/refman/RefMan-int.tex @@ -58,7 +58,7 @@ Chapter~\ref{Addoc-coqide}. \section*{How to read this book} -This is a Reference Manual, not a User Manual, then it is not made for a +This is a Reference Manual, not a User Manual, so it is not made for a continuous reading. However, it has some structure that is explained below. @@ -100,6 +100,11 @@ corresponds to the Chapter~\ref{Addoc-syntax}. presented. Finally, Chapter~\ref{Addoc-coqide} describes the \Coq{} integrated development environment. + +\item The fifth part documents a number of advanced features, including + coercions, canonical structures, typeclasses, program extraction, and + specialized solvers and tactics. See the table of contents for a complete + list. \end{itemize} At the end of the document, after the global index, the user can find @@ -120,15 +125,6 @@ documents: user can read also the tutorial on recursive types (document {\tt RecTutorial.ps}). -\item[Addendum] The fifth part (the Addendum) of the Reference Manual - is distributed as a separate document. It contains more - detailed documentation and examples about some specific aspects of the - system that may interest only certain users. It shares the indexes, - the page numbers and - the bibliography with the Reference Manual. If you see in one of the - indexes a page number that is outside the Reference Manual, it refers - to the Addendum. - \item[Installation] A text file INSTALL that comes with the sources explains how to install \Coq{}. diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex index bb679ecba7..3ce1d4ecd8 100644 --- a/doc/refman/RefMan-ltac.tex +++ b/doc/refman/RefMan-ltac.tex @@ -392,7 +392,7 @@ all selected goals. \item{} [{\ident}] {\tt :} {\tacexpr} In this variant, {\tacexpr} is applied locally to a goal - previously named by the user. + previously named by the user (see~\ref{ExistentialVariables}). \item {\num} {\tt :} {\tacexpr} @@ -891,7 +891,7 @@ behavior can be retrieved with the {\tt Tactic Compat Context} flag. \end{Variants} -\subsubsection[Pattern matching on goals]{Pattern matching on goals\index{Ltac!match goal@\texttt{match goal}} +\subsubsection[Pattern matching on goals]{Pattern matching on goals\index{Ltac!match goal@\texttt{match goal}}\label{ltac-match-goal} \index{Ltac!match reverse goal@\texttt{match reverse goal}} \index{match goal@\texttt{match goal}!in Ltac} \index{match reverse goal@\texttt{match reverse goal}!in Ltac}} @@ -1131,8 +1131,9 @@ on. This can be obtained thanks to the option below. \optindex{Shrink Abstract} {\tt Set Shrink Abstract} \end{quote} +\emph{Deprecated since 8.7} -When set, all lemmas generated through \texttt{abstract {\tacexpr}} +When set (default), all lemmas generated through \texttt{abstract {\tacexpr}} and \texttt{transparent\_abstract {\tacexpr}} are quantified only over the variables that appear in the term constructed by \texttt{\tacexpr}. diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex index 3daaac88b1..bf48057cdf 100644 --- a/doc/refman/RefMan-oth.tex +++ b/doc/refman/RefMan-oth.tex @@ -656,7 +656,7 @@ dynamically. searched into the current {\ocaml} loadpath (see the command {\tt Add ML Path} in the Section~\ref{loadpath}). Loading of {\ocaml} files is only possible under the bytecode version of {\tt coqtop} -(i.e. {\tt coqtop} called with options {\tt -byte}, see chapter +(i.e. {\tt coqtop.byte}, see chapter \ref{Addoc-coqc}), or when {\Coq} has been compiled with a version of {\ocaml} that supports native {\tt Dynlink} ($\ge$ 3.11). @@ -739,7 +739,7 @@ the command {\tt Declare ML Module} in the Section~\ref{compiled}). \subsection[\tt Print ML Path {\str}.]{\tt Print ML Path {\str}.\comindex{Print ML Path}} This command displays the current {\ocaml} loadpath. This command makes sense only under the bytecode version of {\tt -coqtop}, i.e. using option {\tt -byte} (see the +coqtop}, i.e. {\tt coqtop.byte} (see the command {\tt Declare ML Module} in the section \ref{compiled}). diff --git a/doc/refman/RefMan-pro.tex b/doc/refman/RefMan-pro.tex index b66659dc8c..95fee3241c 100644 --- a/doc/refman/RefMan-pro.tex +++ b/doc/refman/RefMan-pro.tex @@ -421,6 +421,24 @@ This command displays the current goals. \item \errindex{No focused proof} \end{ErrMsgs} +\item {\tt Show {\ident}.}\\ + Displays the named goal {\ident}. + This is useful in particular to display a shelved goal but only works + if the corresponding existential variable has been named by the user + (see~\ref{ExistentialVariables}) as in the following example. + +\begin{coq_eval} +Reset Initial. +\end{coq_eval} + +\begin{coq_example*} +Goal exists n, n = 0. + eexists ?[n]. +\end{coq_example*} +\begin{coq_example} + Show n. +\end{coq_example} + \item {\tt Show Script.}\comindex{Show Script}\\ Displays the whole list of tactics applied from the beginning of the current proof. diff --git a/doc/refman/RefMan-sch.tex b/doc/refman/RefMan-sch.tex index d3719bed46..23a1c9b029 100644 --- a/doc/refman/RefMan-sch.tex +++ b/doc/refman/RefMan-sch.tex @@ -227,6 +227,7 @@ We define the function \texttt{div2} as follows: \begin{coq_eval} Reset Initial. +Require Import FunInd. \end{coq_eval} \begin{coq_example*} diff --git a/doc/refman/RefMan-syn.tex b/doc/refman/RefMan-syn.tex index ecaf82806e..084317776b 100644 --- a/doc/refman/RefMan-syn.tex +++ b/doc/refman/RefMan-syn.tex @@ -13,7 +13,7 @@ described in Section~\ref{scopes}. were present for a while in {\Coq} are no longer available from {\Coq} version 8.0. The underlying AST structure is also no longer available. The functionalities of the command {\tt Syntactic Definition} are -still available, see Section~\ref{Abbreviations}. +still available; see Section~\ref{Abbreviations}. \section[Notations]{Notations\label{Notation} \comindex{Notation}} @@ -35,8 +35,8 @@ The expression \texttt{(and A B)} is the abbreviated term and the string \verb="A /\ B"= (called a {\em notation}) tells how it is symbolically written. -A notation is always surrounded by double quotes (excepted when the -abbreviation is a single identifier, see \ref{Abbreviations}). The +A notation is always surrounded by double quotes (except when the +abbreviation is a single identifier; see \ref{Abbreviations}). The notation is composed of {\em tokens} separated by spaces. Identifiers in the string (such as \texttt{A} and \texttt{B}) are the {\em parameters} of the notation. They must occur at least once each in the @@ -68,7 +68,7 @@ declaration of the notation. \subsection[Precedences and associativity]{Precedences and associativity\index{Precedences} \index{Associativity}} -Mixing different symbolic notations in a same text may cause serious +Mixing different symbolic notations in the same text may cause serious parsing ambiguity. To deal with the ambiguity of notations, {\Coq} uses precedence levels ranging from 0 to 100 (plus one extra level numbered 200) and associativity rules. @@ -88,8 +88,8 @@ precedence level to each notation, knowing that a lower level binds more than a higher level. Hence the level for disjunction must be higher than the level for conjunction. -Since connectives are the less tight articulation points of a text, it -is reasonable to choose levels not so far from the higher level which +Since connectives are not tight articulation points of a text, it +is reasonable to choose levels not so far from the highest level which is 100, for example 85 for disjunction and 80 for conjunction\footnote{which are the levels effectively chosen in the current implementation of {\Coq}}. @@ -102,10 +102,10 @@ even consider that the expression is not well-formed and that parentheses are mandatory (this is a ``no associativity'')\footnote{ {\Coq} accepts notations declared as no associative but the parser on which {\Coq} is built, namely {\camlpppp}, currently does not implement the -no-associativity and replace it by a left associativity; hence it is +no-associativity and replaces it by a left associativity; hence it is the same for {\Coq}: no-associativity is in fact left associativity}. We don't know of a special convention of the associativity of -disjunction and conjunction, let's apply for instance a right +disjunction and conjunction, so let's apply for instance a right associativity (which is the choice of {\Coq}). Precedence levels and associativity rules of notations have to be @@ -701,11 +701,11 @@ Notation}. % Introduction An {\em interpretation scope} is a set of notations for terms with -their interpretation. Interpretation scopes provides with a weak, -purely syntactical form of notations overloading: a same notation, for -instance the infix symbol \verb=+= can be used to denote distinct -definitions of an additive operator. Depending on which interpretation -scopes is currently open, the interpretation is different. +their interpretation. Interpretation scopes provide a weak, +purely syntactical form of notation overloading: the same notation, for +instance the infix symbol \verb=+=, can be used to denote distinct +definitions of the additive operator. Depending on which interpretation +scope is currently open, the interpretation is different. Interpretation scopes can include an interpretation for numerals and strings. However, this is only made possible at the {\ocaml} level. @@ -889,7 +889,8 @@ statically. For instance, if {\tt f} is a polymorphic function of type recognized as an argument to be interpreted in scope {\scope}. \comindex{Bind Scope} -More generally, any {\class} (see Chapter~\ref{Coercions-full}) can be +\label{bindscope} +More generally, any coercion {\class} (see Chapter~\ref{Coercions-full}) can be bound to an interpretation scope. The command to do it is \begin{quote} {\tt Bind Scope} {\scope} \texttt{with} {\class} @@ -908,7 +909,7 @@ Open Scope nat_scope. (* Define + on the nat as the default for + *) Check (fun x y1 y2 z t => P _ (x + t) ((f _ (y1 + y2) + z))). \end{coq_example} -\Rem The scope {\tt type\_scope} has also a local effect on +\Rem The scopes {\tt type\_scope} and {\tt function\_scope} also have a local effect on interpretation. See the next section. \SeeAlso The command to show the scopes bound to the arguments of a @@ -940,10 +941,21 @@ Check # @@%mybool #. The scope {\tt type\_scope} has a special status. It is a primitive interpretation scope which is temporarily activated each time a -subterm of an expression is expected to be a type. This includes goals -and statements, types of binders, domain and codomain of implication, -codomain of products, and more generally any type argument of a -declared or defined constant. +subterm of an expression is expected to be a type. It is delimited by +the key {\tt type}, and bound to the coercion class {\tt Sortclass}. It is also +used in certain situations where an expression is statically known to +be a type, including the conclusion and the type of hypotheses within +an {\tt Ltac} goal match (see Section~\ref{ltac-match-goal}) +the statement of a theorem, the type of +a definition, the type of a binder, the domain and codomain of +implication, the codomain of products, and more generally any type +argument of a declared or defined constant. + +\subsection[The {\tt function\_scope} interpretation scope]{The {\tt function\_scope} interpretation scope\index{function\_scope@\texttt{function\_scope}}} + +The scope {\tt function\_scope} also has a special status. +It is temporarily activated each time the argument of a global reference is +recognized to be a {\tt Funclass instance}, i.e., of type {\tt forall x:A, B} or {\tt A -> B}. \subsection{Interpretation scopes used in the standard library of {\Coq}} @@ -953,38 +965,39 @@ commands {\tt Print Scopes} or {\tt Print Scope {\scope}}. \subsubsection{\tt type\_scope} -This includes infix {\tt *} for product types and infix {\tt +} for -sum types. It is delimited by key {\tt type}. +This scope includes infix {\tt *} for product types and infix {\tt +} for +sum types. It is delimited by key {\tt type}, and bound to the coercion class +{\tt Sortclass}, as described at \ref{bindscope}. \subsubsection{\tt nat\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt nat}. Positive numerals in this scope are mapped to their canonical representent built from {\tt O} and {\tt S}. The scope is -delimited by key {\tt nat}. +delimited by key {\tt nat}, and bound to the type {\tt nat} (see \ref{bindscope}). \subsubsection{\tt N\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt N} (binary natural numbers). It is delimited by key {\tt N} and comes with an interpretation for numerals as closed term of type {\tt Z}. \subsubsection{\tt Z\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt Z} (binary integer numbers). It is delimited by key {\tt Z} and comes with an interpretation for numerals as closed term of type {\tt Z}. \subsubsection{\tt positive\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt positive} (binary strictly positive numbers). It is delimited by key {\tt positive} and comes with an interpretation for numerals as closed term of type {\tt positive}. \subsubsection{\tt Q\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt Q} (rational numbers defined as fractions of an integer and a strictly positive integer modulo the equality of the numerator-denominator cross-product). As for numerals, only $0$ and @@ -993,13 +1006,13 @@ interpretations are $\frac{0}{1}$ and $\frac{1}{1}$ respectively). \subsubsection{\tt Qc\_scope} -This includes the standard arithmetical operators and relations on the +This scope includes the standard arithmetical operators and relations on the type {\tt Qc} of rational numbers defined as the type of irreducible fractions of an integer and a strictly positive integer. \subsubsection{\tt real\_scope} -This includes the standard arithmetical operators and relations on +This scope includes the standard arithmetical operators and relations on type {\tt R} (axiomatic real numbers). It is delimited by key {\tt R} and comes with an interpretation for numerals as term of type {\tt R}. The interpretation is based on the binary decomposition. The @@ -1014,35 +1027,40 @@ those of {\tt R}. \subsubsection{\tt bool\_scope} -This includes notations for the boolean operators. It is -delimited by key {\tt bool}. +This scope includes notations for the boolean operators. It is +delimited by key {\tt bool}, and bound to the type {\tt bool} (see \ref{bindscope}). \subsubsection{\tt list\_scope} -This includes notations for the list operators. It is -delimited by key {\tt list}. +This scope includes notations for the list operators. It is +delimited by key {\tt list}, and bound to the type {\tt list} (see \ref{bindscope}). + +\subsubsection{\tt function\_scope} + +This scope is delimited by the key {\tt function}, and bound to the coercion class {\tt Funclass}, +as described at \ref{bindscope}. \subsubsection{\tt core\_scope} -This includes the notation for pairs. It is delimited by key {\tt core}. +This scope includes the notation for pairs. It is delimited by key {\tt core}. \subsubsection{\tt string\_scope} -This includes notation for strings as elements of the type {\tt +This scope includes notation for strings as elements of the type {\tt string}. Special characters and escaping follow {\Coq} conventions on strings (see Section~\ref{strings}). Especially, there is no convention to visualize non printable characters of a string. The file {\tt String.v} shows an example that contains quotes, a newline -and a beep (i.e. the ascii character of code 7). +and a beep (i.e. the ASCII character of code 7). \subsubsection{\tt char\_scope} -This includes interpretation for all strings of the form -\verb!"!$c$\verb!"! where $c$ is an ascii character, or of the form +This scope includes interpretation for all strings of the form +\verb!"!$c$\verb!"! where $c$ is an ASCII character, or of the form \verb!"!$nnn$\verb!"! where $nnn$ is a three-digits number (possibly with leading 0's), or of the form \verb!""""!. Their respective -denotations are the ascii code of $c$, the decimal ascii code $nnn$, -or the ascii code of the character \verb!"! (i.e. the ascii code +denotations are the ASCII code of $c$, the decimal ASCII code $nnn$, +or the ASCII code of the character \verb!"! (i.e. the ASCII code 34), all of them being represented in the type {\tt ascii}. \subsection{Displaying informations about scopes} diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex index be75dc9d56..b13ae9b7b3 100644 --- a/doc/refman/RefMan-tac.tex +++ b/doc/refman/RefMan-tac.tex @@ -352,7 +352,7 @@ Section~\ref{pattern} to transform the goal so that it gets the form The tactic {\tt eapply} behaves like {\tt apply} but it does not fail when no instantiations are deducible for some variables in the - premises. Rather, it turns these variables into + premises. Rather, it turns these variables into existential variables which are variables still to instantiate (see Section~\ref{evars}). The instantiation is intended to be found later in the proof. @@ -1411,7 +1411,7 @@ in the list of subgoals remaining to prove. quantifications or non-dependent implications) are instantiated by concrete terms coming either from arguments \term$_1$ $\ldots$ \term$_n$ or from a bindings list (see - Section~\ref{Binding-list} for more about bindings lists). + Section~\ref{Binding-list} for more about bindings lists). In the first form the application to \term$_1$ {\ldots} \term$_n$ can be partial. The first form is equivalent to {\tt assert ({\ident} := {\ident} {\term$_1$} \dots\ \term$_n$)}. @@ -1515,23 +1515,33 @@ The {\tt evar} tactic creates a new local definition named \ident\ with type \term\ in the context. The body of this binding is a fresh existential variable. -\subsection{\tt instantiate ( {\num} := {\term} )} +\subsection{\tt instantiate ( {\ident} := {\term} )} \tacindex{instantiate} \label{instantiate} The {\tt instantiate} tactic refines (see Section~\ref{refine}) -an existential variable -with the term \term. The \num\ argument is the position of the -existential variable from right to left in the conclusion. This cannot be -the number of the existential variable since this number is different -in every session. +an existential variable {\ident} with the term {\term}. +It is equivalent to {\tt only [\ident]: refine \term} (preferred alternative). -When you are referring to hypotheses which you did not name +\begin{Remarks} +\item To be able to refer to an existential variable by name, the +user must have given the name explicitly (see~\ref{ExistentialVariables}). + +\item When you are referring to hypotheses which you did not name explicitly, be aware that Coq may make a different decision on how to name the variable in the current goal and in the context of the existential variable. This can lead to surprising behaviors. +\end{Remarks} \begin{Variants} + + \item {\tt instantiate ( {\num} := {\term} )} + This variant allows to refer to an existential variable which was not + named by the user. The {\num} argument is the position of the + existential variable from right to left in the goal. + Because this variant is not robust to slight changes in the goal, + its use is strongly discouraged. + \item {\tt instantiate ( {\num} := {\term} ) in \ident} \item {\tt instantiate ( {\num} := {\term} ) in ( Value of {\ident} )} @@ -2594,6 +2604,21 @@ Abort. This tactic behaves as generalizing \ident$_1$\dots\ \ident$_n$, then doing \texttt{inversion {\ident} using \ident$'$}. +\item \tacindex{inversion\_sigma} \texttt{inversion\_sigma} + + This tactic turns equalities of dependent pairs (e.g., + \texttt{existT P x p = existT P y q}, frequently left over by + \texttt{inversion} on a dependent type family) into pairs of + equalities (e.g., a hypothesis \texttt{H : x = y} and a hypothesis + of type \texttt{rew H in p = q}); these hypotheses can subsequently + be simplified using \texttt{subst}, without ever invoking any kind + of axiom asserting uniqueness of identity proofs. If you want to + explicitly specify the hypothesis to be inverted, or name the + generated hypotheses, you can invoke \texttt{induction H as [H1 H2] + using eq\_sigT\_rect}. This tactic also works for \texttt{sig}, + \texttt{sigT2}, and \texttt{sig2}, and there are similar + \texttt{eq\_sig\emph{*}\_rect} induction lemmas. + \end{Variants} \firstexample @@ -2688,6 +2713,64 @@ dependent inversion_clear H. Note that \texttt{H} has been substituted by \texttt{(LeS n m0 l)} and \texttt{m} by \texttt{(S m0)}. +\example{Using \texorpdfstring{\texttt{inversion\_sigma}}{inversion\_sigma}} + +Let us consider the following inductive type of length-indexed lists, +and a lemma about inverting equality of \texttt{cons}: + +\begin{coq_eval} +Reset Initial. +Set Printing Compact Contexts. +\end{coq_eval} + +\begin{coq_example*} +Require Coq.Logic.Eqdep_dec. + +Inductive vec A : nat -> Type := +| nil : vec A O +| cons {n} (x : A) (xs : vec A n) : vec A (S n). + +Lemma invert_cons : forall A n x xs y ys, + @cons A n x xs = @cons A n y ys + -> xs = ys. +Proof. +\end{coq_example*} + +\begin{coq_example} +intros A n x xs y ys H. +\end{coq_example} + +After performing \texttt{inversion}, we are left with an equality of +\texttt{existT}s: + +\begin{coq_example} +inversion H. +\end{coq_example} + +We can turn this equality into a usable form with +\texttt{inversion\_sigma}: + +\begin{coq_example} +inversion_sigma. +\end{coq_example} + +To finish cleaning up the proof, we will need to use the fact that +that all proofs of \texttt{n = n} for \texttt{n} a \texttt{nat} are +\texttt{eq\_refl}: + +\begin{coq_example} +let H := match goal with H : n = n |- _ => H end in +pose proof (Eqdep_dec.UIP_refl_nat _ H); subst H. +simpl in *. +\end{coq_example} + +Finally, we can finish the proof: + +\begin{coq_example} +assumption. +Qed. +\end{coq_example} + \subsection{\tt fix {\ident} {\num}} \tacindex{fix} \label{tactic:fix} @@ -2988,7 +3071,7 @@ activated, {\tt subst} also deals with the following corner cases: \item The presence of a recursive equation which without the option would be a cause of failure of {\tt subst}. - + \item A context with cyclic dependencies as with hypotheses {\tt \ident$_1$ = f~\ident$_2$} and {\tt \ident$_2$ = g~\ident$_1$} which without the option would be a cause of failure of {\tt subst}. @@ -3283,7 +3366,7 @@ a sort of strong normalization with two key differences: \begin{itemize} \item They unfold a constant if and only if it leads to a $\iota$-reduction, i.e. reducing a match or unfolding a fixpoint. -\item While reducing a constant unfolding to (co)fixpoints, +\item While reducing a constant unfolding to (co)fixpoints, the tactics use the name of the constant the (co)fixpoint comes from instead of the (co)fixpoint definition in recursive calls. @@ -3402,6 +3485,7 @@ reduced to \texttt{S t}. \optindex{Refolding Reduction} {\tt Refolding Reduction} \end{quote} +\emph{Deprecated since 8.7} This option (off by default) controls the use of the refolding strategy of {\tt cbn} while doing reductions in unification, type inference and @@ -4014,7 +4098,7 @@ Abort. & & e * & \text{ Kleene star } \\ & & \texttt{emp} & \text{ empty } \\ & & \texttt{eps} & \text{ epsilon } \\ - & & \texttt{(} e \texttt{)} & + & & \texttt{(} e \texttt{)} & \end{array}\] The \texttt{emp} regexp does not match any search path while @@ -4029,7 +4113,7 @@ is to set the cut expression to $c | e$, the initial cut expression being \texttt{emp}. -\item \texttt{Mode} {\tt (+ | ! | -)}$^*$ {\qualid} +\item \texttt{Mode} {\qualid} {\tt (+ | ! | -)}$^*$ \label{HintMode} \comindex{Hint Mode} @@ -5178,7 +5262,7 @@ Reset Initial. \subsection[\tt swap \num$_1$ \num$_2$]{\tt swap \num$_1$ \num$_2$\tacindex{swap}} -This tactic switches the position of the goals of indices $\num_1$ and $\num_2$. If either $\num_1$ or $\num_2$ is negative then goals are counted from the end of the focused goal list. Goals are indexed from $1$, there is no goal with position $0$. +This tactic switches the position of the goals of indices $\num_1$ and $\num_2$. If either $\num_1$ or $\num_2$ is negative then goals are counted from the end of the focused goal list. Goals are indexed from $1$, there is no goal with position $0$. \Example \begin{coq_example*} diff --git a/doc/refman/RefMan-tacex.tex b/doc/refman/RefMan-tacex.tex index 9f4ddc8044..cb8f916f13 100644 --- a/doc/refman/RefMan-tacex.tex +++ b/doc/refman/RefMan-tacex.tex @@ -849,7 +849,7 @@ Ltac DSimplif trm := Ltac Length trm := match trm with | (_ * ?B) => let succ := Length B in constr:(S succ) - | _ => constr:1 + | _ => constr:(1) end. Ltac assoc := repeat rewrite <- Ass. \end{coq_example} diff --git a/doc/refman/RefMan-uti.tex b/doc/refman/RefMan-uti.tex index 08cdbee503..768d0df763 100644 --- a/doc/refman/RefMan-uti.tex +++ b/doc/refman/RefMan-uti.tex @@ -60,7 +60,7 @@ subdirectory of the sources. The majority of \Coq\ projects are very similar: a collection of {\tt .v} files and eventually some {\tt .ml} ones (a \Coq\ plugin). The main piece -of metadata needed in order to build the project are the command +of metadata needed in order to build the project are the command line options to {\tt coqc} (e.g. {\tt -R, -I}, \SeeAlso Section~\ref{coqoptions}). Collecting the list of files and options is the job of the {\tt \_CoqProject} file. @@ -98,7 +98,7 @@ Such command generates the following files: An optional file {\bf {\tt CoqMakefile.local}} can be provided by the user in order to extend {\tt CoqMakefile}. In particular one can declare custom actions to be performed before or after the build process. Similarly one can customize the install target or even provide new targets. Extension points are documented in the {\tt CoqMakefile} file. The extensions of the files listed in {\tt \_CoqProject} is -used in order to decide how to build them In particular: +used in order to decide how to build them. In particular: \begin{itemize} \item {\Coq} files must use the \texttt{.v} extension @@ -108,12 +108,171 @@ used in order to decide how to build them In particular: \end{itemize} The use of \texttt{.mlpack} files has to be preferred over \texttt{.mllib} -files, since it results in a ``packed'' plugin: All auxiliary +files, since it results in a ``packed'' plugin: All auxiliary modules (as {\tt Baz} and {\tt Bazaux}) are hidden inside the plugin's ``name space'' ({\tt Qux\_plugin}). This reduces the chances of begin unable to load two distinct plugins because of a clash in their auxiliary module names. +\paragraph{Timing targets and performance testing} +The generated \texttt{Makefile} supports the generation of two kinds +of timing data: per-file build-times, and per-line times for an +individual file. + +The following targets and \texttt{Makefile} variables allow collection +of per-file timing data: +\begin{itemize} +\item \texttt{TIMED=1} --- passing this variable will cause + \texttt{make} to emit a line describing the user-space build-time + and peak memory usage for each file built. + + \texttt{Note}: On Mac OS, this works best if you've installed + \texttt{gnu-time}. + + \texttt{Example}: For example, the output of \texttt{make TIMED=1} + may look like this: +\begin{verbatim} +COQDEP Fast.v +COQDEP Slow.v +COQC Slow.v +Slow (user: 0.34 mem: 395448 ko) +COQC Fast.v +Fast (user: 0.01 mem: 45184 ko) +\end{verbatim} +\item \texttt{pretty-timed} --- this target stores the output of + \texttt{make TIMED=1} into \texttt{time-of-build.log}, and displays + a table of the times, sorted from slowest to fastest, which is also + stored in \texttt{time-of-build-pretty.log}. If you want to + construct the log for targets other than the default one, you can + pass them via the variable \texttt{TGTS}, e.g., \texttt{make + pretty-timed TGTS="a.vo b.vo"}. + + \texttt{Note}: This target requires \texttt{python} to build the table. + + \texttt{Note}: This target will \emph{append} to the timing log; if + you want a fresh start, you must remove the file + \texttt{time-of-build.log} or run \texttt{make cleanall}. + + \texttt{Example}: For example, the output of \texttt{make + pretty-timed} may look like this: +\begin{verbatim} +COQDEP Fast.v +COQDEP Slow.v +COQC Slow.v +Slow (user: 0.36 mem: 393912 ko) +COQC Fast.v +Fast (user: 0.05 mem: 45992 ko) +Time | File Name +-------------------- +0m00.41s | Total +-------------------- +0m00.36s | Slow +0m00.05s | Fast +\end{verbatim} +\item \texttt{print-pretty-timed-diff} --- this target builds a table + of timing changes between two compilations; run \texttt{make + make-pretty-timed-before} to build the log of the ``before'' + times, and run \texttt{make make-pretty-timed-after} to build the + log of the ``after'' times. The table is printed on the command + line, and stored in \texttt{time-of-build-both.log}. This target is + most useful for profiling the difference between two commits to a + repo. + + \texttt{Note}: This target requires \texttt{python} to build the table. + + \texttt{Note}: The \texttt{make-pretty-timed-before} and + \texttt{make-pretty-timed-after} targets will \emph{append} to the + timing log; if you want a fresh start, you must remove the files + \texttt{time-of-build-before.log} and + \texttt{time-of-build-after.log} or run \texttt{make cleanall} + \emph{before} building either the ``before'' or ``after'' targets. + + \texttt{Note}: The table will be sorted first by absolute time + differences rounded towards zero to a whole-number of seconds, then + by times in the ``after'' column, and finally lexicographically by + file name. This will put the biggest changes in either direction + first, and will prefer sorting by build-time over subsecond changes + in build time (which are frequently noise); lexicographic sorting + forces an order on files which take effectively no time to compile. + + \texttt{Example}: For example, the output table from \texttt{make + print-pretty-timed-diff} may look like this: +\begin{verbatim} +After | File Name | Before || Change | % Change +-------------------------------------------------------- +0m00.39s | Total | 0m00.35s || +0m00.03s | +11.42% +-------------------------------------------------------- +0m00.37s | Slow | 0m00.01s || +0m00.36s | +3600.00% +0m00.02s | Fast | 0m00.34s || -0m00.32s | -94.11% +\end{verbatim} +\end{itemize} + +The following targets and \texttt{Makefile} variables allow collection +of per-line timing data: +\begin{itemize} +\item \texttt{TIMING=1} --- passing this variable will cause + \texttt{make} to use \texttt{coqc -time} to write to a + \texttt{.v.timing} file for each \texttt{.v} file compiled, which + contains line-by-line timing information. + + \texttt{Example}: For example, running \texttt{make all TIMING=1} may + result in a file like this: +\begin{verbatim} +Chars 0 - 26 [Require~Coq.ZArith.BinInt.] 0.157 secs (0.128u,0.028s) +Chars 27 - 68 [Declare~Reduction~comp~:=~vm_c...] 0. secs (0.u,0.s) +Chars 69 - 162 [Definition~foo0~:=~Eval~comp~i...] 0.153 secs (0.136u,0.019s) +Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] 0.239 secs (0.236u,0.s) +\end{verbatim} + +\item \texttt{print-pretty-single-time-diff + BEFORE=path/to/file.v.before-timing + AFTER=path/to/file.v.after-timing} --- this target will make a + sorted table of the per-line timing differences between the timing + logs in the \texttt{BEFORE} and \texttt{AFTER} files, display it, + and save it to the file specified by the + \texttt{TIME\_OF\_PRETTY\_BUILD\_FILE} variable, which defaults to + \texttt{time-of-build-pretty.log}. + + To generate the \texttt{.v.before-timing} or + \texttt{.v.after-timing} files, you should pass + \texttt{TIMING=before} or \texttt{TIMING=after} rather than + \texttt{TIMING=1}. + + \texttt{Note}: The sorting used here is the same as in the + \texttt{print-pretty-timed-diff} target. + + \texttt{Note}: This target requires \texttt{python} to build the table. + + \texttt{Example}: For example, running + \texttt{print-pretty-single-time-diff} might give a table like this: +\begin{verbatim} +After | Code | Before || Change | % Change +--------------------------------------------------------------------------------------------------- +0m00.50s | Total | 0m04.17s || -0m03.66s | -87.96% +--------------------------------------------------------------------------------------------------- +0m00.145s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.192s || -0m00.04s | -24.47% +0m00.126s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.143s || -0m00.01s | -11.88% + N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | 0m00.s || +0m00.00s | N/A +0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | N/A || +0m00.00s | N/A +0m00.231s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m03.836s || -0m03.60s | -93.97% +\end{verbatim} + +\item \texttt{all.timing.diff}, \texttt{path/to/file.v.timing.diff} + --- The \texttt{path/to/file.v.timing.diff} target will make a + \texttt{.v.timing.diff} file for the corresponding \texttt{.v} file, + with a table as would be generated by the + \texttt{print-pretty-single-time-diff} target; it depends on having + already made the corresponding \texttt{.v.before-timing} and + \texttt{.v.after-timing} files, which can be made by passing + \texttt{TIMING=before} and \texttt{TIMING=after}. The + \texttt{all.timing.diff} target will make such timing difference + files for all of the \texttt{.v} files that the \texttt{Makefile} + knows about. It will fail if some \texttt{.v.before-timing} or + \texttt{.v.after-timing} files don't exist. + + \texttt{Note}: This target requires \texttt{python} to build the table. +\end{itemize} + \paragraph{Notes about including the generated Makefile} This practice is discouraged. The contents of this file, including variable names @@ -121,6 +280,43 @@ and status of rules shall change in the future. Users are advised to include {\tt Makefile.conf} or call a target of the generated Makefile as in {\tt make -f Makefile target} from another Makefile. +One way to get access to all targets of the generated +\texttt{CoqMakefile} is to have a generic target for invoking unknown +targets. For example: +\begin{verbatim} +# KNOWNTARGETS will not be passed along to CoqMakefile +KNOWNTARGETS := CoqMakefile extra-stuff extra-stuff2 +# KNOWNFILES will not get implicit targets from the final rule, and so +# depending on them won't invoke the submake +# Warning: These files get declared as PHONY, so any targets depending +# on them always get rebuilt +KNOWNFILES := Makefile _CoqProject + +.DEFAULT_GOAL := invoke-coqmakefile + +CoqMakefile: Makefile _CoqProject + $(COQBIN)coq_makefile -f _CoqProject -o CoqMakefile + +invoke-coqmakefile: CoqMakefile + $(MAKE) --no-print-directory -f CoqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) + +.PHONY: invoke-coqmakefile $(KNOWNFILES) + +#################################################################### +#################################################################### +#################################################################### +#################################################################### +## Your targets here ## +#################################################################### +#################################################################### +#################################################################### +#################################################################### + +# This should be the last rule, to handle any targets not declared above +%: invoke-coqmakefile + @true +\end{verbatim} + \paragraph{Notes for users of {\tt coq\_makefile} with version $<$ 8.7} \begin{itemize} @@ -128,7 +324,7 @@ as in {\tt make -f Makefile target} from another Makefile. or after the build (like invoking make on a subdirectory) one can hook in {\tt pre-all} and {\tt post-all} extension points \item \texttt{-extra-phony} and \texttt{-extra} are deprecated. To provide - additional target ({\tt .PHONY} or not) please use + additional target ({\tt .PHONY} or not) please use {\tt CoqMakefile.local} \end{itemize} diff --git a/doc/refman/Setoid.tex b/doc/refman/Setoid.tex index 2c9602a229..6c79284389 100644 --- a/doc/refman/Setoid.tex +++ b/doc/refman/Setoid.tex @@ -156,9 +156,9 @@ compatibility constraints. \begin{cscexample}[Rewriting] Continuing the previous examples, suppose that the user must prove \texttt{set\_eq int (union int (union int S1 S2) S2) (f S1 S2)} under the -hypothesis \texttt{H: set\_eq int S2 (nil int)}. It is possible to +hypothesis \texttt{H: set\_eq int S2 (@nil int)}. It is possible to use the \texttt{rewrite} tactic to replace the first two occurrences of -\texttt{S2} with \texttt{nil int} in the goal since the context +\texttt{S2} with \texttt{@nil int} in the goal since the context \texttt{set\_eq int (union int (union int S1 nil) nil) (f S1 S2)}, being a composition of morphisms instances, is a morphism. However the tactic will fail replacing the third occurrence of \texttt{S2} unless \texttt{f} diff --git a/doc/refman/Universes.tex b/doc/refman/Universes.tex index 2bb1301c79..cd36d1d320 100644 --- a/doc/refman/Universes.tex +++ b/doc/refman/Universes.tex @@ -134,12 +134,14 @@ producing global universe constraints, one can use the \asection{{\tt Cumulative, NonCumulative}} \comindex{Cumulative} \comindex{NonCumulative} -\optindex{Inductive Cumulativity} +\optindex{Polymorphic Inductive Cumulativity} -Inductive types, coinductive types, variants and records can be +Polymorphic inductive types, coinductive types, variants and records can be declared cumulative using the \texttt{Cumulative}. Alternatively, -there is an option \texttt{Set Inductive Cumulativity} which when set, -makes all subsequent inductive definitions cumulative. Consider the examples below. +there is an option \texttt{Set Polymorphic Inductive Cumulativity} which when set, +makes all subsequent \emph{polymorphic} inductive definitions cumulative. When set, +inductive types and the like can be enforced to be +\emph{non-cumulative} using the \texttt{NonCumulative} prefix. Consider the examples below. \begin{coq_example*} Polymorphic Cumulative Inductive list {A : Type} := | nil : list @@ -158,24 +160,61 @@ This also means that any two instances of \texttt{list} are convertible: $\WTEGCONV{\mathtt{list@\{i\}} A}{\mathtt{list@\{j\}} B}$ whenever $\WTEGCONV{A}{B}$ and furthermore their corresponding (when fully applied to convertible arguments) constructors. See Chapter~\ref{Cic} for more details on convertibility and subtyping. -Also notice the subtyping constraints for the \emph{non-cumulative} version of list: +The following is an example of a record with non-trivial subtyping relation: \begin{coq_example*} -Polymorphic NonCumulative Inductive list' {A : Type} := -| nil' : list' -| cons' : A -> list' -> list'. +Polymorphic Cumulative Record packType := {pk : Type}. \end{coq_example*} \begin{coq_example} -Print list'. +Print packType. +\end{coq_example} +Notice that as expected, \texttt{packType@\{i\}} and \texttt{packType@\{j\}} are +convertible if and only if \texttt{i $=$ j}. + +Cumulative inductive types, coninductive types, variants and records +only make sense when they are universe polymorphic. Therefore, an +error is issued whenever the user uses the \texttt{Cumulative} or +\texttt{NonCumulative} prefix in a monomorphic context. +Notice that this is not the case for the option \texttt{Set Polymorphic Inductive Cumulativity}. +That is, this option, when set, makes all subsequent \emph{polymorphic} +inductive declarations cumulative (unless, of course the \texttt{NonCumulative} prefix is used) +but has no effect on \emph{monomorphic} inductive declarations. +Consider the following examples. +\begin{coq_example} +Monomorphic Cumulative Inductive Unit := unit. +\end{coq_example} +\begin{coq_example} +Monomorphic NonCumulative Inductive Unit := unit. \end{coq_example} -The following is an example of a record with non-trivial subtyping relation: \begin{coq_example*} -Polymorphic Cumulative Record packType := {pk : Type}. +Set Polymorphic Inductive Cumulativity. +Inductive Unit := unit. \end{coq_example*} \begin{coq_example} -Print packType. +Print Unit. \end{coq_example} -Notice that as expected, \texttt{packType@\{i\}} and \texttt{packType@\{j\}} are convertible if and only if \texttt{i $=$ j}. +\subsection*{An example of a proof using cumulativity} + +\begin{coq_example} +Set Universe Polymorphism. +Set Polymorphic Inductive Cumulativity. + +Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x. + +Definition funext_type@{a b e} (A : Type@{a}) (B : A -> Type@{b}) + := forall f g : (forall a, B a), + (forall x, eq@{e} (f x) (g x)) + -> eq@{e} f g. + +Section down. + Universes a b e e'. + Constraint e' < e. + Lemma funext_down {A B} + (H : @funext_type@{a b e} A B) : @funext_type@{a b e'} A B. + Proof. + exact H. + Defined. +\end{coq_example} \asection{Global and local universes} diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template index 48f82f2d92..48048b7a0f 100644 --- a/doc/stdlib/index-list.html.template +++ b/doc/stdlib/index-list.html.template @@ -591,5 +591,6 @@ through the <tt>Require Import</tt> command.</p> theories/Compat/AdmitAxiom.v theories/Compat/Coq85.v theories/Compat/Coq86.v + theories/Compat/Coq87.v </dd> </dl> diff --git a/doc/tutorial/Tutorial.tex b/doc/tutorial/Tutorial.tex index 30b6304c16..77ce8574f2 100644 --- a/doc/tutorial/Tutorial.tex +++ b/doc/tutorial/Tutorial.tex @@ -23,7 +23,7 @@ of Inductive Constructions. It allows the interactive construction of formal proofs, and also the manipulation of functional programs consistently with their specifications. It runs as a computer program on many architectures. -%, and mainly on Unix machines. + It is available with a variety of user interfaces. The present document does not attempt to present a comprehensive view of all the possibilities of \Coq, but rather to present in the most elementary @@ -33,63 +33,34 @@ proof tools. For more advanced information, the reader could refer to the \Coq{} Reference Manual or the \textit{Coq'Art}, a book by Y. Bertot and P. Castéran on practical uses of the \Coq{} system. -Coq can be used from a standard teletype-like shell window but -preferably through the graphical user interface -CoqIde\footnote{Alternative graphical interfaces exist: Proof General -and Pcoq.}. - Instructions on installation procedures, as well as more comprehensive documentation, may be found in the standard distribution of \Coq, -which may be obtained from \Coq{} web site \url{https://coq.inria.fr/}. - -In the following, we assume that \Coq{} is called from a standard -teletype-like shell window. All examples preceded by the prompting -sequence \verb:Coq < : represent user input, terminated by a -period. - -The following lines usually show \Coq's answer as it appears on the -users screen. When used from a graphical user interface such as -CoqIde, the prompt is not displayed: user input is given in one window +which may be obtained from \Coq{} web site +\url{https://coq.inria.fr/}\footnote{You can report any bug you find +while using \Coq{} at \url{https://coq.inria.fr/bugs}. Make sure to +always provide a way to reproduce it and to specify the exact version +you used. You can get this information by running \texttt{coqc -v}}. +\Coq{} is distributed together with a graphical user interface called +CoqIDE. Alternative interfaces exist such as +Proof General\footnote{See \url{https://proofgeneral.github.io/}.}. + +In the following examples, lines preceded by the prompt \verb:Coq < : +represent user input, terminated by a period. +The following lines usually show \Coq's answer. +When used from a graphical user interface such as +CoqIDE, the prompt is not displayed: user input is given in one window and \Coq's answers are displayed in a different window. -The sequence of such examples is a valid \Coq{} -session, unless otherwise specified. This version of the tutorial has -been prepared on a PC workstation running Linux. The standard -invocation of \Coq{} delivers a message such as: - -\begin{small} -\begin{flushleft} -\begin{verbatim} -unix:~> coqtop -Welcome to Coq 8.2 (January 2009) - -Coq < -\end{verbatim} -\end{flushleft} -\end{small} - -The first line gives a banner stating the precise version of \Coq{} -used. You should always return this banner when you report an anomaly -to our bug-tracking system -\url{https://coq.inria.fr/bugs/}. - \chapter{Basic Predicate Calculus} \section{An overview of the specification language Gallina} A formal development in Gallina consists in a sequence of {\sl declarations} -and {\sl definitions}. You may also send \Coq{} {\sl commands} which are -not really part of the formal development, but correspond to information -requests, or service routine invocations. For instance, the command: -\begin{verbatim} -Coq < Quit. -\end{verbatim} -terminates the current session. +and {\sl definitions}. \subsection{Declarations} -A declaration associates a {\sl name} with -a {\sl specification}. +A declaration associates a {\sl name} with a {\sl specification}. A name corresponds roughly to an identifier in a programming language, i.e. to a string of letters, digits, and a few ASCII symbols like underscore (\verb"_") and prime (\verb"'"), starting with a letter. @@ -165,25 +136,25 @@ in the current context: Check gt. \end{coq_example} -which tells us that \verb:gt: is a function expecting two arguments of -type \verb:nat: in order to build a logical proposition. +which tells us that \texttt{gt} is a function expecting two arguments of +type \texttt{nat} in order to build a logical proposition. What happens here is similar to what we are used to in a functional -programming language: we may compose the (specification) type \verb:nat: -with the (abstract) type \verb:Prop: of logical propositions through the +programming language: we may compose the (specification) type \texttt{nat} +with the (abstract) type \texttt{Prop} of logical propositions through the arrow function constructor, in order to get a functional type -\verb:nat->Prop:: +\texttt{nat -> Prop}: \begin{coq_example} Check (nat -> Prop). \end{coq_example} -which may be composed one more times with \verb:nat: in order to obtain the -type \verb:nat->nat->Prop: of binary relations over natural numbers. -Actually the type \verb:nat->nat->Prop: is an abbreviation for -\verb:nat->(nat->Prop):. +which may be composed once more with \verb:nat: in order to obtain the +type \texttt{nat -> nat -> Prop} of binary relations over natural numbers. +Actually the type \texttt{nat -> nat -> Prop} is an abbreviation for +\texttt{nat -> (nat -> Prop)}. Functional notions may be composed in the usual way. An expression $f$ of type $A\ra B$ may be applied to an expression $e$ of type $A$ in order to form the expression $(f~e)$ of type $B$. Here we get that -the expression \verb:(gt n): is well-formed of type \verb:nat->Prop:, +the expression \verb:(gt n): is well-formed of type \texttt{nat -> Prop}, and thus that the expression \verb:(gt n O):, which abbreviates \verb:((gt n) O):, is a well-formed proposition. \begin{coq_example} @@ -193,11 +164,12 @@ Check gt n O. \subsection{Definitions} The initial prelude contains a few arithmetic definitions: -\verb:nat: is defined as a mathematical collection (type \verb:Set:), constants -\verb:O:, \verb:S:, \verb:plus:, are defined as objects of types -respectively \verb:nat:, \verb:nat->nat:, and \verb:nat->nat->nat:. +\texttt{nat} is defined as a mathematical collection (type \texttt{Set}), +constants \texttt{O}, \texttt{S}, \texttt{plus}, are defined as objects of +types respectively \texttt{nat}, \texttt{nat -> nat}, and \texttt{nat -> +nat -> nat}. You may introduce new definitions, which link a name to a well-typed value. -For instance, we may introduce the constant \verb:one: as being defined +For instance, we may introduce the constant \texttt{one} as being defined to be equal to the successor of zero: \begin{coq_example} Definition one := (S O). @@ -217,17 +189,18 @@ argument \verb:m: of type \verb:nat: in order to build its result as \verb:(plus m m):: \begin{coq_example} -Definition double (m:nat) := plus m m. +Definition double (m : nat) := plus m m. \end{coq_example} This introduces the constant \texttt{double} defined as the -expression \texttt{fun m:nat => plus m m}. -The abstraction introduced by \texttt{fun} is explained as follows. The expression -\verb+fun x:A => e+ is well formed of type \verb+A->B+ in a context -whenever the expression \verb+e+ is well-formed of type \verb+B+ in -the given context to which we add the declaration that \verb+x+ -is of type \verb+A+. Here \verb+x+ is a bound, or dummy variable in -the expression \verb+fun x:A => e+. For instance we could as well have -defined \verb:double: as \verb+fun n:nat => (plus n n)+. +expression \texttt{fun m : nat => plus m m}. +The abstraction introduced by \texttt{fun} is explained as follows. +The expression \texttt{fun x : A => e} is well formed of type +\texttt{A -> B} in a context whenever the expression \texttt{e} is +well-formed of type \texttt{B} in the given context to which we add the +declaration that \texttt{x} is of type \texttt{A}. Here \texttt{x} is a +bound, or dummy variable in the expression \texttt{fun x : A => e}. +For instance we could as well have defined \texttt{double} as +\texttt{fun n : nat => (plus n n)}. Bound (local) variables and free (global) variables may be mixed. For instance, we may define the function which adds the constant \verb:n: @@ -243,19 +216,17 @@ Binding operations are well known for instance in logic, where they are called quantifiers. Thus we may universally quantify a proposition such as $m>0$ in order to get a universal proposition $\forall m\cdot m>0$. Indeed this operator is available in \Coq, with -the following syntax: \verb+forall m:nat, gt m O+. Similarly to the +the following syntax: \texttt{forall m : nat, gt m O}. Similarly to the case of the functional abstraction binding, we are obliged to declare explicitly the type of the quantified variable. We check: \begin{coq_example} -Check (forall m:nat, gt m 0). -\end{coq_example} -We may revert to the clean state of -our initial session using the \Coq{} \verb:Reset: command: -\begin{coq_example} -Reset Initial. +Check (forall m : nat, gt m 0). \end{coq_example} + \begin{coq_eval} +Reset Initial. Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} \section{Introduction to the proof engine: Minimal Logic} @@ -270,7 +241,7 @@ Variables A B C : Prop. \end{coq_example} We shall consider simple implications, such as $A\ra B$, read as -``$A$ implies $B$''. Remark that we overload the arrow symbol, which +``$A$ implies $B$''. Note that we overload the arrow symbol, which has been used above as the functionality type constructor, and which may be used as well as propositional connective: \begin{coq_example} @@ -318,7 +289,7 @@ apply H. We are now in the situation where we have two judgments as conjectures that remain to be proved. Only the first is listed in full, for the others the system displays only the corresponding subgoal, without its -local hypotheses list. Remark that \verb:apply: has kept the local +local hypotheses list. Note that \verb:apply: has kept the local hypotheses of its father judgment, which are still available for the judgments it generated. @@ -340,17 +311,12 @@ the current goal is solvable from the current local assumptions: assumption. \end{coq_example} -The proof is now finished. We may either discard it, by using the -command \verb:Abort: which returns to the standard \Coq{} toplevel loop -without further ado, or else save it as a lemma in the current context, -under name say \verb:trivial_lemma:: +The proof is now finished. We are now going to ask \Coq{}'s kernel +to check and save the proof. \begin{coq_example} -Save trivial_lemma. +Qed. \end{coq_example} -As a comment, the system shows the proof script listing all tactic -commands used in the proof. - Let us redo the same proof with a few variations. First of all we may name the initial goal as a conjectured lemma: \begin{coq_example} @@ -383,46 +349,30 @@ We may thus complete the proof of \verb:distr_impl: with one composite tactic: apply H; [ assumption | apply H0; assumption ]. \end{coq_example} -Let us now save lemma \verb:distr_impl:: -\begin{coq_example} -Qed. -\end{coq_example} - -Here \verb:Qed: needs no argument, since we gave the name \verb:distr_impl: -in advance. +You should be aware however that relying on automatically generated names is +not robust to slight updates to this proof script. Consequently, it is +discouraged in finished proof scripts. As for the composition of tactics with +\texttt{:} it may hinder the readability of the proof script and it is also +harder to see what's going on when replaying the proof because composed +tactics are evaluated in one go. Actually, such an easy combination of tactics \verb:intro:, \verb:apply: and \verb:assumption: may be found completely automatically by an automatic tactic, called \verb:auto:, without user guidance: -\begin{coq_example} -Lemma distr_imp : (A -> B -> C) -> (A -> B) -> A -> C. -auto. -\end{coq_example} - -This time, we do not save the proof, we just discard it with the \verb:Abort: -command: -\begin{coq_example} +\begin{coq_eval} Abort. +\end{coq_eval} +\begin{coq_example} +Lemma distr_impl : (A -> B -> C) -> (A -> B) -> A -> C. +auto. \end{coq_example} -At any point during a proof, we may use \verb:Abort: to exit the proof mode -and go back to Coq's main loop. We may also use \verb:Restart: to restart -from scratch the proof of the same lemma. We may also use \verb:Undo: to -backtrack one step, and more generally \verb:Undo n: to -backtrack n steps. - -We end this section by showing a useful command, \verb:Inspect n.:, -which inspects the global \Coq{} environment, showing the last \verb:n: declared -notions: +Let us now save lemma \verb:distr_impl:: \begin{coq_example} -Inspect 3. +Qed. \end{coq_example} -The declarations, whether global parameters or axioms, are shown preceded by -\verb:***:; definitions and lemmas are stated with their specification, but -their value (or proof-term) is omitted. - \section{Propositional Calculus} \subsection{Conjunction} @@ -438,7 +388,7 @@ connective. Let us show how to use these ideas for the propositional connectives \begin{coq_example} Lemma and_commutative : A /\ B -> B /\ A. -intro. +intro H. \end{coq_example} We make use of the conjunctive hypothesis \verb:H: with the \verb:elim: tactic, @@ -453,8 +403,11 @@ conjunctive goal into the two subgoals: split. \end{coq_example} and the proof is now trivial. Indeed, the whole proof is obtainable as follows: +\begin{coq_eval} +Abort. +\end{coq_eval} \begin{coq_example} -Restart. +Lemma and_commutative : A /\ B -> B /\ A. intro H; elim H; auto. Qed. \end{coq_example} @@ -465,7 +418,7 @@ conjunction introduction operator \verb+conj+ Check conj. \end{coq_example} -Actually, the tactic \verb+Split+ is just an abbreviation for \verb+apply conj.+ +Actually, the tactic \verb+split+ is just an abbreviation for \verb+apply conj.+ What we have just seen is that the \verb:auto: tactic is more powerful than just a simple application of local hypotheses; it tries to apply as well @@ -498,6 +451,17 @@ clear away unnecessary hypotheses which may clutter your screen. clear H. \end{coq_example} +The tactic \verb:destruct: combines the effects of \verb:elim:, \verb:intros:, +and \verb:clear:: + +\begin{coq_eval} +Abort. +\end{coq_eval} +\begin{coq_example} +Lemma or_commutative : A \/ B -> B \/ A. +intros H; destruct H. +\end{coq_example} + The disjunction connective has two introduction rules, since \verb:P\/Q: may be obtained from \verb:P: or from \verb:Q:; the two corresponding proof constructors are called respectively \verb:or_introl: and @@ -528,8 +492,11 @@ such a simple tautology. The reason is that we want to keep A complete tactic for propositional tautologies is indeed available in \Coq{} as the \verb:tauto: tactic. +\begin{coq_eval} +Abort. +\end{coq_eval} \begin{coq_example} -Restart. +Lemma or_commutative : A \/ B -> B \/ A. tauto. Qed. \end{coq_example} @@ -541,8 +508,8 @@ currently defined in the context: Print or_commutative. \end{coq_example} -It is not easy to understand the notation for proof terms without a few -explanations. The \texttt{fun} prefix, such as \verb+fun H:A\/B =>+, +It is not easy to understand the notation for proof terms without some +explanations. The \texttt{fun} prefix, such as \verb+fun H : A\/B =>+, corresponds to \verb:intro H:, whereas a subterm such as \verb:(or_intror: \verb:B H0): @@ -572,15 +539,17 @@ Lemma Peirce : ((A -> B) -> A) -> A. try tauto. \end{coq_example} -Note the use of the \verb:Try: tactical, which does nothing if its tactic +Note the use of the \verb:try: tactical, which does nothing if its tactic argument fails. This may come as a surprise to someone familiar with classical reasoning. Peirce's lemma is true in Boolean logic, i.e. it evaluates to \verb:true: for every truth-assignment to \verb:A: and \verb:B:. Indeed the double negation of Peirce's law may be proved in \Coq{} using \verb:tauto:: -\begin{coq_example} +\begin{coq_eval} Abort. +\end{coq_eval} +\begin{coq_example} Lemma NNPeirce : ~ ~ (((A -> B) -> A) -> A). tauto. Qed. @@ -651,26 +620,20 @@ function and predicate symbols. \subsection{Sections and signatures} Usually one works in some domain of discourse, over which range the individual -variables and function symbols. In \Coq{} we speak in a language with a rich -variety of types, so me may mix several domains of discourse, in our +variables and function symbols. In \Coq{}, we speak in a language with a rich +variety of types, so we may mix several domains of discourse, in our multi-sorted language. For the moment, we just do a few exercises, over a domain of discourse \verb:D: axiomatised as a \verb:Set:, and we consider two predicate symbols \verb:P: and \verb:R: over \verb:D:, of arities -respectively 1 and 2. Such abstract entities may be entered in the context -as global variables. But we must be careful about the pollution of our -global environment by such declarations. For instance, we have already -polluted our \Coq{} session by declaring the variables -\verb:n:, \verb:Pos_n:, \verb:A:, \verb:B:, and \verb:C:. +1 and 2, respectively. -\begin{coq_example} -Reset Initial. -\end{coq_example} \begin{coq_eval} +Reset Initial. Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} -We shall now declare a new \verb:Section:, which will allow us to define -notions local to a well-delimited scope. We start by assuming a domain of +We start by assuming a domain of discourse \verb:D:, and a binary relation \verb:R: over \verb:D:: \begin{coq_example} Section Predicate_calculus. @@ -686,24 +649,25 @@ a theory, but rather local hypotheses to a theorem, we open a specific section to this effect. \begin{coq_example} Section R_sym_trans. -Hypothesis R_symmetric : forall x y:D, R x y -> R y x. -Hypothesis R_transitive : forall x y z:D, R x y -> R y z -> R x z. +Hypothesis R_symmetric : forall x y : D, R x y -> R y x. +Hypothesis R_transitive : + forall x y z : D, R x y -> R y z -> R x z. \end{coq_example} -Remark the syntax \verb+forall x:D,+ which stands for universal quantification +Note the syntax \verb+forall x : D,+ which stands for universal quantification $\forall x : D$. \subsection{Existential quantification} We now state our lemma, and enter proof mode. \begin{coq_example} -Lemma refl_if : forall x:D, (exists y, R x y) -> R x x. +Lemma refl_if : forall x : D, (exists y, R x y) -> R x x. \end{coq_example} -Remark that the hypotheses which are local to the currently opened sections +The hypotheses that are local to the currently opened sections are listed as local hypotheses to the current goals. -The rationale is that these hypotheses are going to be discharged, as we -shall see, when we shall close the corresponding sections. +That is because these hypotheses are going to be discharged, as +we shall see, when we shall close the corresponding sections. Note the functional syntax for existential quantification. The existential quantifier is built from the operator \verb:ex:, which expects a @@ -711,19 +675,19 @@ predicate as argument: \begin{coq_example} Check ex. \end{coq_example} -and the notation \verb+(exists x:D, P x)+ is just concrete syntax for -the expression \verb+(ex D (fun x:D => P x))+. +and the notation \verb+(exists x : D, P x)+ is just concrete syntax for +the expression \verb+(ex D (fun x : D => P x))+. Existential quantification is handled in \Coq{} in a similar -fashion to the connectives \verb:/\: and \verb:\/: : it is introduced by +fashion to the connectives \verb:/\: and \verb:\/:: it is introduced by the proof combinator \verb:ex_intro:, which is invoked by the specific -tactic \verb:Exists:, and its elimination provides a witness \verb+a:D+ to -\verb:P:, together with an assumption \verb+h:(P a)+ that indeed \verb+a+ +tactic \verb:exists:, and its elimination provides a witness \verb+a : D+ to +\verb:P:, together with an assumption \verb+h : (P a)+ that indeed \verb+a+ verifies \verb:P:. Let us see how this works on this simple example. \begin{coq_example} intros x x_Rlinked. \end{coq_example} -Remark that \verb:intros: treats universal quantification in the same way +Note that \verb:intros: treats universal quantification in the same way as the premises of implications. Renaming of bound variables occurs when it is needed; for instance, had we started with \verb:intro y:, we would have obtained the goal: @@ -773,8 +737,8 @@ End R_sym_trans. All the local hypotheses have been discharged in the statement of \verb:refl_if:, which now becomes a general theorem in the first-order language declared in section -\verb:Predicate_calculus:. In this particular example, the use of section -\verb:R_sym_trans: has not been really significant, since we could have +\verb:Predicate_calculus:. In this particular example, section +\verb:R_sym_trans: has not been really useful, since we could have instead stated theorem \verb:refl_if: in its general form, and done basically the same proof, obtaining \verb:R_symmetric: and \verb:R_transitive: as local hypotheses by initial \verb:intros: rather @@ -802,7 +766,7 @@ Lemma weird : (forall x:D, P x) -> exists a, P a. \end{coq_example} First of all, notice the pair of parentheses around -\verb+forall x:D, P x+ in +\verb+forall x : D, P x+ in the statement of lemma \verb:weird:. If we had omitted them, \Coq's parser would have interpreted the statement as a truly trivial fact, since we would @@ -820,7 +784,7 @@ systematically inhabited, lemma \verb:weird: only holds in signatures which allow the explicit construction of an element in the domain of the predicate. -Let us conclude the proof, in order to show the use of the \verb:Exists: +Let us conclude the proof, in order to show the use of the \verb:exists: tactic: \begin{coq_example} exists d; trivial. @@ -836,8 +800,8 @@ We shall need classical reasoning. Instead of loading the \verb:Classical: module as we did above, we just state the law of excluded middle as a local hypothesis schema at this point: \begin{coq_example} -Hypothesis EM : forall A:Prop, A \/ ~ A. -Lemma drinker : exists x:D, P x -> forall x:D, P x. +Hypothesis EM : forall A : Prop, A \/ ~ A. +Lemma drinker : exists x : D, P x -> forall x : D, P x. \end{coq_example} The proof goes by cases on whether or not there is someone who does not drink. Such reasoning by cases proceeds @@ -847,10 +811,11 @@ proper instance of \verb:EM:: elim (EM (exists x, ~ P x)). \end{coq_example} -We first look at the first case. Let Tom be the non-drinker: +We first look at the first case. Let Tom be the non-drinker. +The following combines at once the effect of \verb:intros: and +\verb:destruct:: \begin{coq_example} -intro Non_drinker; elim Non_drinker; - intros Tom Tom_does_not_drink. +intros (Tom, Tom_does_not_drink). \end{coq_example} We conclude in that case by considering Tom, since his drinking leads to @@ -860,9 +825,10 @@ exists Tom; intro Tom_drinks. \end{coq_example} There are several ways in which we may eliminate a contradictory case; -a simple one is to use the \verb:absurd: tactic as follows: +in this case, we use \verb:contradiction: to let \Coq{} find out the +two contradictory hypotheses: \begin{coq_example} -absurd (P Tom); trivial. +contradiction. \end{coq_example} We now proceed with the second case, in which actually any person will do; @@ -893,7 +859,7 @@ Check weird. Check drinker. \end{coq_example} -Remark how the three theorems are completely generic in the most general +Note how the three theorems are completely generic in the most general fashion; the domain \verb:D: is discharged in all of them, \verb:R: is discharged in \verb:refl_if: only, \verb:P: is discharged only in \verb:weird: and @@ -901,12 +867,13 @@ the domain \verb:D: is discharged in all of them, \verb:R: is discharged in Finally, the excluded middle hypothesis is discharged only in \verb:drinker:. -Note that the name \verb:d: has vanished as well from +Note, too, that the name \verb:d: has vanished from the statements of \verb:weird: and \verb:drinker:, since \Coq's pretty-printer replaces -systematically a quantification such as \verb+forall d:D, E+, where \verb:d: -does not occur in \verb:E:, by the functional notation \verb:D->E:. -Similarly the name \verb:EM: does not appear in \verb:drinker:. +systematically a quantification such as \texttt{forall d : D, E}, +where \texttt{d} does not occur in \texttt{E}, +by the functional notation \texttt{D -> E}. +Similarly the name \texttt{EM} does not appear in \texttt{drinker}. Actually, universal quantification, implication, as well as function formation, are @@ -935,12 +902,12 @@ intros. generalize H0. \end{coq_example} -Sometimes it may be convenient to use a lemma, although we do not have -a direct way to appeal to such an already proven fact. The tactic \verb:cut: -permits to use the lemma at this point, keeping the corresponding proof -obligation as a new subgoal: +Sometimes it may be convenient to state an intermediate fact. +The tactic \verb:assert: does this and introduces a new subgoal +for this fact to be proved first. The tactic \verb:enough: does +the same while keeping this goal for later. \begin{coq_example} -cut (R x x); trivial. +enough (R x x) by auto. \end{coq_example} We clean the goal by doing an \verb:Abort: command. \begin{coq_example*} @@ -951,10 +918,10 @@ Abort. \subsection{Equality} The basic equality provided in \Coq{} is Leibniz equality, noted infix like -\verb+x=y+, when \verb:x: and \verb:y: are two expressions of -type the same Set. The replacement of \verb:x: by \verb:y: in any -term is effected by a variety of tactics, such as \verb:rewrite: -and \verb:replace:. +\texttt{x = y}, when \texttt{x} and \texttt{y} are two expressions of +type the same Set. The replacement of \texttt{x} by \texttt{y} in any +term is effected by a variety of tactics, such as \texttt{rewrite} +and \texttt{replace}. Let us give a few examples of equality replacement. Let us assume that some arithmetic function \verb:f: is null in zero: @@ -1009,10 +976,14 @@ In case the equality $t=u$ generated by \verb:replace: $u$ \verb:with: $t$ is an assumption (possibly modulo symmetry), it will be automatically proved and the corresponding goal will not appear. For instance: -\begin{coq_example} + +\begin{coq_eval} Restart. -replace (f 0) with 0. -rewrite f10; rewrite foo; trivial. +\end{coq_eval} +\begin{coq_example} +Lemma L2 : f (f 1) = 0. +replace (f 1) with (f 0). +replace (f 0) with 0; trivial. Qed. \end{coq_example} @@ -1033,20 +1004,20 @@ predicates over some universe \verb:U:. For instance: \begin{coq_example} Variable U : Type. Definition set := U -> Prop. -Definition element (x:U) (S:set) := S x. -Definition subset (A B:set) := - forall x:U, element x A -> element x B. +Definition element (x : U) (S : set) := S x. +Definition subset (A B : set) := + forall x : U, element x A -> element x B. \end{coq_example} Now, assume that we have loaded a module of general properties about relations over some abstract type \verb:T:, such as transitivity: \begin{coq_example} -Definition transitive (T:Type) (R:T -> T -> Prop) := - forall x y z:T, R x y -> R y z -> R x z. +Definition transitive (T : Type) (R : T -> T -> Prop) := + forall x y z : T, R x y -> R y z -> R x z. \end{coq_example} -Now, assume that we want to prove that \verb:subset: is a \verb:transitive: +We want to prove that \verb:subset: is a \verb:transitive: relation. \begin{coq_example} Lemma subset_transitive : transitive set subset. @@ -1071,9 +1042,12 @@ auto. \end{coq_example} Many variations on \verb:unfold: are provided in \Coq. For instance, -we may selectively unfold one designated occurrence: -\begin{coq_example} +instead of unfolding all occurrences of \verb:subset:, we may want to +unfold only one designated occurrence: +\begin{coq_eval} Undo 2. +\end{coq_eval} +\begin{coq_example} unfold subset at 2. \end{coq_example} @@ -1111,6 +1085,7 @@ are {\sl transparent}. \begin{coq_eval} Reset Initial. Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} \section{Data Types as Inductively Defined Mathematical Collections} @@ -1166,11 +1141,14 @@ right; trivial. \end{coq_example} Indeed, the whole proof can be done with the combination of the - \verb:simple: \verb:induction:, which combines \verb:intro: and \verb:elim:, + \verb:destruct:, which combines \verb:intro: and \verb:elim:, with good old \verb:auto:: +\begin{coq_eval} +Abort. +\end{coq_eval} \begin{coq_example} -Restart. -simple induction b; auto. +Lemma duality : forall b:bool, b = true \/ b = false. +destruct b; auto. Qed. \end{coq_example} @@ -1194,7 +1172,7 @@ Check nat_rec. Let us start by showing how to program the standard primitive recursion operator \verb:prim_rec: from the more general \verb:nat_rec:: \begin{coq_example} -Definition prim_rec := nat_rec (fun i:nat => nat). +Definition prim_rec := nat_rec (fun i : nat => nat). \end{coq_example} That is, instead of computing for natural \verb:i: an element of the indexed @@ -1205,22 +1183,27 @@ About prim_rec. \end{coq_example} Oops! Instead of the expected type \verb+nat->(nat->nat->nat)->nat->nat+ we -get an apparently more complicated expression. Indeed the type of -\verb:prim_rec: is equivalent by rule $\beta$ to its expected type; this may -be checked in \Coq{} by command \verb:Eval Cbv Beta:, which $\beta$-reduces -an expression to its {\sl normal form}: +get an apparently more complicated expression. +In fact, the two types are convertible and one way of having the proper +type would be to do some computation before actually defining \verb:prim_rec: +as such: + +\begin{coq_eval} +Reset Initial. +Set Printing Width 60. +Set Printing Compact Contexts. +\end{coq_eval} + \begin{coq_example} -Eval cbv beta in - ((fun _:nat => nat) O -> - (forall y:nat, - (fun _:nat => nat) y -> (fun _:nat => nat) (S y)) -> - forall n:nat, (fun _:nat => nat) n). +Definition prim_rec := + Eval compute in nat_rec (fun i : nat => nat). +About prim_rec. \end{coq_example} Let us now show how to program addition with primitive recursion: \begin{coq_example} Definition addition (n m:nat) := - prim_rec m (fun p rec:nat => S rec) n. + prim_rec m (fun p rec : nat => S rec) n. \end{coq_example} That is, we specify that \verb+(addition n m)+ computes by cases on \verb:n: @@ -1244,15 +1227,11 @@ Fixpoint plus (n m:nat) {struct n} : nat := end. \end{coq_example} -For the rest of the session, we shall clean up what we did so far with -types \verb:bool: and \verb:nat:, in order to use the initial definitions -given in \Coq's \verb:Prelude: module, and not to get confusing error -messages due to our redefinitions. We thus revert to the initial state: +\begin{coq_eval} \begin{coq_example} Reset Initial. -\end{coq_example} -\begin{coq_eval} Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} \subsection{Simple proofs by induction} @@ -1261,20 +1240,21 @@ Let us now show how to do proofs by structural induction. We start with easy properties of the \verb:plus: function we just defined. Let us first show that $n=n+0$. \begin{coq_example} -Lemma plus_n_O : forall n:nat, n = n + 0. +Lemma plus_n_O : forall n : nat, n = n + 0. intro n; elim n. \end{coq_example} -What happened was that \verb:elim n:, in order to construct a \verb:Prop: -(the initial goal) from a \verb:nat: (i.e. \verb:n:), appealed to the -corresponding induction principle \verb:nat_ind: which we saw was indeed +What happened was that \texttt{elim n}, in order to construct a \texttt{Prop} +(the initial goal) from a \texttt{nat} (i.e. \texttt{n}), appealed to the +corresponding induction principle \texttt{nat\_ind} which we saw was indeed exactly Peano's induction scheme. Pattern-matching instantiated the -corresponding predicate \verb:P: to \verb+fun n:nat => n = n + 0+, and we get -as subgoals the corresponding instantiations of the base case \verb:(P O): , -and of the inductive step \verb+forall y:nat, P y -> P (S y)+. -In each case we get an instance of function \verb:plus: in which its second +corresponding predicate \texttt{P} to \texttt{fun n : nat => n = n + 0}, +and we get as subgoals the corresponding instantiations of the base case +\texttt{(P O)}, and of the inductive step +\texttt{forall y : nat, P y -> P (S y)}. +In each case we get an instance of function \texttt{plus} in which its second argument starts with a constructor, and is thus amenable to simplification -by primitive recursion. The \Coq{} tactic \verb:simpl: can be used for +by primitive recursion. The \Coq{} tactic \texttt{simpl} can be used for this purpose: \begin{coq_example} simpl. @@ -1305,12 +1285,12 @@ We now proceed to the similar property concerning the other constructor Lemma plus_n_S : forall n m:nat, S (n + m) = n + S m. \end{coq_example} -We now go faster, remembering that tactic \verb:simple induction: does the +We now go faster, using the tactic \verb:induction:, which does the necessary \verb:intros: before applying \verb:elim:. Factoring simplification and automation in both cases thanks to tactic composition, we prove this lemma in one line: \begin{coq_example} -simple induction n; simpl; auto. +induction n; simpl; auto. Qed. Hint Resolve plus_n_S . \end{coq_example} @@ -1324,7 +1304,7 @@ Lemma plus_com : forall n m:nat, n + m = m + n. Here we have a choice on doing an induction on \verb:n: or on \verb:m:, the situation being symmetric. For instance: \begin{coq_example} -simple induction m; simpl; auto. +induction m as [ | m IHm ]; simpl; auto. \end{coq_example} Here \verb:auto: succeeded on the base case, thanks to our hint @@ -1332,7 +1312,7 @@ Here \verb:auto: succeeded on the base case, thanks to our hint \verb:auto: does not handle: \begin{coq_example} -intros m' E; rewrite <- E; auto. +rewrite <- IHm; auto. Qed. \end{coq_example} @@ -1344,13 +1324,13 @@ the constructors \verb:O: and \verb:S:: it computes to \verb:False: when its argument is \verb:O:, and to \verb:True: when its argument is of the form \verb:(S n):: \begin{coq_example} -Definition Is_S (n:nat) := match n with - | O => False - | S p => True - end. +Definition Is_S (n : nat) := match n with + | O => False + | S p => True + end. \end{coq_example} -Now we may use the computational power of \verb:Is_S: in order to prove +Now we may use the computational power of \verb:Is_S: to prove trivially that \verb:(Is_S (S n)):: \begin{coq_example} Lemma S_Is_S : forall n:nat, Is_S (S n). @@ -1389,8 +1369,11 @@ Actually, a specific tactic \verb:discriminate: is provided to produce mechanically such proofs, without the need for the user to define explicitly the relevant discrimination predicates: +\begin{coq_eval} +Abort. +\end{coq_eval} \begin{coq_example} -Restart. +Lemma no_confusion : forall n:nat, 0 <> S n. intro n; discriminate. Qed. \end{coq_example} @@ -1403,12 +1386,13 @@ may define inductive families, and for instance inductive predicates. Here is the definition of predicate $\le$ over type \verb:nat:, as given in \Coq's \verb:Prelude: module: \begin{coq_example*} -Inductive le (n:nat) : nat -> Prop := +Inductive le (n : nat) : nat -> Prop := | le_n : le n n - | le_S : forall m:nat, le n m -> le n (S m). + | le_S : forall m : nat, le n m -> le n (S m). \end{coq_example*} -This definition introduces a new predicate \verb+le:nat->nat->Prop+, +This definition introduces a new predicate +\verb+le : nat -> nat -> Prop+, and the two constructors \verb:le_n: and \verb:le_S:, which are the defining clauses of \verb:le:. That is, we get not only the ``axioms'' \verb:le_n: and \verb:le_S:, but also the converse property, that @@ -1426,7 +1410,7 @@ Check le_ind. Let us show how proofs may be conducted with this principle. First we show that $n\le m \Rightarrow n+1\le m+1$: \begin{coq_example} -Lemma le_n_S : forall n m:nat, le n m -> le (S n) (S m). +Lemma le_n_S : forall n m : nat, le n m -> le (S n) (S m). intros n m n_le_m. elim n_le_m. \end{coq_example} @@ -1442,10 +1426,14 @@ intros; apply le_S; trivial. Now we know that it is a good idea to give the defining clauses as hints, so that the proof may proceed with a simple combination of -\verb:induction: and \verb:auto:. +\verb:induction: and \verb:auto:. \verb:Hint Constructors le: +is just an abbreviation for \verb:Hint Resolve le_n le_S:. +\begin{coq_eval} +Abort. +\end{coq_eval} \begin{coq_example} -Restart. -Hint Resolve le_n le_S . +Hint Constructors le. +Lemma le_n_S : forall n m : nat, le n m -> le (S n) (S m). \end{coq_example} We have a slight problem however. We want to say ``Do an induction on @@ -1453,7 +1441,7 @@ hypothesis \verb:(le n m):'', but we have no explicit name for it. What we do in this case is to say ``Do an induction on the first unnamed hypothesis'', as follows. \begin{coq_example} -simple induction 1; auto. +induction 1; auto. Qed. \end{coq_example} @@ -1483,6 +1471,7 @@ Qed. \begin{coq_eval} Reset Initial. Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} \section{Opening library modules} @@ -1552,6 +1541,7 @@ known lemmas about both the successor and the less or equal relation, just ask: \begin{coq_eval} Reset Initial. Set Printing Width 60. +Set Printing Compact Contexts. \end{coq_eval} \begin{coq_example} Search S le. @@ -1562,14 +1552,13 @@ predicate appears at the head position in the conclusion. SearchHead le. \end{coq_example} -A new and more convenient search tool is \verb:SearchPattern: -developed by Yves Bertot. It allows finding the theorems with a -conclusion matching a given pattern, where \verb:_: can be used in -place of an arbitrary term. We remark in this example, that \Coq{} +The \verb:Search: commands also allows finding the theorems +containing a given pattern, where \verb:_: can be used in +place of an arbitrary term. As shown in this example, \Coq{} provides usual infix notations for arithmetic operators. \begin{coq_example} -SearchPattern (_ + _ = _). +Search (_ + _ = _). \end{coq_example} \section{Now you are on your own} diff --git a/engine/eConstr.ml b/engine/eConstr.ml index 078f2fc333..7b879a8031 100644 --- a/engine/eConstr.ml +++ b/engine/eConstr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/eConstr.mli b/engine/eConstr.mli index 07a4dc8e23..4dbf6c18a3 100644 --- a/engine/eConstr.mli +++ b/engine/eConstr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/evarutil.ml b/engine/evarutil.ml index e8d184632e..2afc12cd36 100644 --- a/engine/evarutil.ml +++ b/engine/evarutil.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/evarutil.mli b/engine/evarutil.mli index 90c5c3dc0d..a8b6b5861c 100644 --- a/engine/evarutil.mli +++ b/engine/evarutil.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/evd.ml b/engine/evd.ml index bf1e052b63..cfc9aa6351 100644 --- a/engine/evd.ml +++ b/engine/evd.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -780,8 +780,9 @@ let new_sort_variable ?loc ?name rigid d = let add_global_univ d u = { d with universes = UState.add_global_univ d.universes u } -let make_flexible_variable evd b u = - { evd with universes = UState.make_flexible_variable evd.universes b u } +let make_flexible_variable evd ~algebraic u = + { evd with universes = + UState.make_flexible_variable evd.universes ~algebraic u } let make_evar_universe_context e l = let uctx = UState.make (Environ.universes e) in diff --git a/engine/evd.mli b/engine/evd.mli index 86755c360b..3f00a3b0b2 100644 --- a/engine/evd.mli +++ b/engine/evd.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -522,7 +522,9 @@ val new_sort_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_ val add_global_univ : evar_map -> Univ.Level.t -> evar_map val universe_rigidity : evar_map -> Univ.Level.t -> rigid -val make_flexible_variable : evar_map -> bool -> Univ.universe_level -> evar_map +val make_flexible_variable : evar_map -> algebraic:bool -> Univ.universe_level -> evar_map +(** See [UState.make_flexible_variable] *) + val is_sort_variable : evar_map -> sorts -> Univ.universe_level option (** [is_sort_variable evm s] returns [Some u] or [None] if [s] is not a local sort variable declared in [evm] *) diff --git a/engine/ftactic.ml b/engine/ftactic.ml index 68368e38fa..8e4c5f2206 100644 --- a/engine/ftactic.ml +++ b/engine/ftactic.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/ftactic.mli b/engine/ftactic.mli index 97bebe9da8..c108c0c2ea 100644 --- a/engine/ftactic.mli +++ b/engine/ftactic.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/geninterp.ml b/engine/geninterp.ml index cfca95d3e6..e79e258fbc 100644 --- a/engine/geninterp.ml +++ b/engine/geninterp.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -32,7 +32,7 @@ struct let repr = ValT.repr let create = ValT.create - let pr : type a. a typ -> Pp.std_ppcmds = fun t -> Pp.str (repr t) + let pr : type a. a typ -> Pp.t = fun t -> Pp.str (repr t) let typ_list = ValT.create "list" let typ_opt = ValT.create "option" diff --git a/engine/geninterp.mli b/engine/geninterp.mli index b70671a2d9..492e372adb 100644 --- a/engine/geninterp.mli +++ b/engine/geninterp.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -30,7 +30,7 @@ sig val eq : 'a typ -> 'b typ -> ('a, 'b) CSig.eq option val repr : 'a typ -> string - val pr : 'a typ -> Pp.std_ppcmds + val pr : 'a typ -> Pp.t val typ_list : t list typ val typ_opt : t option typ diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml index 6e821ea5aa..bf1b3e0e86 100644 --- a/engine/logic_monad.ml +++ b/engine/logic_monad.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli index dd122cca0f..8c8f9fe935 100644 --- a/engine/logic_monad.mli +++ b/engine/logic_monad.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,11 +57,11 @@ module NonLogical : sig val print_char : char -> unit t (** Loggers. The buffer is also flushed. *) - val print_debug : Pp.std_ppcmds -> unit t - val print_warning : Pp.std_ppcmds -> unit t - val print_notice : Pp.std_ppcmds -> unit t - val print_info : Pp.std_ppcmds -> unit t - val print_error : Pp.std_ppcmds -> unit t + val print_debug : Pp.t -> unit t + val print_warning : Pp.t -> unit t + val print_notice : Pp.t -> unit t + val print_info : Pp.t -> unit t + val print_error : Pp.t -> unit t (** [Pervasives.raise]. Except that exceptions are wrapped with {!Exception}. *) diff --git a/engine/namegen.ml b/engine/namegen.ml index 783085654e..a75fe721f7 100644 --- a/engine/namegen.ml +++ b/engine/namegen.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/namegen.mli b/engine/namegen.mli index 058b1c228b..14846a9184 100644 --- a/engine/namegen.mli +++ b/engine/namegen.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/engine/proofview.ml b/engine/proofview.ml index 39ef65dab1..eef2b83f44 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -332,7 +332,7 @@ exception NoSuchGoals of int (* This hook returns a string to be appended to the usual message. Primarily used to add a suggestion about the right bullet to use to focus the next goal, if applicable. *) -let nosuchgoals_hook:(int -> std_ppcmds) ref = ref (fun n -> mt ()) +let nosuchgoals_hook:(int -> Pp.t) ref = ref (fun n -> mt ()) let set_nosuchgoals_hook f = nosuchgoals_hook := f @@ -1072,13 +1072,6 @@ module Goal = struct end end - exception NotExactlyOneSubgoal - let _ = CErrors.register_handler begin function - | NotExactlyOneSubgoal -> - CErrors.user_err (Pp.str"Not exactly one subgoal.") - | _ -> raise CErrors.Unhandled - end - let enter_one f = let open Proof in Comb.get >>= function @@ -1090,7 +1083,7 @@ module Goal = struct let (e, info) = CErrors.push e in tclZERO ~info e end - | _ -> tclZERO NotExactlyOneSubgoal + | _ -> assert false (* unsatisfied not-exactly-one-goal precondition *) let goals = Pv.get >>= fun step -> diff --git a/engine/proofview.mli b/engine/proofview.mli index aae25b6f8f..d92d0a7d53 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -25,7 +25,7 @@ type proofview new nearly identical function everytime. Hence the generic name. *) (* In this version: returns the list of focused goals together with the [evar_map] context. *) -val proofview : proofview -> Goal.goal list * Evd.evar_map +val proofview : proofview -> Evd.evar list * Evd.evar_map (** {6 Starting and querying a proof view} *) @@ -88,7 +88,7 @@ type focus_context new nearly identical function everytime. Hence the generic name. *) (* In this version: the goals in the context, as a "zipper" (the first list is in reversed order). *) -val focus_context : focus_context -> Goal.goal list * Goal.goal list +val focus_context : focus_context -> Evd.evar list * Evd.evar list (** [focus i j] focuses a proofview on the goals from index [i] to index [j] (inclusive, goals are indexed from [1]). I.e. goals @@ -148,7 +148,7 @@ type +'a tactic {!Logic_monad.TacticFailure}*) val apply : Environ.env -> 'a tactic -> proofview -> 'a * proofview - * (bool*Goal.goal list*Goal.goal list) + * (bool*Evd.evar list*Evd.evar list) * Proofview_monad.Info.tree (** {7 Monadic primitives} *) @@ -235,7 +235,7 @@ val tclBREAK : (iexn -> iexn option) -> 'a tactic -> 'a tactic This hook is used to add a suggestion about bullets when applicable. *) exception NoSuchGoals of int -val set_nosuchgoals_hook: (int -> Pp.std_ppcmds) -> unit +val set_nosuchgoals_hook: (int -> Pp.t) -> unit val tclFOCUS : int -> int -> 'a tactic -> 'a tactic @@ -304,12 +304,12 @@ val shelve : unit tactic (** Shelves the given list of goals, which might include some that are under focus and some that aren't. All the goals are placed on the shelf for later use (or being solved by side-effects). *) -val shelve_goals : Goal.goal list -> unit tactic +val shelve_goals : Evd.evar list -> unit tactic (** [unifiable sigma g l] checks whether [g] appears in another subgoal of [l]. The list [l] may contain [g], but it does not affect the result. Used by [shelve_unifiable]. *) -val unifiable : Evd.evar_map -> Goal.goal -> Goal.goal list -> bool +val unifiable : Evd.evar_map -> Evd.evar -> Evd.evar list -> bool (** Shelves the unifiable goals under focus, i.e. the goals which appear in other goals under focus (the unfocused goals are not @@ -322,15 +322,15 @@ val guard_no_unifiable : Names.Name.t list option tactic (** [unshelve l p] adds all the goals in [l] at the end of the focused goals of p *) -val unshelve : Goal.goal list -> proofview -> proofview +val unshelve : Evd.evar list -> proofview -> proofview (** [depends_on g1 g2 sigma] checks if g1 occurs in the type/ctx of g2 *) -val depends_on : Evd.evar_map -> Goal.goal -> Goal.goal -> bool +val depends_on : Evd.evar_map -> Evd.evar -> Evd.evar -> bool (** [with_shelf tac] executes [tac] and returns its result together with the set of goals shelved by [tac]. The current shelf is unchanged and the returned list contains only unsolved goals. *) -val with_shelf : 'a tactic -> (Goal.goal list * 'a) tactic +val with_shelf : 'a tactic -> (Evd.evar list * 'a) tactic (** If [n] is positive, [cycle n] puts the [n] first goal last. If [n] is negative, then it puts the [n] last goals first.*) @@ -416,14 +416,14 @@ module Unsafe : sig (** [tclNEWGOALS gls] adds the goals [gls] to the ones currently being proved, appending them to the list of focused goals. If a goal is already solved, it is not added. *) - val tclNEWGOALS : Goal.goal list -> unit tactic + val tclNEWGOALS : Evd.evar list -> unit tactic (** [tclSETGOALS gls] sets goals [gls] as the goals being under focus. If a goal is already solved, it is not set. *) - val tclSETGOALS : Goal.goal list -> unit tactic + val tclSETGOALS : Evd.evar list -> unit tactic (** [tclGETGOALS] returns the list of goals under focus. *) - val tclGETGOALS : Goal.goal list tactic + val tclGETGOALS : Evd.evar list tactic (** Sets the evar universe context. *) val tclEVARUNIVCONTEXT : Evd.evar_universe_context -> unit tactic @@ -498,7 +498,7 @@ module Goal : sig val enter : ([ `LZ ] t -> unit tactic) -> unit tactic (** Like {!enter}, but assumes exactly one goal under focus, raising *) - (** an error otherwise. *) + (** a fatal error otherwise. *) val enter_one : ([ `LZ ] t -> 'a tactic) -> 'a tactic (** Recover the list of current goals under focus, without evar-normalization. @@ -526,7 +526,7 @@ module Trace : sig val log : Proofview_monad.lazy_msg -> unit tactic val name_tactic : Proofview_monad.lazy_msg -> 'a tactic -> 'a tactic - val pr_info : ?lvl:int -> Proofview_monad.Info.tree -> Pp.std_ppcmds + val pr_info : ?lvl:int -> Proofview_monad.Info.tree -> Pp.t end diff --git a/engine/proofview_monad.ml b/engine/proofview_monad.ml index 6f52b3ee90..d0f4712258 100644 --- a/engine/proofview_monad.ml +++ b/engine/proofview_monad.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -62,7 +62,7 @@ end (** We typically label nodes of [Trace.tree] with messages to print. But we don't want to compute the result. *) -type lazy_msg = unit -> Pp.std_ppcmds +type lazy_msg = unit -> Pp.t let pr_lazy_msg msg = msg () (** Info trace. *) diff --git a/engine/proofview_monad.mli b/engine/proofview_monad.mli index 637414cce7..e7123218b1 100644 --- a/engine/proofview_monad.mli +++ b/engine/proofview_monad.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,7 +43,7 @@ end (** We typically label nodes of [Trace.tree] with messages to print. But we don't want to compute the result. *) -type lazy_msg = unit -> Pp.std_ppcmds +type lazy_msg = unit -> Pp.t (** Info trace. *) module Info : sig @@ -58,7 +58,7 @@ module Info : sig type state = tag Trace.incr type tree = tag Trace.forest - val print : tree -> Pp.std_ppcmds + val print : tree -> Pp.t (** [collapse n t] flattens the first [n] levels of [Tactic] in an info trace, effectively forgetting about the [n] top level of diff --git a/engine/termops.ml b/engine/termops.ml index 3eef71b2d0..2bd0c06d6d 100644 --- a/engine/termops.ml +++ b/engine/termops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -906,7 +906,7 @@ let collect_vars sigma c = aux Id.Set.empty c let vars_of_global_reference env gr = - let c, _ = Universes.unsafe_constr_of_global gr in + let c, _ = Global.constr_of_global_in_context env gr in vars_of_global (Global.env ()) c (* Tests whether [m] is a subterm of [t]: @@ -994,12 +994,14 @@ let rec strip_outer_cast sigma c = match EConstr.kind sigma c with (* flattens application lists throwing casts in-between *) let collapse_appl sigma c = match EConstr.kind sigma c with | App (f,cl) -> + if EConstr.isCast sigma f then let rec collapse_rec f cl2 = match EConstr.kind sigma (strip_outer_cast sigma f) with | App (g,cl1) -> collapse_rec g (Array.append cl1 cl2) | _ -> EConstr.mkApp (f,cl2) in collapse_rec f cl + else c | _ -> c (* First utilities for avoiding telescope computation for subst_term *) @@ -1145,9 +1147,6 @@ let is_template_polymorphic env sigma f = | Ind (ind, u) -> if not (EConstr.EInstance.is_empty u) then false else Environ.template_polymorphic_ind ind env - | Const (cst, u) -> - if not (EConstr.EInstance.is_empty u) then false - else Environ.template_polymorphic_constant cst env | _ -> false let base_sort_cmp pb s0 s1 = diff --git a/engine/termops.mli b/engine/termops.mli index 58837ba033..2624afd30d 100644 --- a/engine/termops.mli +++ b/engine/termops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,16 +9,15 @@ (** This file defines various utilities for term manipulation that are not needed in the kernel. *) -open Pp open Names open Term open Environ open EConstr (** printers *) -val print_sort : sorts -> std_ppcmds -val pr_sort_family : sorts_family -> std_ppcmds -val pr_fix : ('a -> std_ppcmds) -> ('a, 'a) pfixpoint -> std_ppcmds +val print_sort : sorts -> Pp.t +val pr_sort_family : sorts_family -> Pp.t +val pr_fix : ('a -> Pp.t) -> ('a, 'a) pfixpoint -> Pp.t (** about contexts *) val push_rel_assum : Name.t * types -> env -> env @@ -279,25 +278,25 @@ val on_judgment_type : ('t -> 't) -> ('c, 't) punsafe_judgment -> ('c, 't) puns open Evd -val pr_existential_key : evar_map -> evar -> Pp.std_ppcmds +val pr_existential_key : evar_map -> evar -> Pp.t val pr_evar_suggested_name : existential_key -> evar_map -> Id.t -val pr_evar_info : evar_info -> Pp.std_ppcmds -val pr_evar_constraints : evar_map -> evar_constraint list -> Pp.std_ppcmds -val pr_evar_map : ?with_univs:bool -> int option -> evar_map -> Pp.std_ppcmds +val pr_evar_info : evar_info -> Pp.t +val pr_evar_constraints : evar_map -> evar_constraint list -> Pp.t +val pr_evar_map : ?with_univs:bool -> int option -> evar_map -> Pp.t val pr_evar_map_filter : ?with_univs:bool -> (Evar.t -> evar_info -> bool) -> - evar_map -> Pp.std_ppcmds -val pr_metaset : Metaset.t -> Pp.std_ppcmds -val pr_evar_universe_context : evar_universe_context -> Pp.std_ppcmds -val pr_evd_level : evar_map -> Univ.Level.t -> Pp.std_ppcmds + evar_map -> Pp.t +val pr_metaset : Metaset.t -> Pp.t +val pr_evar_universe_context : evar_universe_context -> Pp.t +val pr_evd_level : evar_map -> Univ.Level.t -> Pp.t (** debug printer: do not use to display terms to the casual user... *) -val set_print_constr : (env -> Evd.evar_map -> constr -> std_ppcmds) -> unit -val print_constr : constr -> std_ppcmds -val print_constr_env : env -> Evd.evar_map -> constr -> std_ppcmds -val print_named_context : env -> std_ppcmds -val pr_rel_decl : env -> Context.Rel.Declaration.t -> std_ppcmds -val print_rel_context : env -> std_ppcmds -val print_env : env -> std_ppcmds +val set_print_constr : (env -> Evd.evar_map -> constr -> Pp.t) -> unit +val print_constr : constr -> Pp.t +val print_constr_env : env -> Evd.evar_map -> constr -> Pp.t +val print_named_context : env -> Pp.t +val pr_rel_decl : env -> Context.Rel.Declaration.t -> Pp.t +val print_rel_context : env -> Pp.t +val print_env : env -> Pp.t diff --git a/engine/uState.ml b/engine/uState.ml index 0973ca457f..63bd247d56 100644 --- a/engine/uState.ml +++ b/engine/uState.ml @@ -384,16 +384,21 @@ let add_global_univ uctx u = uctx_initial_universes = initial; uctx_universes = univs } -let make_flexible_variable ctx b u = - let {uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in +let make_flexible_variable ctx ~algebraic u = + let {uctx_local = cstrs; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} = ctx in let uvars' = Univ.LMap.add u None uvars in let avars' = - if b then + if algebraic then let uu = Univ.Universe.make u in let substu_not_alg u' v = Option.cata (fun vu -> Univ.Universe.equal uu vu && not (Univ.LSet.mem u' avars)) false v in - if not (Univ.LMap.exists substu_not_alg uvars) + let has_upper_constraint () = + Univ.Constraint.exists + (fun (l,d,r) -> d == Univ.Lt && Univ.Level.equal l u) + (Univ.ContextSet.constraints cstrs) + in + if not (Univ.LMap.exists substu_not_alg uvars || has_upper_constraint ()) then Univ.LSet.add u avars else avars else avars in diff --git a/engine/uState.mli b/engine/uState.mli index 0cdc6277a5..d198fbfbe9 100644 --- a/engine/uState.mli +++ b/engine/uState.mli @@ -92,7 +92,14 @@ val emit_side_effects : Safe_typing.private_constants -> t -> t val new_univ_variable : ?loc:Loc.t -> rigid -> string option -> t -> t * Univ.Level.t val add_global_univ : t -> Univ.Level.t -> t -val make_flexible_variable : t -> bool -> Univ.Level.t -> t + +(** [make_flexible_variable g algebraic l] + + Turn the variable [l] flexible, and algebraic if [algebraic] is true + and [l] can be. That is if there are no strict upper constraints on + [l] and and it does not appear in the instance of any non-algebraic + universe. Otherwise the variable is just made flexible. *) +val make_flexible_variable : t -> algebraic:bool -> Univ.Level.t -> t val is_sort_variable : t -> Sorts.t -> Univ.Level.t option @@ -116,4 +123,4 @@ val update_sigma_env : t -> Environ.env -> t (** {5 Pretty-printing} *) -val pr_uctx_level : t -> Univ.Level.t -> Pp.std_ppcmds +val pr_uctx_level : t -> Univ.Level.t -> Pp.t diff --git a/engine/universes.ml b/engine/universes.ml index bd4d75930c..719af43edf 100644 --- a/engine/universes.ml +++ b/engine/universes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -282,28 +282,27 @@ let new_Type dp = mkType (new_univ dp) let new_Type_sort dp = Type (new_univ dp) let fresh_universe_instance ctx = - Instance.subst_fn (fun _ -> new_univ_level (Global.current_dirpath ())) - (AUContext.instance ctx) + let init _ = new_univ_level (Global.current_dirpath ()) in + Instance.of_array (Array.init (AUContext.size ctx) init) let fresh_instance_from_context ctx = let inst = fresh_universe_instance ctx in - let constraints = UContext.constraints (subst_instance_context inst ctx) in + let constraints = AUContext.instantiate inst ctx in inst, constraints let fresh_instance ctx = let ctx' = ref LSet.empty in - let inst = - Instance.subst_fn (fun v -> - let u = new_univ_level (Global.current_dirpath ()) in - ctx' := LSet.add u !ctx'; u) - (AUContext.instance ctx) + let init _ = + let u = new_univ_level (Global.current_dirpath ()) in + ctx' := LSet.add u !ctx'; u + in + let inst = Instance.of_array (Array.init (AUContext.size ctx) init) in !ctx', inst let existing_instance ctx inst = let () = - let a1 = Instance.to_array inst - and a2 = Instance.to_array (AUContext.instance ctx) in - let len1 = Array.length a1 and len2 = Array.length a2 in + let len1 = Array.length (Instance.to_array inst) + and len2 = AUContext.size ctx in if not (len1 == len2) then CErrors.user_err ~hdr:"Universes" (str "Polymorphic constant expected " ++ int len2 ++ @@ -317,12 +316,9 @@ let fresh_instance_from ctx inst = | Some inst -> existing_instance ctx inst | None -> fresh_instance ctx in - let constraints = UContext.constraints (subst_instance_context inst ctx) in + let constraints = AUContext.instantiate inst ctx in inst, (ctx', constraints) -let unsafe_instance_from ctx = - (Univ.AUContext.instance ctx, Univ.instantiate_univ_context ctx) - (** Fresh universe polymorphic construction *) let fresh_constant_instance env c inst = @@ -359,34 +355,6 @@ let fresh_constructor_instance env (ind,i) inst = let inst, ctx = fresh_instance_from (ACumulativityInfo.univ_context acumi) inst in (((ind,i),inst), ctx) -let unsafe_constant_instance env c = - let cb = lookup_constant c env in - match cb.Declarations.const_universes with - | Declarations.Monomorphic_const _ -> - ((c,Instance.empty), UContext.empty) - | Declarations.Polymorphic_const auctx -> - let inst, ctx = unsafe_instance_from auctx in ((c, inst), ctx) - -let unsafe_inductive_instance env ind = - let mib, mip = Inductive.lookup_mind_specif env ind in - match mib.Declarations.mind_universes with - | Declarations.Monomorphic_ind _ -> ((ind,Instance.empty), UContext.empty) - | Declarations.Polymorphic_ind auctx -> - let inst, ctx = unsafe_instance_from auctx in ((ind,inst), ctx) - | Declarations.Cumulative_ind acumi -> - let inst, ctx = unsafe_instance_from (ACumulativityInfo.univ_context acumi) in - ((ind,inst), ctx) - -let unsafe_constructor_instance env (ind,i) = - let mib, mip = Inductive.lookup_mind_specif env ind in - match mib.Declarations.mind_universes with - | Declarations.Monomorphic_ind _ -> (((ind, i),Instance.empty), UContext.empty) - | Declarations.Polymorphic_ind auctx -> - let inst, ctx = unsafe_instance_from auctx in (((ind, i),inst), ctx) - | Declarations.Cumulative_ind acumi -> - let inst, ctx = unsafe_instance_from (ACumulativityInfo.univ_context acumi) in - (((ind, i),inst), ctx) - open Globnames let fresh_global_instance ?names env gr = @@ -411,19 +379,6 @@ let fresh_inductive_instance env sp = let fresh_constructor_instance env sp = fresh_constructor_instance env sp None -let unsafe_global_instance env gr = - match gr with - | VarRef id -> mkVar id, UContext.empty - | ConstRef sp -> - let c, ctx = unsafe_constant_instance env sp in - mkConstU c, ctx - | ConstructRef sp -> - let c, ctx = unsafe_constructor_instance env sp in - mkConstructU c, ctx - | IndRef sp -> - let c, ctx = unsafe_inductive_instance env sp in - mkIndU c, ctx - let constr_of_global gr = let c, ctx = fresh_global_instance (Global.env ()) gr in if not (Univ.ContextSet.is_empty ctx) then @@ -438,9 +393,6 @@ let constr_of_global gr = let constr_of_reference = constr_of_global -let unsafe_constr_of_global gr = - unsafe_global_instance (Global.env ()) gr - let constr_of_global_univ (gr,u) = match gr with | VarRef id -> mkVar id @@ -467,7 +419,7 @@ let type_of_reference env r = | VarRef id -> Environ.named_type id env, ContextSet.empty | ConstRef c -> let cb = Environ.lookup_constant c env in - let ty = Typeops.type_of_constant_type env cb.const_type in + let ty = cb.const_type in begin match cb.const_universes with | Monomorphic_const _ -> ty, ContextSet.empty @@ -514,25 +466,6 @@ let type_of_reference env r = let type_of_global t = type_of_reference (Global.env ()) t -let unsafe_type_of_reference env r = - match r with - | VarRef id -> Environ.named_type id env - | ConstRef c -> - let cb = Environ.lookup_constant c env in - Typeops.type_of_constant_type env cb.const_type - - | IndRef ind -> - let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in - let (_, inst), _ = unsafe_inductive_instance env ind in - Inductive.type_of_inductive env (specif, inst) - - | ConstructRef (ind, _ as cstr) -> - let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in - let (_, inst), _ = unsafe_inductive_instance env ind in - Inductive.type_of_constructor (cstr,inst) specif - -let unsafe_type_of_global t = unsafe_type_of_reference (Global.env ()) t - let fresh_sort_in_family env = function | InProp -> prop_sort, ContextSet.empty | InSet -> set_sort, ContextSet.empty @@ -1015,34 +948,6 @@ let normalize_context_set ctx us algs = (* let normalize_conkey = Profile.declare_profile "normalize_context_set" *) (* let normalize_context_set a b c = Profile.profile3 normalize_conkey normalize_context_set a b c *) -let simplify_universe_context (univs,csts) = - let uf = UF.create () in - let noneqs = - Constraint.fold (fun (l,d,r) noneqs -> - if d == Eq && (LSet.mem l univs || LSet.mem r univs) then - (UF.union l r uf; noneqs) - else Constraint.add (l,d,r) noneqs) - csts Constraint.empty - in - let partition = UF.partition uf in - let flex x = LSet.mem x univs in - let subst, univs', csts' = List.fold_left (fun (subst, univs, cstrs) s -> - let canon, (global, rigid, flexible) = choose_canonical univs flex LSet.empty s in - (* Add equalities for globals which can't be merged anymore. *) - let cstrs = LSet.fold (fun g cst -> - Constraint.add (canon, Univ.Eq, g) cst) (LSet.union global rigid) - cstrs - in - let subst = LSet.fold (fun f -> LMap.add f canon) - flexible subst - in (subst, LSet.diff univs flexible, cstrs)) - (LMap.empty, univs, noneqs) partition - in - (* Noneqs is now in canonical form w.r.t. equality constraints, - and contains only inequality constraints. *) - let csts' = subst_univs_level_constraints subst csts' in - (univs', csts'), subst - let is_trivial_leq (l,d,r) = Univ.Level.is_prop l && (d == Univ.Le || (d == Univ.Lt && Univ.Level.is_set r)) diff --git a/engine/universes.mli b/engine/universes.mli index 5ce5e4a42a..fe40f82385 100644 --- a/engine/universes.mli +++ b/engine/universes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -17,7 +17,7 @@ val is_set_minimization : unit -> bool (** Universes *) -val pr_with_global_universes : Level.t -> Pp.std_ppcmds +val pr_with_global_universes : Level.t -> Pp.t (** Local universe name <-> level mapping *) @@ -52,7 +52,7 @@ type universe_constraint = universe * universe_constraint_type * universe module Constraints : sig include Set.S with type elt = universe_constraint - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t end type universe_constraints = Constraints.t @@ -189,35 +189,21 @@ val constr_of_global : Globnames.global_reference -> constr (** ** DEPRECATED ** synonym of [constr_of_global] *) val constr_of_reference : Globnames.global_reference -> constr -(** [unsafe_constr_of_global gr] turns [gr] into a constr, works on polymorphic - references by taking the original universe instance that is not recorded - anywhere. The constraints are forgotten as well. DO NOT USE in new code. *) -val unsafe_constr_of_global : Globnames.global_reference -> constr in_universe_context - (** Returns the type of the global reference, by creating a fresh instance of polymorphic references and computing their instantiated universe context. (side-effect on the universe counter, use with care). *) val type_of_global : Globnames.global_reference -> types in_universe_context_set -(** [unsafe_type_of_global gr] returns [gr]'s type, works on polymorphic - references by taking the original universe instance that is not recorded - anywhere. The constraints are forgotten as well. - USE with care. *) -val unsafe_type_of_global : Globnames.global_reference -> types - (** Full universes substitutions into terms *) val nf_evars_and_universes_opt_subst : (existential -> constr option) -> universe_opt_subst -> constr -> constr -val simplify_universe_context : universe_context_set -> - universe_context_set * universe_level_subst - val refresh_constraints : UGraph.t -> universe_context_set -> universe_context_set * UGraph.t (** Pretty-printing *) -val pr_universe_opt_subst : universe_opt_subst -> Pp.std_ppcmds +val pr_universe_opt_subst : universe_opt_subst -> Pp.t (** {6 Support for template polymorphism } *) diff --git a/grammar/argextend.mlp b/grammar/argextend.mlp index 8aecf0e0c8..12b7b171b7 100644 --- a/grammar/argextend.mlp +++ b/grammar/argextend.mlp @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -46,17 +46,17 @@ let make_act loc act pil = make (List.rev pil) let make_prod_item = function - | ExtTerminal s -> <:expr< Grammar_API.Extend.Atoken (Grammar_API.CLexer.terminal $mlexpr_of_string s$) >> + | ExtTerminal s -> <:expr< Extend.Atoken (CLexer.terminal $mlexpr_of_string s$) >> | ExtNonTerminal (g, _) -> let base s = <:expr< $lid:s$ >> in mlexpr_of_prod_entry_key base g let rec make_prod = function -| [] -> <:expr< Grammar_API.Extend.Stop >> -| item :: prods -> <:expr< Grammar_API.Extend.Next $make_prod prods$ $make_prod_item item$ >> +| [] -> <:expr< Extend.Stop >> +| item :: prods -> <:expr< Extend.Next $make_prod prods$ $make_prod_item item$ >> let make_rule loc (prods,act) = - <:expr< Grammar_API.Extend.Rule $make_prod (List.rev prods)$ $make_act loc act prods$ >> + <:expr< Extend.Rule $make_prod (List.rev prods)$ $make_act loc act prods$ >> let is_ident x = function | <:expr< $lid:s$ >> -> (s : string) = x @@ -67,7 +67,7 @@ let make_extend loc s cl wit = match cl with (** Special handling of identity arguments by not redeclaring an entry *) <:str_item< value $lid:s$ = - let () = Grammar_API.Pcoq.register_grammar $wit$ $lid:e$ in + let () = Pcoq.register_grammar $wit$ $lid:e$ in $lid:e$ >> | _ -> @@ -75,8 +75,8 @@ let make_extend loc s cl wit = match cl with let rules = mlexpr_of_list (make_rule loc) (List.rev cl) in <:str_item< value $lid:s$ = - let $lid:s$ = Grammar_API.Pcoq.create_generic_entry Grammar_API.Pcoq.utactic $se$ (Genarg.rawwit $wit$) in - let () = Grammar_API.Pcoq.grammar_extend $lid:s$ None (None, [(None, None, $rules$)]) in + let $lid:s$ = Pcoq.create_generic_entry Pcoq.utactic $se$ (Genarg.rawwit $wit$) in + let () = Pcoq.grammar_extend $lid:s$ None (None, [(None, None, $rules$)]) in $lid:s$ >> let warning_redundant prefix s = @@ -127,7 +127,7 @@ let declare_tactic_argument loc s (typ, f, g, h) cl = begin match globtyp with | None -> let typ = match globtyp with None -> ExtraArgType s | Some typ -> typ in - <:expr< fun ist v -> API.Ftactic.return (API.Geninterp.Val.inject (API.Geninterp.val_tag $make_topwit loc typ$) v) >> + <:expr< fun ist v -> Ftactic.return (Geninterp.Val.inject (Geninterp.val_tag $make_topwit loc typ$) v) >> | Some globtyp -> <:expr< fun ist x -> Tacinterp.interp_genarg ist (Genarg.in_gen $make_globwit loc globtyp$ x) >> @@ -137,10 +137,11 @@ let declare_tactic_argument loc s (typ, f, g, h) cl = let typ = match globtyp with None -> ExtraArgType s | Some typ -> typ in <:expr< let f = $lid:f$ in - fun ist v -> API.Ftactic.nf_enter (fun gl -> - let (sigma, v) = API.Tacmach.New.of_old (fun gl -> f ist gl v) gl in - let v = API.Geninterp.Val.inject (API.Geninterp.val_tag $make_topwit loc typ$) v in - API.Proofview.tclTHEN (API.Proofview.Unsafe.tclEVARS sigma) (API.Ftactic.return v) + fun ist v -> Ftactic.enter (fun gl -> + let gl = Proofview.Goal.assume gl in + let (sigma, v) = Tacmach.New.of_old (fun gl -> f ist gl v) gl in + let v = Geninterp.Val.inject (Geninterp.val_tag $make_topwit loc typ$) v in + Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) (Ftactic.return v) ) >> in let subst = match h with @@ -156,15 +157,15 @@ let declare_tactic_argument loc s (typ, f, g, h) cl = | Some f -> <:expr< $lid:f$>> in let dyn = match typ with | None -> <:expr< None >> - | Some typ -> <:expr< Some (API.Geninterp.val_tag $make_topwit loc typ$) >> + | Some typ -> <:expr< Some (Geninterp.val_tag $make_topwit loc typ$) >> in let wit = <:expr< $lid:"wit_"^s$ >> in declare_str_items loc [ <:str_item< value ($lid:"wit_"^s$) = Genarg.make0 $se$ >>; - <:str_item< Grammar_API.Genintern.register_intern0 $wit$ $glob$ >>; - <:str_item< Grammar_API.Genintern.register_subst0 $wit$ $subst$ >>; - <:str_item< API.Geninterp.register_interp0 $wit$ $interp$ >>; - <:str_item< API.Geninterp.register_val0 $wit$ $dyn$ >>; + <:str_item< Genintern.register_intern0 $wit$ $glob$ >>; + <:str_item< Genintern.register_subst0 $wit$ $subst$ >>; + <:str_item< Geninterp.register_interp0 $wit$ $interp$ >>; + <:str_item< Geninterp.register_val0 $wit$ $dyn$ >>; make_extend loc s cl wit; <:str_item< do { Pptactic.declare_extra_genarg_pprule diff --git a/grammar/q_util.mli b/grammar/q_util.mli index 0b3def058f..3690778d32 100644 --- a/grammar/q_util.mli +++ b/grammar/q_util.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/grammar/q_util.mlp b/grammar/q_util.mlp index 1c2009ecea..536ee7ca56 100644 --- a/grammar/q_util.mlp +++ b/grammar/q_util.mlp @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,23 +57,23 @@ let mlexpr_of_option f = function | Some e -> <:expr< Some $f e$ >> let mlexpr_of_name f = function - | None -> <:expr< API.Names.Name.Anonymous >> - | Some e -> <:expr< API.Names.Name.Name $f e$ >> + | None -> <:expr< Names.Name.Anonymous >> + | Some e -> <:expr< Names.Name.Name $f e$ >> -let symbol_of_string s = <:expr< Grammar_API.Extend.Atoken (Grammar_API.CLexer.terminal $str:s$) >> +let symbol_of_string s = <:expr< Extend.Atoken (CLexer.terminal $str:s$) >> let rec mlexpr_of_prod_entry_key f = function - | Ulist1 s -> <:expr< Grammar_API.Extend.Alist1 $mlexpr_of_prod_entry_key f s$ >> - | Ulist1sep (s,sep) -> <:expr< Grammar_API.Extend.Alist1sep $mlexpr_of_prod_entry_key f s$ $symbol_of_string sep$ >> - | Ulist0 s -> <:expr< Grammar_API.Extend.Alist0 $mlexpr_of_prod_entry_key f s$ >> - | Ulist0sep (s,sep) -> <:expr< Grammar_API.Extend.Alist0sep $mlexpr_of_prod_entry_key f s$ $symbol_of_string sep$ >> - | Uopt s -> <:expr< Grammar_API.Extend.Aopt $mlexpr_of_prod_entry_key f s$ >> - | Uentry e -> <:expr< Grammar_API.Extend.Aentry ($f e$) >> + | Ulist1 s -> <:expr< Extend.Alist1 $mlexpr_of_prod_entry_key f s$ >> + | Ulist1sep (s,sep) -> <:expr< Extend.Alist1sep $mlexpr_of_prod_entry_key f s$ $symbol_of_string sep$ >> + | Ulist0 s -> <:expr< Extend.Alist0 $mlexpr_of_prod_entry_key f s$ >> + | Ulist0sep (s,sep) -> <:expr< Extend.Alist0sep $mlexpr_of_prod_entry_key f s$ $symbol_of_string sep$ >> + | Uopt s -> <:expr< Extend.Aopt $mlexpr_of_prod_entry_key f s$ >> + | Uentry e -> <:expr< Extend.Aentry ($f e$) >> | Uentryl (e, l) -> (** Keep in sync with Pcoq! *) assert (e = "tactic"); - if l = 5 then <:expr< Grammar_API.Extend.Aentry Pltac.binder_tactic >> - else <:expr< Grammar_API.Extend.Aentryl (Pltac.tactic_expr) $mlexpr_of_int l$ >> + if l = 5 then <:expr< Extend.Aentry Pltac.binder_tactic >> + else <:expr< Extend.Aentryl (Pltac.tactic_expr) $mlexpr_of_int l$ >> let rec type_of_user_symbol = function | Ulist1 s | Ulist1sep (s, _) | Ulist0 s | Ulist0sep (s, _) -> diff --git a/grammar/tacextend.mlp b/grammar/tacextend.mlp index 8f3f7a9de8..0b33dab051 100644 --- a/grammar/tacextend.mlp +++ b/grammar/tacextend.mlp @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -25,7 +25,7 @@ let plugin_name = <:expr< __coq_plugin_name >> let mlexpr_of_ident id = (** Workaround for badly-designed generic arguments lacking a closure *) let id = "$" ^ id in - <:expr< API.Names.Id.of_string_soft $str:id$ >> + <:expr< Names.Id.of_string_soft $str:id$ >> let rec make_patt = function | [] -> <:patt< [] >> @@ -57,18 +57,18 @@ let make_fun_clauses loc s l = let get_argt e = <:expr< (fun e -> match e with [ Genarg.ExtraArg tag -> tag | _ -> assert False ]) $e$ >> let rec mlexpr_of_symbol = function -| Ulist1 s -> <:expr< Grammar_API.Extend.Ulist1 $mlexpr_of_symbol s$ >> -| Ulist1sep (s,sep) -> <:expr< Grammar_API.Extend.Ulist1sep $mlexpr_of_symbol s$ $str:sep$ >> -| Ulist0 s -> <:expr< Grammar_API.Extend.Ulist0 $mlexpr_of_symbol s$ >> -| Ulist0sep (s,sep) -> <:expr< Grammar_API.Extend.Ulist0sep $mlexpr_of_symbol s$ $str:sep$ >> -| Uopt s -> <:expr< Grammar_API.Extend.Uopt $mlexpr_of_symbol s$ >> +| Ulist1 s -> <:expr< Extend.Ulist1 $mlexpr_of_symbol s$ >> +| Ulist1sep (s,sep) -> <:expr< Extend.Ulist1sep $mlexpr_of_symbol s$ $str:sep$ >> +| Ulist0 s -> <:expr< Extend.Ulist0 $mlexpr_of_symbol s$ >> +| Ulist0sep (s,sep) -> <:expr< Extend.Ulist0sep $mlexpr_of_symbol s$ $str:sep$ >> +| Uopt s -> <:expr< Extend.Uopt $mlexpr_of_symbol s$ >> | Uentry e -> let arg = get_argt <:expr< $lid:"wit_"^e$ >> in - <:expr< Grammar_API.Extend.Uentry (Genarg.ArgT.Any $arg$) >> + <:expr< Extend.Uentry (Genarg.ArgT.Any $arg$) >> | Uentryl (e, l) -> assert (e = "tactic"); let arg = get_argt <:expr< Tacarg.wit_tactic >> in - <:expr< Grammar_API.Extend.Uentryl (Genarg.ArgT.Any $arg$) $mlexpr_of_int l$>> + <:expr< Extend.Uentryl (Genarg.ArgT.Any $arg$) $mlexpr_of_int l$>> let make_prod_item = function | ExtTerminal s -> <:expr< Tacentries.TacTerm $str:s$ >> @@ -113,12 +113,12 @@ let declare_tactic loc tacname ~level classification clause = match clause with the ML tactic retrieves its arguments in the [ist] environment instead. This is the rôle of the [lift_constr_tac_to_ml_tac] function. *) let body = <:expr< Tacexpr.TacFun ($vars$, Tacexpr.TacML (Loc.tag ( $ml$ , []))) >> in - let name = <:expr< API.Names.Id.of_string $name$ >> in + let name = <:expr< Names.Id.of_string $name$ >> in declare_str_items loc [ <:str_item< do { let obj () = Tacenv.register_ltac True False $name$ $body$ in let () = Tacenv.register_ml_tactic $se$ [|$tac$|] in - API.Mltop.declare_cache_obj obj $plugin_name$ } >> + Mltop.declare_cache_obj obj $plugin_name$ } >> ] | _ -> (** Otherwise we add parsing and printing rules to generate a call to a @@ -131,7 +131,7 @@ let declare_tactic loc tacname ~level classification clause = match clause with declare_str_items loc [ <:str_item< do { Tacenv.register_ml_tactic $se$ (Array.of_list $make_fun_clauses loc tacname clause$); - Grammar_API.Mltop.declare_cache_obj $obj$ $plugin_name$; } >> + Mltop.declare_cache_obj $obj$ $plugin_name$; } >> ] open Pcaml diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp index 6f0e9b7cf4..a529185dd6 100644 --- a/grammar/vernacextend.mlp +++ b/grammar/vernacextend.mlp @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -100,12 +100,12 @@ let make_fun_classifiers loc s c l = mlexpr_of_list (fun x -> x) cl let make_prod_item = function - | ExtTerminal s -> <:expr< Grammar_API.Egramml.GramTerminal $str:s$ >> + | ExtTerminal s -> <:expr< Egramml.GramTerminal $str:s$ >> | ExtNonTerminal (g, ido) -> let nt = type_of_user_symbol g in - let base s = <:expr< Grammar_API.Pcoq.genarg_grammar ($mk_extraarg loc s$) >> in + let base s = <:expr< Pcoq.genarg_grammar ($mk_extraarg loc s$) >> in let typ = match ido with None -> None | Some _ -> Some nt in - <:expr< Grammar_API.Egramml.GramNonTerminal ( Loc.tag ( $mlexpr_of_option (make_rawwit loc) typ$ , + <:expr< Egramml.GramNonTerminal ( Loc.tag ( $mlexpr_of_option (make_rawwit loc) typ$ , $mlexpr_of_prod_entry_key base g$ ) ) >> let mlexpr_of_clause cl = @@ -122,9 +122,9 @@ let declare_command loc s c nt cl = let classl = make_fun_classifiers loc s c cl in declare_str_items loc [ <:str_item< do { - CList.iteri (fun i (depr, f) -> Grammar_API.Vernacinterp.vinterp_add depr ($se$, i) f) $funcl$; - CList.iteri (fun i f -> API.Vernac_classifier.declare_vernac_classifier ($se$, i) f) $classl$; - CList.iteri (fun i r -> Grammar_API.Egramml.extend_vernac_command_grammar ($se$, i) $nt$ r) $gl$; + CList.iteri (fun i (depr, f) -> Vernacinterp.vinterp_add depr ($se$, i) f) $funcl$; + CList.iteri (fun i f -> Vernac_classifier.declare_vernac_classifier ($se$, i) f) $classl$; + CList.iteri (fun i r -> Egramml.extend_vernac_command_grammar ($se$, i) $nt$ r) $gl$; } >> ] open Pcaml @@ -143,16 +143,16 @@ EXTEND | "DECLARE"; "PLUGIN"; name = STRING -> declare_str_items loc [ <:str_item< value __coq_plugin_name = $str:name$ >>; - <:str_item< value _ = Grammar_API.Mltop.add_known_module __coq_plugin_name >>; + <:str_item< value _ = Mltop.add_known_module __coq_plugin_name >>; ] ] ] ; classification: [ [ "CLASSIFIED"; "BY"; c = LIDENT -> <:expr< $lid:c$ >> | "CLASSIFIED"; "AS"; "SIDEFF" -> - <:expr< fun _ -> API.Vernac_classifier.classify_as_sideeff >> + <:expr< fun _ -> Vernac_classifier.classify_as_sideeff >> | "CLASSIFIED"; "AS"; "QUERY" -> - <:expr< fun _ -> API.Vernac_classifier.classify_as_query >> + <:expr< fun _ -> Vernac_classifier.classify_as_query >> ] ] ; deprecation: diff --git a/ide/config_lexer.mll b/ide/config_lexer.mll index ac9cc57bc0..eb575b95ff 100644 --- a/ide/config_lexer.mll +++ b/ide/config_lexer.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coq.ml b/ide/coq.ml index cd45e2fcdc..0fe831ab36 100644 --- a/ide/coq.ml +++ b/ide/coq.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -366,7 +366,14 @@ let bind_self_as f = (** This launches a fresh handle from its command line arguments. *) let spawn_handle args respawner feedback_processor = let prog = coqtop_path () in - let args = Array.of_list ("--xml_format=Ppcmds" :: "-async-proofs" :: "on" :: "-ideslave" :: args) in + let async_default = + (* disable async processing by default in Windows *) + if List.mem Sys.os_type ["Win32"; "Cygwin"] then + "off" + else + "on" + in + let args = Array.of_list ("--xml_format=Ppcmds" :: "-async-proofs" :: async_default :: "-ideslave" :: args) in let env = match !Flags.ideslave_coqtop_flags with | None -> None diff --git a/ide/coq.mli b/ide/coq.mli index e8e2f5239e..5d96486035 100644 --- a/ide/coq.mli +++ b/ide/coq.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coqOps.ml b/ide/coqOps.ml index 3a869f69af..364fc883ba 100644 --- a/ide/coqOps.ml +++ b/ide/coqOps.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -58,7 +58,7 @@ module SentenceId : sig val connect : sentence -> signals val dbg_to_string : - GText.buffer -> bool -> Stateid.t option -> sentence -> Pp.std_ppcmds + GText.buffer -> bool -> Stateid.t option -> sentence -> Pp.t end = struct @@ -163,7 +163,7 @@ let flags_to_color f = else `NAME Preferences.processed_color#get (* Move to utils? *) -let rec validate (s : Pp.std_ppcmds) = match Pp.repr s with +let rec validate (s : Pp.t) = match Pp.repr s with | Pp.Ppcmd_empty | Pp.Ppcmd_print_break _ | Pp.Ppcmd_force_newline -> true diff --git a/ide/coqOps.mli b/ide/coqOps.mli index 332c18f2f0..013db684ef 100644 --- a/ide/coqOps.mli +++ b/ide/coqOps.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coq_commands.ml b/ide/coq_commands.ml index 5912bec357..1873d5acf8 100644 --- a/ide/coq_commands.ml +++ b/ide/coq_commands.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coq_lex.mll b/ide/coq_lex.mll index b6286c49fb..8bfd937e38 100644 --- a/ide/coq_lex.mll +++ b/ide/coq_lex.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coqide.ml b/ide/coqide.ml index a1e78ee3c9..feb45a7bea 100644 --- a/ide/coqide.ml +++ b/ide/coqide.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coqide.mli b/ide/coqide.mli index 744b974ffa..39b4d9ae2f 100644 --- a/ide/coqide.mli +++ b/ide/coqide.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/coqide_main.ml4 b/ide/coqide_main.ml4 index 534a3f179d..73a30b18f1 100644 --- a/ide/coqide_main.ml4 +++ b/ide/coqide_main.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/document.mli b/ide/document.mli index fb96cb6d76..ab8e71808c 100644 --- a/ide/document.mli +++ b/ide/document.mli @@ -102,7 +102,7 @@ val context : 'a document -> (id * 'a) list * (id * 'a) list (** debug print *) val print : - 'a document -> (bool -> id option -> 'a -> Pp.std_ppcmds) -> Pp.std_ppcmds + 'a document -> (bool -> id option -> 'a -> Pp.t) -> Pp.t (** Callbacks on documents *) diff --git a/ide/fileOps.ml b/ide/fileOps.ml index 7be1bdb927..7c09f8628b 100644 --- a/ide/fileOps.ml +++ b/ide/fileOps.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/fileOps.mli b/ide/fileOps.mli index 9f0b75ac56..76014ec752 100644 --- a/ide/fileOps.mli +++ b/ide/fileOps.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/gtk_parsing.ml b/ide/gtk_parsing.ml index f905053ddb..f0575e325a 100644 --- a/ide/gtk_parsing.ml +++ b/ide/gtk_parsing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml index a07a04cbba..67391f5567 100644 --- a/ide/ide_slave.ml +++ b/ide/ide_slave.ml @@ -1,7 +1,7 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,9 +20,8 @@ module CompactedDecl = Context.Compacted.Declaration (** Ide_slave : an implementation of [Interface], i.e. mainly an interp function and a rewind function. This specialized loop is triggered - when the -ideslave option is passed to Coqtop. Currently CoqIDE is - the only one using this mode, but we try here to be as generic as - possible, so this may change in the future... *) + when the -ideslave option is passed to Coqtop. *) + (** Signal handling: we postpone ^C during input and output phases, but make it directly raise a Sys.Break during evaluation of the request. *) @@ -65,7 +64,7 @@ let is_known_option cmd = match cmd with (** Check whether a command is forbidden in the IDE *) let ide_cmd_checks ~id (loc,ast) = - let user_error s = CErrors.user_err ?loc ~hdr:"CoqIde" (str s) in + let user_error s = CErrors.user_err ?loc ~hdr:"IDE" (str s) in let warn msg = Feedback.(feedback ~id (Message (Warning, loc, strbrk msg))) in if is_debug ast then user_error "Debug mode not available in the IDE"; @@ -178,11 +177,9 @@ let process_goal sigma g = let min_env = Environ.reset_context env in let id = Goal.uid g in let ccl = - let norm_constr = Reductionops.nf_evar sigma (Goal.V82.concl sigma g) in - pr_goal_concl_style_env env sigma norm_constr + pr_goal_concl_style_env env sigma (Goal.V82.concl sigma g) in let process_hyp d (env,l) = - let d = CompactedDecl.map_constr (fun c -> EConstr.Unsafe.to_constr (Reductionops.nf_evar sigma (EConstr.of_constr c))) d in let d' = CompactedDecl.to_named_context d in (List.fold_right Environ.push_named d' env, (pr_compacted_decl env sigma d) :: l) in @@ -211,7 +208,7 @@ let evars () = Stm.finish (); let pfts = Proof_global.give_me_the_proof () in let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in - let exl = Evar.Map.bindings (Evarutil.non_instantiated sigma) in + let exl = Evar.Map.bindings (Evd.undefined_map sigma) in let map_evar ev = { Interface.evar_info = string_of_ppcmds (pr_evar sigma ev); } in let el = List.map map_evar exl in Some el @@ -509,4 +506,4 @@ let () = Coqtop.toploop_run := loop let () = Usage.add_to_usage "coqidetop" " --xml_format=Ppcmds serialize pretty printing messages using the std_ppcmds format\ -\n --help-XML-protocol print the documentation of the XML protocol used by CoqIDE\n" +\n --help-XML-protocol print documentation of the Coq XML protocol\n" diff --git a/ide/ideutils.ml b/ide/ideutils.ml index 8a0e507c0b..83e5da9509 100644 --- a/ide/ideutils.ml +++ b/ide/ideutils.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -316,7 +316,7 @@ let textview_width (view : #GText.view_skel) = let char_width = GPango.to_pixels metrics#approx_char_width in pixel_width / char_width -type logger = Feedback.level -> Pp.std_ppcmds -> unit +type logger = Feedback.level -> Pp.t -> unit let default_logger level message = let level = match level with diff --git a/ide/ideutils.mli b/ide/ideutils.mli index 4b4ba72b0b..f06a48aebe 100644 --- a/ide/ideutils.mli +++ b/ide/ideutils.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -67,7 +67,7 @@ val requote : string -> string val textview_width : #GText.view_skel -> int (** Returns an approximate value of the character width of a textview *) -type logger = Feedback.level -> Pp.std_ppcmds -> unit +type logger = Feedback.level -> Pp.t -> unit val default_logger : logger (** Default logger. It logs messages that the casual user should not see. *) diff --git a/ide/interface.mli b/ide/interface.mli index 1a4d6c0ecb..1939a8427c 100644 --- a/ide/interface.mli +++ b/ide/interface.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -17,9 +17,9 @@ type verbose = bool type goal = { goal_id : string; (** Unique goal identifier *) - goal_hyp : Pp.std_ppcmds list; + goal_hyp : Pp.t list; (** List of hypotheses *) - goal_ccl : Pp.std_ppcmds; + goal_ccl : Pp.t; (** Goal conclusion *) } @@ -121,7 +121,7 @@ type edit_id = int should probably retract to that point *) type 'a value = | Good of 'a - | Fail of (state_id * location * Pp.std_ppcmds) + | Fail of (state_id * location * Pp.t) type ('a, 'b) union = ('a, 'b) Util.union @@ -213,7 +213,7 @@ type about_sty = unit type about_rty = coq_info type handle_exn_sty = Exninfo.iexn -type handle_exn_rty = state_id * location * Pp.std_ppcmds +type handle_exn_rty = state_id * location * Pp.t (* Retrocompatibility stuff *) type interp_sty = (raw * verbose) * string diff --git a/ide/minilib.mli b/ide/minilib.mli index 4517a23744..c96e59b226 100644 --- a/ide/minilib.mli +++ b/ide/minilib.mli @@ -22,7 +22,7 @@ type level = [ (** debug printing *) val debug : bool ref -val log_pp : ?level:level -> Pp.std_ppcmds -> unit +val log_pp : ?level:level -> Pp.t -> unit val log : ?level:level -> string -> unit val coqide_config_home : unit -> string diff --git a/ide/nanoPG.ml b/ide/nanoPG.ml index 93bdeb324c..664fa7fb42 100644 --- a/ide/nanoPG.ml +++ b/ide/nanoPG.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/preferences.ml b/ide/preferences.ml index 08739d013e..7c251f79c6 100644 --- a/ide/preferences.ml +++ b/ide/preferences.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -407,11 +407,15 @@ let opposite_tabs = let background_color = new preference ~name:["background_color"] ~init:"cornsilk" ~repr:Repr.(string) +let attach_tag (pref : string preference) (tag : GText.tag) f = + tag#set_property (f pref#get); + pref#connect#changed ~callback:(fun c -> tag#set_property (f c)) + let attach_bg (pref : string preference) (tag : GText.tag) = - pref#connect#changed ~callback:(fun c -> tag#set_property (`BACKGROUND c)) + attach_tag pref tag (fun c -> `BACKGROUND c) let attach_fg (pref : string preference) (tag : GText.tag) = - pref#connect#changed ~callback:(fun c -> tag#set_property (`FOREGROUND c)) + attach_tag pref tag (fun c -> `FOREGROUND c) let processing_color = new preference ~name:["processing_color"] ~init:"light blue" ~repr:Repr.(string) diff --git a/ide/preferences.mli b/ide/preferences.mli index 801869d1dc..9dab43ba99 100644 --- a/ide/preferences.mli +++ b/ide/preferences.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/richpp.ml b/ide/richpp.ml index 522a3e0b31..5e176bdf14 100644 --- a/ide/richpp.ml +++ b/ide/richpp.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/richpp.mli b/ide/richpp.mli index ea4b189ba8..84adc61ca2 100644 --- a/ide/richpp.mli +++ b/ide/richpp.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -24,7 +24,7 @@ type 'annotation located = { that represents (located) annotations of this string. The [get_annotations] function is used to convert tags into the desired annotation. [width] sets the printing witdh of the formatter. *) -val rich_pp : int -> Pp.std_ppcmds -> Pp.pp_tag located Xml_datatype.gxml +val rich_pp : int -> Pp.t -> Pp.pp_tag located Xml_datatype.gxml (** [annotations_positions ssdoc] returns a list associating each annotations with its position in the string from which [ssdoc] is @@ -47,5 +47,5 @@ type richpp = Xml_datatype.xml (** Type of text with style annotations *) -val richpp_of_pp : int -> Pp.std_ppcmds -> richpp +val richpp_of_pp : int -> Pp.t -> richpp (** Extract style information from formatted text *) diff --git a/ide/sentence.ml b/ide/sentence.ml index e332682dd0..9386ac123d 100644 --- a/ide/sentence.ml +++ b/ide/sentence.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/sentence.mli b/ide/sentence.mli index feb3c0ac03..0e093a31c3 100644 --- a/ide/sentence.mli +++ b/ide/sentence.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/serialize.ml b/ide/serialize.ml index 7b568501ed..e874b9ff27 100644 --- a/ide/serialize.ml +++ b/ide/serialize.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/serialize.mli b/ide/serialize.mli index bf9e184ebb..2f18f0de24 100644 --- a/ide/serialize.mli +++ b/ide/serialize.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/session.ml b/ide/session.ml index 7aea75ac84..0a09cc9f57 100644 --- a/ide/session.ml +++ b/ide/session.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/session.mli b/ide/session.mli index 028a1f9de6..b0866ddc95 100644 --- a/ide/session.mli +++ b/ide/session.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/tags.ml b/ide/tags.ml index e4510e7af4..08ca47a842 100644 --- a/ide/tags.ml +++ b/ide/tags.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/tags.mli b/ide/tags.mli index 02e15a5ae4..265dfe46e3 100644 --- a/ide/tags.mli +++ b/ide/tags.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/utf8_convert.mll b/ide/utf8_convert.mll index 5cc8cbc0d2..6a9e238797 100644 --- a/ide/utf8_convert.mll +++ b/ide/utf8_convert.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Command.ml b/ide/wg_Command.ml index 621c46b94a..031af6e2a2 100644 --- a/ide/wg_Command.ml +++ b/ide/wg_Command.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Command.mli b/ide/wg_Command.mli index 341322be1b..f22ec96ef1 100644 --- a/ide/wg_Command.mli +++ b/ide/wg_Command.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Completion.ml b/ide/wg_Completion.ml index 3bb6b780e6..f87730461f 100644 --- a/ide/wg_Completion.ml +++ b/ide/wg_Completion.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Completion.mli b/ide/wg_Completion.mli index dd496aa5f5..149563bb72 100644 --- a/ide/wg_Completion.mli +++ b/ide/wg_Completion.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Detachable.ml b/ide/wg_Detachable.ml index cbc34462e2..e5b4364278 100644 --- a/ide/wg_Detachable.ml +++ b/ide/wg_Detachable.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Detachable.mli b/ide/wg_Detachable.mli index a7e8f46763..7261c1e035 100644 --- a/ide/wg_Detachable.mli +++ b/ide/wg_Detachable.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Find.ml b/ide/wg_Find.ml index f84b9063bf..a62ff2de58 100644 --- a/ide/wg_Find.ml +++ b/ide/wg_Find.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Find.mli b/ide/wg_Find.mli index 1ef1c4d499..1055ba9164 100644 --- a/ide/wg_Find.mli +++ b/ide/wg_Find.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_MessageView.ml b/ide/wg_MessageView.ml index 3d0cd46cd4..65df2b8494 100644 --- a/ide/wg_MessageView.ml +++ b/ide/wg_MessageView.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -28,9 +28,9 @@ class type message_view = inherit GObj.widget method connect : message_view_signals method clear : unit - method add : Pp.std_ppcmds -> unit + method add : Pp.t -> unit method add_string : string -> unit - method set : Pp.std_ppcmds -> unit + method set : Pp.t -> unit method refresh : bool -> unit method push : Ideutils.logger (** same as [add], but with an explicit level instead of [Notice] *) diff --git a/ide/wg_MessageView.mli b/ide/wg_MessageView.mli index d065fcbc80..6bd0625f0e 100644 --- a/ide/wg_MessageView.mli +++ b/ide/wg_MessageView.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,9 +18,9 @@ class type message_view = inherit GObj.widget method connect : message_view_signals method clear : unit - method add : Pp.std_ppcmds -> unit + method add : Pp.t -> unit method add_string : string -> unit - method set : Pp.std_ppcmds -> unit + method set : Pp.t -> unit method refresh : bool -> unit method push : Ideutils.logger (** same as [add], but with an explicit level instead of [Notice] *) diff --git a/ide/wg_Notebook.ml b/ide/wg_Notebook.ml index 0e5284c2f9..e0979af9a1 100644 --- a/ide/wg_Notebook.ml +++ b/ide/wg_Notebook.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Notebook.mli b/ide/wg_Notebook.mli index 34eb1d11e3..01cf043a20 100644 --- a/ide/wg_Notebook.mli +++ b/ide/wg_Notebook.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_ProofView.ml b/ide/wg_ProofView.ml index 0bf5afbfdb..eccebce124 100644 --- a/ide/wg_ProofView.ml +++ b/ide/wg_ProofView.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_ProofView.mli b/ide/wg_ProofView.mli index a90d429d04..7c33f0ae5a 100644 --- a/ide/wg_ProofView.mli +++ b/ide/wg_ProofView.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_ScriptView.ml b/ide/wg_ScriptView.ml index 7430f07d47..f9b9f44937 100644 --- a/ide/wg_ScriptView.ml +++ b/ide/wg_ScriptView.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_ScriptView.mli b/ide/wg_ScriptView.mli index 6cce5e5b43..29ad2615a0 100644 --- a/ide/wg_ScriptView.mli +++ b/ide/wg_ScriptView.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Segment.ml b/ide/wg_Segment.ml index d527a0d13a..523d41709a 100644 --- a/ide/wg_Segment.ml +++ b/ide/wg_Segment.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/wg_Segment.mli b/ide/wg_Segment.mli index 29cbbedacf..5ec5421f55 100644 --- a/ide/wg_Segment.mli +++ b/ide/wg_Segment.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/xml_printer.ml b/ide/xml_printer.ml index 40ab4ce9cb..10ed3004d9 100644 --- a/ide/xml_printer.ml +++ b/ide/xml_printer.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/xml_printer.mli b/ide/xml_printer.mli index f24f51fff5..f2bb2f850d 100644 --- a/ide/xml_printer.mli +++ b/ide/xml_printer.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml index d42bfe43dd..4b521a9682 100644 --- a/ide/xmlprotocol.ml +++ b/ide/xmlprotocol.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -117,7 +117,7 @@ let to_box = let open Pp in | x -> raise (Marshal_error("*ppbox",PCData x)) ) -let rec of_pp (pp : Pp.std_ppcmds) = let open Pp in match Pp.repr pp with +let rec of_pp (pp : Pp.t) = let open Pp in match Pp.repr pp with | Ppcmd_empty -> constructor "ppdoc" "empty" [] | Ppcmd_string s -> constructor "ppdoc" "string" [of_string s] | Ppcmd_glue sl -> constructor "ppdoc" "glue" [of_list of_pp sl] @@ -149,7 +149,7 @@ let rec to_pp xpp = let open Pp in let of_richpp x = Element ("richpp", [], [x]) (* Run-time Selectable *) -let of_pp (pp : Pp.std_ppcmds) = +let of_pp (pp : Pp.t) = match !msg_format with | Richpp margin -> of_richpp (Richpp.richpp_of_pp margin pp) | Ppcmds -> of_pp pp diff --git a/ide/xmlprotocol.mli b/ide/xmlprotocol.mli index 9cefab517f..d1c678b90f 100644 --- a/ide/xmlprotocol.mli +++ b/ide/xmlprotocol.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/install.sh b/install.sh index c5835b0143..f8589a3c71 100755 --- a/install.sh +++ b/install.sh @@ -8,7 +8,7 @@ for f; do dn=`dirname $f` install -d "$dest/$dn" case $bn in - *.cmxs) install -m 755 $f "$dest/$dn/$bn" + *.cmxs|*.py) install -m 755 $f "$dest/$dn/$bn" ;; *) install -m 644 $f "$dest/$dn/$bn" ;; diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml index 396dde0465..2d0a19b9a6 100644 --- a/interp/constrexpr_ops.ml +++ b/interp/constrexpr_ops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli index 0ff51b060f..7bd275e510 100644 --- a/interp/constrexpr_ops.mli +++ b/interp/constrexpr_ops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 8a798bfb00..fcaee5c939 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/constrextern.mli b/interp/constrextern.mli index 6c82168e48..b5242b3477 100644 --- a/interp/constrextern.mli +++ b/interp/constrextern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/constrintern.ml b/interp/constrintern.ml index 89827300c4..c9fc3aa4f3 100644 --- a/interp/constrintern.ml +++ b/interp/constrintern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -664,11 +664,11 @@ let instantiate_notation_constr loc intern ntnvars subst infos c = | NProd (Name id, NHole _, c') when option_mem_assoc id binderopt -> let a,letins = snd (Option.get binderopt) in let e = make_letins letins (aux subst' infos c') in - let (loc,(na,bk,t)) = a in + let (_loc,(na,bk,t)) = a in CAst.make ?loc @@ GProd (na,bk,t,e) | NLambda (Name id,NHole _,c') when option_mem_assoc id binderopt -> let a,letins = snd (Option.get binderopt) in - let (loc,(na,bk,t)) = a in + let (_loc,(na,bk,t)) = a in CAst.make ?loc @@ GLambda (na,bk,t,make_letins letins (aux subst' infos c')) (* Two special cases to keep binder name synchronous with BinderType *) | NProd (na,NHole(Evar_kinds.BinderType na',naming,arg),c') diff --git a/interp/constrintern.mli b/interp/constrintern.mli index a92e94d97b..0a4eaf8382 100644 --- a/interp/constrintern.mli +++ b/interp/constrintern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/declare.ml b/interp/declare.ml index db3dbcbd92..70f422b514 100644 --- a/library/declare.ml +++ b/interp/declare.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -63,8 +63,12 @@ let cache_variable ((sp,_),o) = impl, true, poly, ctx | SectionLocalDef (de) -> let univs = Global.push_named_def (id,de) in + let poly = match de.const_entry_universes with + | Monomorphic_const_entry _ -> false + | Polymorphic_const_entry _ -> true + in Explicit, de.const_entry_opaque, - de.const_entry_polymorphic, univs in + poly, univs in Nametab.push (Nametab.Until 1) (restrict_path 0 sp) (VarRef id); add_section_variable id impl poly ctx; Dischargedhypsmap.set_discharged_hyps sp []; @@ -98,14 +102,12 @@ let declare_variable id obj = (** Declaration of constants and parameters *) type constant_obj = { - cst_decl : global_declaration; + cst_decl : global_declaration option; + (** [None] when the declaration is a side-effect and has already been defined + in the global environment. *) cst_hyps : Dischargedhypsmap.discharged_hyps; cst_kind : logical_kind; cst_locl : bool; - mutable cst_exported : Safe_typing.exported_private_constant list; - (* mutable: to avoid change the libobject API, since cache_function - * does not return an updated object *) - mutable cst_was_seff : bool } type constant_declaration = Safe_typing.private_constants constant_entry * logical_kind @@ -145,16 +147,15 @@ let cache_constant ((sp,kn), obj) = let id = basename sp in let _,dir,_ = repr_kn kn in let kn' = - if obj.cst_was_seff then begin - obj.cst_was_seff <- false; + match obj.cst_decl with + | None -> if Global.exists_objlabel (Label.of_id (basename sp)) then constant_of_kn kn else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp) ++ str".") - end else + | Some decl -> let () = check_exists sp in - let kn', exported = Global.add_constant dir id obj.cst_decl in - obj.cst_exported <- exported; - kn' in + Global.add_constant dir id decl + in assert (eq_constant kn' (constant_of_kn kn)); Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn)); let cst = Global.lookup_constant kn' in @@ -175,26 +176,20 @@ let discharge_constant ((sp, kn), obj) = let new_hyps = (discharged_hyps kn hyps) @ obj.cst_hyps in let abstract = (named_of_variable_context hyps, subst, uctx) in let new_decl = GlobalRecipe{ from; info = { Opaqueproof.modlist; abstract}} in - Some { obj with cst_hyps = new_hyps; cst_decl = new_decl; } + Some { obj with cst_hyps = new_hyps; cst_decl = Some new_decl; } (* Hack to reduce the size of .vo: we keep only what load/open needs *) -let dummy_constant_entry = - ConstantEntry - (false, ParameterEntry (None,false,(mkProp,Univ.UContext.empty),None)) - let dummy_constant cst = { - cst_decl = dummy_constant_entry; + cst_decl = None; cst_hyps = []; cst_kind = cst.cst_kind; cst_locl = cst.cst_locl; - cst_exported = []; - cst_was_seff = cst.cst_was_seff; } let classify_constant cst = Substitute (dummy_constant cst) -let (inConstant, outConstant : (constant_obj -> obj) * (obj -> constant_obj)) = - declare_object_full { (default_object "CONSTANT") with +let (inConstant : constant_obj -> obj) = + declare_object { (default_object "CONSTANT") with cache_function = cache_constant; load_function = load_constant; open_function = open_constant; @@ -205,31 +200,14 @@ let (inConstant, outConstant : (constant_obj -> obj) * (obj -> constant_obj)) = let declare_scheme = ref (fun _ _ -> assert false) let set_declare_scheme f = declare_scheme := f +let update_tables c = + declare_constant_implicits c; + Heads.declare_head (EvalConstRef c); + Notation.declare_ref_arguments_scope (ConstRef c) + let declare_constant_common id cst = - let update_tables c = -(* Printf.eprintf "tables: %s\n%!" (Names.Constant.to_string c); *) - declare_constant_implicits c; - Heads.declare_head (EvalConstRef c); - Notation.declare_ref_arguments_scope (ConstRef c) in let o = inConstant cst in let _, kn as oname = add_leaf id o in - List.iter (fun (c,ce,role) -> - (* handling of private_constants just exported *) - let o = inConstant { - cst_decl = ConstantEntry (false, ce); - cst_hyps = [] ; - cst_kind = IsProof Theorem; - cst_locl = false; - cst_exported = []; - cst_was_seff = true; } in - let id = Label.to_id (pi3 (Constant.repr3 c)) in - ignore(add_leaf id o); - update_tables c; - let () = if_xml (Hook.get f_xml_declare_constant) (InternalTacticRequest, c) in - match role with - | Safe_typing.Subproof -> () - | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|]) - (outConstant o).cst_exported; pull_to_head oname; let c = Global.constant_of_delta_kn kn in update_tables c; @@ -237,34 +215,58 @@ let declare_constant_common id cst = let definition_entry ?fix_exn ?(opaque=false) ?(inline=false) ?types ?(poly=false) ?(univs=Univ.UContext.empty) ?(eff=Safe_typing.empty_private_constants) body = + let univs = + if poly then Polymorphic_const_entry univs + else Monomorphic_const_entry univs + in { const_entry_body = Future.from_val ?fix_exn ((body,Univ.ContextSet.empty), eff); const_entry_secctx = None; const_entry_type = types; - const_entry_polymorphic = poly; const_entry_universes = univs; const_entry_opaque = opaque; const_entry_feedback = None; const_entry_inline_code = inline} let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(export_seff=false) (cd, kind) = - let export = (* We deal with side effects *) + let is_poly de = match de.const_entry_universes with + | Monomorphic_const_entry _ -> false + | Polymorphic_const_entry _ -> true + in + let in_section = Lib.sections_are_opened () in + let export, decl = (* We deal with side effects *) match cd with | DefinitionEntry de when export_seff || not de.const_entry_opaque || - de.const_entry_polymorphic -> - let bo = de.const_entry_body in - let _, seff = Future.force bo in - Safe_typing.empty_private_constants <> seff - | _ -> false + is_poly de -> + (** This globally defines the side-effects in the environment. We mark + exported constants as being side-effect not to redeclare them at + caching time. *) + let cd, export = Global.export_private_constants ~in_section cd in + export, ConstantEntry (PureEntry, cd) + | _ -> [], ConstantEntry (EffectEntry, cd) + in + let iter_eff (c, role) = + let o = inConstant { + cst_decl = None; + cst_hyps = [] ; + cst_kind = IsProof Theorem; + cst_locl = false; + } in + let id = Label.to_id (pi3 (Constant.repr3 c)) in + ignore(add_leaf id o); + update_tables c; + let () = if_xml (Hook.get f_xml_declare_constant) (InternalTacticRequest, c) in + match role with + | Safe_typing.Subproof -> () + | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|] in + let () = List.iter iter_eff export in let cst = { - cst_decl = ConstantEntry (export,cd); + cst_decl = Some decl; cst_hyps = [] ; cst_kind = kind; cst_locl = local; - cst_exported = []; - cst_was_seff = false; } in let kn = declare_constant_common id cst in let () = if_xml (Hook.get f_xml_declare_constant) (internal, kn) in @@ -333,9 +335,9 @@ let discharge_inductive ((sp,kn),(dhyps,mie)) = let mind = Global.mind_of_delta_kn kn in let mie = Global.lookup_mind mind in let repl = replacement_context () in - let sechyps,usubst,uctx = section_segment_of_mutual_inductive mind in + let sechyps, _, _ as info = section_segment_of_mutual_inductive mind in Some (discharged_hyps kn sechyps, - Discharge.process_inductive (named_of_variable_context sechyps,uctx) repl mie) + Discharge.process_inductive info repl mie) let dummy_one_inductive_entry mie = { mind_entry_typename = mie.mind_entry_typename; diff --git a/library/declare.mli b/interp/declare.mli index f70d594d7e..6a09434645 100644 --- a/library/declare.mli +++ b/interp/declare.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml index 10621f14dd..561b0078aa 100644 --- a/interp/dumpglob.ml +++ b/interp/dumpglob.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli index f42055af7b..054e43e7c8 100644 --- a/interp/dumpglob.mli +++ b/interp/dumpglob.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/genintern.ml b/interp/genintern.ml index e443824bd2..f4996c997f 100644 --- a/interp/genintern.ml +++ b/interp/genintern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/genintern.mli b/interp/genintern.mli index 658caa08c2..bce9ba5892 100644 --- a/interp/genintern.mli +++ b/interp/genintern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/impargs.ml b/interp/impargs.ml index 8f3bfc17e4..d8241c0443 100644 --- a/library/impargs.ml +++ b/interp/impargs.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -414,7 +414,7 @@ let compute_semi_auto_implicits env f manual t = let compute_constant_implicits flags manual cst = let env = Global.env () in let cb = Environ.lookup_constant cst env in - let ty = Typeops.type_of_constant_type env cb.const_type in + let ty = cb.const_type in let impls = compute_semi_auto_implicits env flags manual ty in impls @@ -431,12 +431,13 @@ let compute_mib_implicits flags manual kn = (Array.mapi (* No need to lift, arities contain no de Bruijn *) (fun i mip -> (** No need to care about constraints here *) - Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, Global.type_of_global_unsafe (IndRef (kn,i)))) + let ty, _ = Global.type_of_global_in_context env (IndRef (kn,i)) in + Context.Rel.Declaration.LocalAssum (Name mip.mind_typename, ty)) mib.mind_packets) in let env_ar = push_rel_context ar env in let imps_one_inductive i mip = let ind = (kn,i) in - let ar = Global.type_of_global_unsafe (IndRef ind) in + let ar, _ = Global.type_of_global_in_context env (IndRef ind) in ((IndRef ind,compute_semi_auto_implicits env flags manual ar), Array.mapi (fun j c -> (ConstructRef (ind,j+1),compute_semi_auto_implicits env_ar flags manual c)) @@ -674,7 +675,7 @@ let projection_implicits env p impls = let declare_manual_implicits local ref ?enriching l = let flags = !implicit_args in let env = Global.env () in - let t = Global.type_of_global_unsafe ref in + let t, _ = Global.type_of_global_in_context (Global.env ()) ref in let enriching = Option.default flags.auto enriching in let isrigid,autoimpls = compute_auto_implicits env flags enriching t in let l' = match l with diff --git a/library/impargs.mli b/interp/impargs.mli index 3919a519c9..4b78f54eac 100644 --- a/library/impargs.mli +++ b/interp/impargs.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml index ade524141a..e498d979de 100644 --- a/interp/implicit_quantifiers.ml +++ b/interp/implicit_quantifiers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/implicit_quantifiers.mli b/interp/implicit_quantifiers.mli index 945bed2aad..f7c36c4e5f 100644 --- a/interp/implicit_quantifiers.mli +++ b/interp/implicit_quantifiers.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/modintern.ml b/interp/modintern.ml index 3115c2bcbf..08657936ee 100644 --- a/interp/modintern.ml +++ b/interp/modintern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/modintern.mli b/interp/modintern.mli index 1e04ada17b..a21b6e2312 100644 --- a/interp/modintern.mli +++ b/interp/modintern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/notation.ml b/interp/notation.ml index 300f6b1dd0..c07a009438 100644 --- a/interp/notation.ml +++ b/interp/notation.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -582,11 +582,12 @@ let interpretation_eq (vars1, t1) (vars2, t2) = List.equal var_attributes_eq vars1 vars2 && Notation_ops.eq_notation_constr (List.map fst vars1, List.map fst vars2) t1 t2 -let exists_notation_in_scope scopt ntn r = +let exists_notation_in_scope scopt ntn onlyprint r = let scope = match scopt with Some s -> s | None -> default_scope in try let sc = String.Map.find scope !scope_map in let n = String.Map.find ntn sc.notations in + onlyprint = n.not_onlyprinting && interpretation_eq n.not_interp r with Not_found -> false @@ -717,13 +718,13 @@ let rebuild_arguments_scope (req,r,n,l,_) = match req with | ArgsScopeNoDischarge -> assert false | ArgsScopeAuto -> - let scs,cls = compute_arguments_scope_full (fst(Universes.type_of_global r)(*FIXME?*)) in + let scs,cls = compute_arguments_scope_full (fst(Global.type_of_global_in_context (Global.env ()) r)(*FIXME?*)) in (req,r,List.length scs,scs,cls) | ArgsScopeManual -> (* Add to the manually given scopes the one found automatically for the extra parameters of the section. Discard the classes of the manually given scopes to avoid further re-computations. *) - let l',cls = compute_arguments_scope_full (Global.type_of_global_unsafe r) in + let l',cls = compute_arguments_scope_full (fst (Global.type_of_global_in_context (Global.env ()) r)) in let l1 = List.firstn n l' in let cls1 = List.firstn n cls in (req,r,0,l1@l,cls1) @@ -767,7 +768,7 @@ let find_arguments_scope r = with Not_found -> [] let declare_ref_arguments_scope ref = - let t = Global.type_of_global_unsafe ref in + let t, _ = Global.type_of_global_in_context (Global.env ()) ref in let (scs,cls as o) = compute_arguments_scope_full t in declare_arguments_scope_gen ArgsScopeAuto ref (List.length scs) o diff --git a/interp/notation.mli b/interp/notation.mli index c739ec12fd..e63ad10cde 100644 --- a/interp/notation.mli +++ b/interp/notation.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Bigint open Names open Libnames @@ -148,7 +147,7 @@ val interp_notation_as_global_reference : ?loc:Loc.t -> (global_reference -> boo (** Checks for already existing notations *) val exists_notation_in_scope : scope_name option -> notation -> - interpretation -> bool + bool -> interpretation -> bool (** Declares and looks for scopes associated to arguments of a global ref *) val declare_arguments_scope : @@ -189,13 +188,13 @@ val make_notation_key : symbol list -> notation val decompose_notation_key : notation -> symbol list (** Prints scopes (expects a pure aconstr printer) *) -val pr_scope_class : scope_class -> std_ppcmds -val pr_scope : (glob_constr -> std_ppcmds) -> scope_name -> std_ppcmds -val pr_scopes : (glob_constr -> std_ppcmds) -> std_ppcmds -val locate_notation : (glob_constr -> std_ppcmds) -> notation -> - scope_name option -> std_ppcmds +val pr_scope_class : scope_class -> Pp.t +val pr_scope : (glob_constr -> Pp.t) -> scope_name -> Pp.t +val pr_scopes : (glob_constr -> Pp.t) -> Pp.t +val locate_notation : (glob_constr -> Pp.t) -> notation -> + scope_name option -> Pp.t -val pr_visibility: (glob_constr -> std_ppcmds) -> scope_name option -> std_ppcmds +val pr_visibility: (glob_constr -> Pp.t) -> scope_name option -> Pp.t (** {6 Printing rules for notations} *) diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 33b93606ec..5d703011d2 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -22,9 +22,16 @@ open Notation_term (**********************************************************************) (* Utilities *) +(* helper for NVar, NVar case in eq_notation_constr *) +let get_var_ndx id vs = try Some (List.index Id.equal id vs) with Not_found -> None + let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with | NRef gr1, NRef gr2 -> eq_gr gr1 gr2 -| NVar id1, NVar id2 -> Int.equal (List.index Id.equal id1 vars1) (List.index Id.equal id2 vars2) +| NVar id1, NVar id2 -> ( + match (get_var_ndx id1 vars1,get_var_ndx id2 vars2) with + | Some n,Some m -> Int.equal n m + | None ,None -> Id.equal id1 id2 + | _ -> false) | NApp (t1, a1), NApp (t2, a2) -> (eq_notation_constr vars) t1 t2 && List.equal (eq_notation_constr vars) a1 a2 | NHole (_, _, _), NHole (_, _, _) -> true (** FIXME? *) diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli index 64f811dc20..3154fd7adb 100644 --- a/interp/notation_ops.mli +++ b/interp/notation_ops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/ppextend.ml b/interp/ppextend.ml index 87ca253253..2bbe87bbca 100644 --- a/interp/ppextend.ml +++ b/interp/ppextend.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/ppextend.mli b/interp/ppextend.mli index 09dc369437..a347a5c7b7 100644 --- a/interp/ppextend.mli +++ b/interp/ppextend.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp - (** {6 Pretty-print. } *) (** Dealing with precedences *) @@ -28,9 +26,9 @@ type ppcut = | PpBrk of int * int | PpFnl -val ppcmd_of_box : ppbox -> std_ppcmds -> std_ppcmds +val ppcmd_of_box : ppbox -> Pp.t -> Pp.t -val ppcmd_of_cut : ppcut -> std_ppcmds +val ppcmd_of_cut : ppcut -> Pp.t type unparsing = | UnpMetaVar of int * parenRelation diff --git a/interp/reserve.ml b/interp/reserve.ml index 20fdd6caa2..b05f052837 100644 --- a/interp/reserve.ml +++ b/interp/reserve.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/reserve.mli b/interp/reserve.mli index 9c77400da2..4fcef23c52 100644 --- a/interp/reserve.mli +++ b/interp/reserve.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/smartlocate.ml b/interp/smartlocate.ml index a9d94669a6..b823aeda25 100644 --- a/interp/smartlocate.ml +++ b/interp/smartlocate.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/smartlocate.mli b/interp/smartlocate.mli index acae1a391f..386cf88c90 100644 --- a/interp/smartlocate.mli +++ b/interp/smartlocate.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/stdarg.ml b/interp/stdarg.ml index a393dd71c2..274ea6213b 100644 --- a/interp/stdarg.ml +++ b/interp/stdarg.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/stdarg.mli b/interp/stdarg.mli index be876504ec..1d4a29b9c2 100644 --- a/interp/stdarg.mli +++ b/interp/stdarg.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml index ed7b0b70d4..84c6f4ef30 100644 --- a/interp/syntax_def.ml +++ b/interp/syntax_def.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli index 55e2848e69..36a3986b54 100644 --- a/interp/syntax_def.mli +++ b/interp/syntax_def.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/topconstr.ml b/interp/topconstr.ml index 94bbc60eaf..7a3c83ff96 100644 --- a/interp/topconstr.ml +++ b/interp/topconstr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/interp/topconstr.mli b/interp/topconstr.mli index fabb1cb930..922f879558 100644 --- a/interp/topconstr.mli +++ b/interp/topconstr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/constrexpr.ml b/intf/constrexpr.ml index 593b190a6b..413cd9704b 100644 --- a/intf/constrexpr.ml +++ b/intf/constrexpr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/decl_kinds.ml b/intf/decl_kinds.ml index c15c009887..a977588332 100644 --- a/intf/decl_kinds.ml +++ b/intf/decl_kinds.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/evar_kinds.ml b/intf/evar_kinds.ml index ac0d96e96b..36c421c6ca 100644 --- a/intf/evar_kinds.ml +++ b/intf/evar_kinds.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/extend.ml b/intf/extend.ml index 99401d06f0..5552bed559 100644 --- a/intf/extend.ml +++ b/intf/extend.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/genredexpr.ml b/intf/genredexpr.ml index 2a542e0ff2..a8c37c6207 100644 --- a/intf/genredexpr.ml +++ b/intf/genredexpr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/glob_term.ml b/intf/glob_term.ml index a35dae4aae..dd122b972d 100644 --- a/intf/glob_term.ml +++ b/intf/glob_term.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/locus.ml b/intf/locus.ml index 57b398ab46..81fa704d88 100644 --- a/intf/locus.ml +++ b/intf/locus.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/misctypes.ml b/intf/misctypes.ml index 2ab70a78ef..807882b42f 100644 --- a/intf/misctypes.ml +++ b/intf/misctypes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/notation_term.ml b/intf/notation_term.ml index 753fa657a8..cee96040bd 100644 --- a/intf/notation_term.ml +++ b/intf/notation_term.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -83,9 +83,10 @@ type notation_interp_env = { type grammar_constr_prod_item = | GramConstrTerminal of Tok.t | GramConstrNonTerminal of Extend.constr_prod_entry_key * Id.t option - | GramConstrListMark of int * bool + | GramConstrListMark of int * bool * int (* tells action rule to make a list of the n previous parsed items; - concat with last parsed list if true *) + concat with last parsed list when true; additionally release + the p last items as if they were parsed autonomously *) type notation_grammar = { notgram_level : int; diff --git a/intf/pattern.ml b/intf/pattern.ml index 48381cacdc..2ab526984a 100644 --- a/intf/pattern.ml +++ b/intf/pattern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/tactypes.ml b/intf/tactypes.ml index 5c1d31946c..2c42e13110 100644 --- a/intf/tactypes.ml +++ b/intf/tactypes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/intf/vernacexpr.ml b/intf/vernacexpr.ml index 31ec444707..2adf522b74 100644 --- a/intf/vernacexpr.ml +++ b/intf/vernacexpr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -305,6 +305,14 @@ type inline = type module_ast_inl = module_ast * inline type module_binder = bool option * lident list * module_ast_inl +(** Cumulativity can be set globally, locally or unset locally and it + can not enabled at all. *) +type cumulative_inductive_parsing_flag = + | GlobalCumulativity + | GlobalNonCumulativity + | LocalCumulativity + | LocalNonCumulativity + (** {6 The type of vernacular expressions} *) type vernac_expr = @@ -336,7 +344,7 @@ type vernac_expr = | VernacExactProof of constr_expr | VernacAssumption of (locality option * assumption_object_kind) * inline * (plident list * constr_expr) with_coercion list - | VernacInductive of cumulative_inductive_flag * private_flag * inductive_flag * (inductive_expr * decl_notation list) list + | VernacInductive of cumulative_inductive_parsing_flag * private_flag * inductive_flag * (inductive_expr * decl_notation list) list | VernacFixpoint of locality option * (fixpoint_expr * decl_notation list) list | VernacCoFixpoint of diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml index 8bd4b5bfe1..7e193ef829 100644 --- a/kernel/cClosure.ml +++ b/kernel/cClosure.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli index 69a5e79b45..9e5cb48a49 100644 --- a/kernel/cClosure.mli +++ b/kernel/cClosure.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml index 94ca4c72dd..25f61c7aa9 100644 --- a/kernel/cbytecodes.ml +++ b/kernel/cbytecodes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli index b8de7619cf..718917ab35 100644 --- a/kernel/cbytecodes.mli +++ b/kernel/cbytecodes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -34,7 +34,7 @@ type structured_constant = | Const_univ_level of Univ.universe_level | Const_type of Univ.universe -val pp_struct_const : structured_constant -> Pp.std_ppcmds +val pp_struct_const : structured_constant -> Pp.t type reloc_table = (tag * int) array @@ -163,8 +163,8 @@ type comp_env = { in_env : vm_env ref (** the variables that are accessed *) } -val pp_bytecodes : bytecodes -> Pp.std_ppcmds -val pp_fv_elem : fv_elem -> Pp.std_ppcmds +val pp_bytecodes : bytecodes -> Pp.t +val pp_fv_elem : fv_elem -> Pp.t (*spiwack: moved this here because I needed it for retroknowledge *) type block = diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml index 02c6a2c715..d63fcffa2c 100644 --- a/kernel/cbytegen.ml +++ b/kernel/cbytegen.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml index 40c1e027d4..092bcecc38 100644 --- a/kernel/cemitcodes.ml +++ b/kernel/cemitcodes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/constr.ml b/kernel/constr.ml index eecceb32a7..c3e6095363 100644 --- a/kernel/constr.ml +++ b/kernel/constr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/constr.mli b/kernel/constr.mli index e0954160f9..76dbf55309 100644 --- a/kernel/constr.mli +++ b/kernel/constr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/context.ml b/kernel/context.ml index abb284f226..929324efec 100644 --- a/kernel/context.ml +++ b/kernel/context.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/context.mli b/kernel/context.mli index 24e69ebd6e..c3ecd8d4ea 100644 --- a/kernel/context.mli +++ b/kernel/context.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/conv_oracle.ml b/kernel/conv_oracle.ml index 4533169804..ca568fc6ec 100644 --- a/kernel/conv_oracle.ml +++ b/kernel/conv_oracle.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli index 70f02b54d7..248cd2b30e 100644 --- a/kernel/conv_oracle.mli +++ b/kernel/conv_oracle.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/cooking.ml b/kernel/cooking.ml index 0008653644..80d41847cd 100644 --- a/kernel/cooking.ml +++ b/kernel/cooking.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,7 +18,6 @@ open Util open Names open Term open Declarations -open Environ open Univ module NamedDecl = Context.Named.Declaration @@ -151,9 +150,14 @@ let abstract_constant_body = type recipe = { from : constant_body; info : Opaqueproof.cooking_info } type inline = bool -type result = - constant_def * constant_type * projection_body option * - constant_universes * inline * Context.Named.t option +type result = { + cook_body : constant_def; + cook_type : types; + cook_proj : projection_body option; + cook_universes : constant_universes; + cook_inline : inline; + cook_context : Context.Named.t option; +} let on_body ml hy f = function | Undef _ as x -> x @@ -162,11 +166,6 @@ let on_body ml hy f = function OpaqueDef (Opaqueproof.discharge_direct_opaque ~cook_constr:f { Opaqueproof.modlist = ml; abstract = hy } o) -let constr_of_def otab = function - | Undef _ -> assert false - | Def cs -> Mod_subst.force_constr cs - | OpaqueDef lc -> Opaqueproof.force_proof otab lc - let expmod_constr_subst cache modlist subst c = let c = expmod_constr cache modlist c in Vars.subst_univs_level_constr subst c @@ -184,13 +183,14 @@ let lift_univs cb subst = if (Univ.LMap.is_empty subst) then subst, (Polymorphic_const auctx) else - let inst = Univ.AUContext.instance auctx in let len = Univ.LMap.cardinal subst in - let subst = - Array.fold_left_i - (fun i acc v -> Univ.LMap.add (Level.var i) (Level.var (i + len)) acc) - subst (Univ.Instance.to_array inst) + let rec gen_subst i acc = + if i < 0 then acc + else + let acc = Univ.LMap.add (Level.var i) (Level.var (i + len)) acc in + gen_subst (pred i) acc in + let subst = gen_subst (Univ.AUContext.size auctx - 1) subst in let auctx' = Univ.subst_univs_level_abstract_universe_context subst auctx in subst, (Polymorphic_const auctx') @@ -214,17 +214,7 @@ let cook_constant ~hcons env { from = cb; info } = List.filter (fun decl' -> not (Id.equal (NamedDecl.get_id decl) (NamedDecl.get_id decl'))) hyps) hyps ~init:cb.const_hyps in - let typ = match cb.const_type with - | RegularArity t -> - let typ = - abstract_constant_type (expmod t) hyps in - RegularArity typ - | TemplateArity (ctx,s) -> - let t = mkArity (ctx,Type s.template_level) in - let typ = abstract_constant_type (expmod t) hyps in - let j = make_judge (constr_of_def (opaque_tables env) body) typ in - Typeops.make_polymorphic_if_constant_for_ind env j - in + let typ = abstract_constant_type (expmod cb.const_type) hyps in let projection pb = let c' = abstract_constant_body (expmod pb.proj_body) hyps in let etab = abstract_constant_body (expmod (fst pb.proj_eta)) hyps in @@ -238,9 +228,6 @@ let cook_constant ~hcons env { from = cb; info } = | _ -> assert false with Not_found -> (((pb.proj_ind,0),Univ.Instance.empty), 0) in - let typ = (* By invariant, a regular arity *) - match typ with RegularArity t -> t | TemplateArity _ -> assert false - in let ctx, ty' = decompose_prod_n (n' + pb.proj_npars + 1) typ in { proj_ind = mind; proj_npars = pb.proj_npars + n'; proj_arg = pb.proj_arg; proj_eta = etab, etat; @@ -249,13 +236,18 @@ let cook_constant ~hcons env { from = cb; info } = let univs = match univs with | Monomorphic_const ctx -> - Monomorphic_const (UContext.union (instantiate_univ_context abs_ctx) ctx) + assert (AUContext.is_empty abs_ctx); univs | Polymorphic_const auctx -> Polymorphic_const (AUContext.union abs_ctx auctx) in - (body, typ, Option.map projection cb.const_proj, - univs, cb.const_inline_code, - Some const_hyps) + { + cook_body = body; + cook_type = typ; + cook_proj = Option.map projection cb.const_proj; + cook_universes = univs; + cook_inline = cb.const_inline_code; + cook_context = Some const_hyps; + } (* let cook_constant_key = Profile.declare_profile "cook_constant" *) (* let cook_constant = Profile.profile2 cook_constant_key cook_constant *) diff --git a/kernel/cooking.mli b/kernel/cooking.mli index 9db85a4a11..6d1b776c05 100644 --- a/kernel/cooking.mli +++ b/kernel/cooking.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,9 +16,14 @@ type recipe = { from : constant_body; info : Opaqueproof.cooking_info } type inline = bool -type result = - constant_def * constant_type * projection_body option * - constant_universes * inline * Context.Named.t option +type result = { + cook_body : constant_def; + cook_type : types; + cook_proj : projection_body option; + cook_universes : constant_universes; + cook_inline : inline; + cook_context : Context.Named.t option; +} val cook_constant : hcons:bool -> env -> recipe -> result val cook_constr : Opaqueproof.cooking_info -> Term.constr -> Term.constr diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml index 40595f944c..d21ea9670f 100644 --- a/kernel/csymtable.ml +++ b/kernel/csymtable.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/csymtable.mli b/kernel/csymtable.mli index cd561148bf..633cf0abdd 100644 --- a/kernel/csymtable.mli +++ b/kernel/csymtable.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/declarations.ml b/kernel/declarations.ml index 21651b3e21..9697b0b8b2 100644 --- a/kernel/declarations.ml +++ b/kernel/declarations.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -36,8 +36,6 @@ type ('a, 'b) declaration_arity = | RegularArity of 'a | TemplateArity of 'b -type constant_type = (types, Context.Rel.t * template_arity) declaration_arity - (** Inlining level of parameters at functor applications. None means no inlining *) @@ -83,7 +81,7 @@ type typing_flags = { type constant_body = { const_hyps : Context.Named.t; (** New: younger hyp at top *) const_body : constant_def; - const_type : constant_type; + const_type : types; const_body_code : Cemitcodes.to_patch_substituted option; const_universes : constant_universes; const_proj : projection_body option; diff --git a/kernel/declareops.ml b/kernel/declareops.ml index 72b4907680..85dd1e66db 100644 --- a/kernel/declareops.ml +++ b/kernel/declareops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -44,78 +44,19 @@ let hcons_template_arity ar = (** {6 Constants } *) -let instantiate cb c = - match cb.const_universes with - | Monomorphic_const _ -> c - | Polymorphic_const ctx -> - Vars.subst_instance_constr (Univ.AUContext.instance ctx) c - let constant_is_polymorphic cb = match cb.const_universes with | Monomorphic_const _ -> false | Polymorphic_const _ -> true -let body_of_constant otab cb = match cb.const_body with - | Undef _ -> None - | Def c -> Some (instantiate cb (force_constr c)) - | OpaqueDef o -> Some (instantiate cb (Opaqueproof.force_proof otab o)) - -let type_of_constant cb = - match cb.const_type with - | RegularArity t as x -> - let t' = instantiate cb t in - if t' == t then x else RegularArity t' - | TemplateArity _ as x -> x - -let constraints_of_constant otab cb = - match cb.const_universes with - | Polymorphic_const ctx -> - Univ.UContext.constraints (Univ.instantiate_univ_context ctx) - | Monomorphic_const ctx -> - Univ.Constraint.union - (Univ.UContext.constraints ctx) - (match cb.const_body with - | Undef _ -> Univ.empty_constraint - | Def c -> Univ.empty_constraint - | OpaqueDef o -> - Univ.ContextSet.constraints (Opaqueproof.force_constraints otab o)) - -let universes_of_constant otab cb = - match cb.const_body with - | Undef _ | Def _ -> - begin - match cb.const_universes with - | Monomorphic_const ctx -> ctx - | Polymorphic_const ctx -> Univ.instantiate_univ_context ctx - end - | OpaqueDef o -> - let body_uctxs = Opaqueproof.force_constraints otab o in - match cb.const_universes with - | Monomorphic_const ctx -> - let uctxs = Univ.ContextSet.of_context ctx in - Univ.ContextSet.to_context (Univ.ContextSet.union body_uctxs uctxs) - | Polymorphic_const ctx -> - assert(Univ.ContextSet.is_empty body_uctxs); - Univ.instantiate_univ_context ctx - -let universes_of_polymorphic_constant otab cb = - match cb.const_universes with - | Monomorphic_const _ -> Univ.UContext.empty - | Polymorphic_const ctx -> Univ.instantiate_univ_context ctx - let constant_has_body cb = match cb.const_body with | Undef _ -> false | Def _ | OpaqueDef _ -> true -let constant_polymorphic_instance cb = - match cb.const_universes with - | Monomorphic_const _ -> Univ.Instance.empty - | Polymorphic_const ctx -> Univ.AUContext.instance ctx - let constant_polymorphic_context cb = match cb.const_universes with - | Monomorphic_const _ -> Univ.UContext.empty - | Polymorphic_const ctx -> Univ.instantiate_univ_context ctx + | Monomorphic_const _ -> Univ.AUContext.empty + | Polymorphic_const ctx -> ctx let is_opaque cb = match cb.const_body with | OpaqueDef _ -> true @@ -128,10 +69,6 @@ let subst_rel_declaration sub = let subst_rel_context sub = List.smartmap (subst_rel_declaration sub) -let subst_template_cst_arity sub (ctx,s as arity) = - let ctx' = subst_rel_context sub ctx in - if ctx==ctx' then arity else (ctx',s) - let subst_const_type sub arity = if is_empty_subst sub then arity else subst_mps sub arity @@ -153,7 +90,7 @@ let subst_const_body sub cb = if is_empty_subst sub then cb else let body' = subst_const_def sub cb.const_body in - let type' = subst_decl_arity subst_const_type subst_template_cst_arity sub cb.const_type in + let type' = subst_const_type sub cb.const_type in let proj' = Option.smartmap (subst_const_proj sub) cb.const_proj in if body' == cb.const_body && type' == cb.const_type && proj' == cb.const_proj then cb @@ -179,14 +116,6 @@ let hcons_rel_decl = let hcons_rel_context l = List.smartmap hcons_rel_decl l -let hcons_regular_const_arity t = Term.hcons_constr t - -let hcons_template_const_arity (ctx, ar) = - (hcons_rel_context ctx, hcons_template_arity ar) - -let hcons_const_type = - map_decl_arity hcons_regular_const_arity hcons_template_const_arity - let hcons_const_def = function | Undef inl -> Undef inl | Def l_constr -> @@ -204,7 +133,7 @@ let hcons_const_universes cbu = let hcons_const_body cb = { cb with const_body = hcons_const_def cb.const_body; - const_type = hcons_const_type cb.const_type; + const_type = Term.hcons_constr cb.const_type; const_universes = hcons_const_universes cb.const_universes } (** {6 Inductive types } *) @@ -299,19 +228,11 @@ let subst_mind_body sub mib = mind_typing_flags = mib.mind_typing_flags; } -let inductive_polymorphic_instance mib = - match mib.mind_universes with - | Monomorphic_ind _ -> Univ.Instance.empty - | Polymorphic_ind ctx -> Univ.AUContext.instance ctx - | Cumulative_ind cumi -> - Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi) - let inductive_polymorphic_context mib = match mib.mind_universes with - | Monomorphic_ind _ -> Univ.UContext.empty - | Polymorphic_ind ctx -> Univ.instantiate_univ_context ctx - | Cumulative_ind cumi -> - Univ.instantiate_univ_context (Univ.ACumulativityInfo.univ_context cumi) + | Monomorphic_ind _ -> Univ.AUContext.empty + | Polymorphic_ind ctx -> ctx + | Cumulative_ind cumi -> Univ.ACumulativityInfo.univ_context cumi let inductive_is_polymorphic mib = match mib.mind_universes with diff --git a/kernel/declareops.mli b/kernel/declareops.mli index 811a28aa65..a8ba5fa392 100644 --- a/kernel/declareops.mli +++ b/kernel/declareops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -27,29 +27,14 @@ val subst_const_body : substitution -> constant_body -> constant_body val constant_has_body : constant_body -> bool -val constant_polymorphic_instance : constant_body -> universe_instance -val constant_polymorphic_context : constant_body -> universe_context +val constant_polymorphic_context : constant_body -> abstract_universe_context (** Is the constant polymorphic? *) val constant_is_polymorphic : constant_body -> bool -(** Accessing const_body, forcing access to opaque proof term if needed. - Only use this function if you know what you're doing. *) - -val body_of_constant : - Opaqueproof.opaquetab -> constant_body -> Term.constr option -val type_of_constant : constant_body -> constant_type -val constraints_of_constant : - Opaqueproof.opaquetab -> constant_body -> Univ.constraints -val universes_of_constant : - Opaqueproof.opaquetab -> constant_body -> Univ.universe_context - (** Return the universe context, in case the definition is polymorphic, otherwise the context is empty. *) -val universes_of_polymorphic_constant : - Opaqueproof.opaquetab -> constant_body -> Univ.universe_context - val is_opaque : constant_body -> bool (** Side effects *) @@ -72,8 +57,7 @@ val subst_wf_paths : substitution -> wf_paths -> wf_paths val subst_mind_body : substitution -> mutual_inductive_body -> mutual_inductive_body -val inductive_polymorphic_instance : mutual_inductive_body -> universe_instance -val inductive_polymorphic_context : mutual_inductive_body -> universe_context +val inductive_polymorphic_context : mutual_inductive_body -> abstract_universe_context (** Is the inductive polymorphic? *) val inductive_is_polymorphic : mutual_inductive_body -> bool diff --git a/kernel/entries.mli b/kernel/entries.ml index f133587c16..a1ccbdbc1b 100644 --- a/kernel/entries.mli +++ b/kernel/entries.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -64,6 +64,10 @@ type mutual_inductive_entry = { type 'a proof_output = constr Univ.in_universe_context_set * 'a type 'a const_entry_body = 'a proof_output Future.computation +type constant_universes_entry = + | Monomorphic_const_entry of Univ.universe_context + | Polymorphic_const_entry of Univ.universe_context + type 'a definition_entry = { const_entry_body : 'a const_entry_body; (* List of section variables *) @@ -71,8 +75,7 @@ type 'a definition_entry = { (* State id on which the completion of type checking is reported *) const_entry_feedback : Stateid.t option; const_entry_type : types option; - const_entry_polymorphic : bool; - const_entry_universes : Univ.universe_context; + const_entry_universes : constant_universes_entry; const_entry_opaque : bool; const_entry_inline_code : bool } diff --git a/kernel/environ.ml b/kernel/environ.ml index 1ab5b7a8d1..d2c737ab0c 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -230,14 +230,7 @@ let add_constant kn cb env = let constraints_of cb u = match cb.const_universes with | Monomorphic_const _ -> Univ.Constraint.empty - | Polymorphic_const ctx -> - Univ.UContext.constraints (Univ.subst_instance_context u ctx) - -let map_regular_arity f = function - | RegularArity a as ar -> - let a' = f a in - if a' == a then ar else RegularArity a' - | TemplateArity _ -> assert false + | Polymorphic_const ctx -> Univ.AUContext.instantiate u ctx (* constant_type gives the type of a constant *) let constant_type env (kn,u) = @@ -246,19 +239,13 @@ let constant_type env (kn,u) = | Monomorphic_const _ -> cb.const_type, Univ.Constraint.empty | Polymorphic_const ctx -> let csts = constraints_of cb u in - (map_regular_arity (subst_instance_constr u) cb.const_type, csts) - -let constant_instance env kn = - let cb = lookup_constant kn env in - match cb.const_universes with - | Monomorphic_const _ -> Univ.Instance.empty - | Polymorphic_const ctx -> Univ.AUContext.instance ctx + (subst_instance_constr u cb.const_type, csts) let constant_context env kn = let cb = lookup_constant kn env in match cb.const_universes with - | Monomorphic_const _ -> Univ.UContext.empty - | Polymorphic_const ctx -> Univ.instantiate_univ_context ctx + | Monomorphic_const _ -> Univ.AUContext.empty + | Polymorphic_const ctx -> ctx type const_evaluation_result = NoBody | Opaque | IsProj @@ -294,7 +281,7 @@ let constant_value_and_type env (kn, u) = | OpaqueDef _ -> None | Undef _ -> None in - b', map_regular_arity (subst_instance_constr u) cb.const_type, cst + b', subst_instance_constr u cb.const_type, cst else let b' = match cb.const_body with | Def l_body -> Some (Mod_subst.force_constr l_body) @@ -310,7 +297,7 @@ let constant_value_and_type env (kn, u) = let constant_type_in env (kn,u) = let cb = lookup_constant kn env in if Declareops.constant_is_polymorphic cb then - map_regular_arity (subst_instance_constr u) cb.const_type + subst_instance_constr u cb.const_type else cb.const_type let constant_value_in env (kn,u) = @@ -344,15 +331,6 @@ let polymorphic_pconstant (cst,u) env = let type_in_type_constant cst env = not (lookup_constant cst env).const_typing_flags.check_universes -let template_polymorphic_constant cst env = - match (lookup_constant cst env).const_type with - | TemplateArity _ -> true - | RegularArity _ -> false - -let template_polymorphic_pconstant (cst,u) env = - if not (Univ.Instance.is_empty u) then false - else template_polymorphic_constant cst env - let lookup_projection cst env = match (lookup_constant (Projection.constant cst) env).const_proj with | Some pb -> pb diff --git a/kernel/environ.mli b/kernel/environ.mli index ae3afcb355..377c61de2c 100644 --- a/kernel/environ.mli +++ b/kernel/environ.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -139,10 +139,6 @@ val polymorphic_constant : constant -> env -> bool val polymorphic_pconstant : pconstant -> env -> bool val type_in_type_constant : constant -> env -> bool -(** Old-style polymorphism *) -val template_polymorphic_constant : constant -> env -> bool -val template_polymorphic_pconstant : pconstant -> env -> bool - (** {6 ... } *) (** [constant_value env c] raises [NotEvaluableConst Opaque] if [c] is opaque and [NotEvaluableConst NoBody] if it has no @@ -153,23 +149,20 @@ type const_evaluation_result = NoBody | Opaque | IsProj exception NotEvaluableConst of const_evaluation_result val constant_value : env -> constant puniverses -> constr constrained -val constant_type : env -> constant puniverses -> constant_type constrained +val constant_type : env -> constant puniverses -> types constrained val constant_opt_value : env -> constant puniverses -> (constr * Univ.constraints) option val constant_value_and_type : env -> constant puniverses -> - constr option * constant_type * Univ.constraints + constr option * types * Univ.constraints (** The universe context associated to the constant, empty if not polymorphic *) -val constant_context : env -> constant -> Univ.universe_context -(** The universe isntance associated to the constant, empty if not - polymorphic *) -val constant_instance : env -> constant -> Univ.universe_instance +val constant_context : env -> constant -> Univ.abstract_universe_context (* These functions should be called under the invariant that [env] already contains the constraints corresponding to the constant application. *) val constant_value_in : env -> constant puniverses -> constr -val constant_type_in : env -> constant puniverses -> constant_type +val constant_type_in : env -> constant puniverses -> types val constant_opt_value_in : env -> constant puniverses -> constr option (** {6 Primitive projections} *) diff --git a/kernel/esubst.ml b/kernel/esubst.ml index 1dc389c649..ac2b3f9d59 100644 --- a/kernel/esubst.ml +++ b/kernel/esubst.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/esubst.mli b/kernel/esubst.mli index 533d1c68c3..95a2e71c2c 100644 --- a/kernel/esubst.mli +++ b/kernel/esubst.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/evar.ml b/kernel/evar.ml index b972fc1147..e63665f519 100644 --- a/kernel/evar.ml +++ b/kernel/evar.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/evar.mli b/kernel/evar.mli index f28a13640f..eee6680fb8 100644 --- a/kernel/evar.mli +++ b/kernel/evar.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml index 00fbe27a70..e248436ec4 100644 --- a/kernel/indtypes.ml +++ b/kernel/indtypes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -961,13 +961,10 @@ let build_inductive env prv iu env_ar paramsctxt kn isrecord isfinite inds nmr r && pkt.mind_consnrealargs.(0) > 0 -> (** The elimination criterion ensures that all projections can be defined. *) let u = - let process auctx = - subst_univs_level_instance substunivs (Univ.AUContext.instance auctx) - in match aiu with | Monomorphic_ind _ -> Univ.Instance.empty - | Polymorphic_ind auctx -> process auctx - | Cumulative_ind acumi -> process (Univ.ACumulativityInfo.univ_context acumi) + | Polymorphic_ind auctx -> Univ.make_abstract_instance auctx + | Cumulative_ind acumi -> Univ.make_abstract_instance (Univ.ACumulativityInfo.univ_context acumi) in let indsp = ((kn, 0), u) in let rctx, indty = decompose_prod_assum (subst1 (mkIndU indsp) pkt.mind_nf_lc.(0)) in diff --git a/kernel/indtypes.mli b/kernel/indtypes.mli index 5b4615399d..e4b7c086af 100644 --- a/kernel/indtypes.mli +++ b/kernel/indtypes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/inductive.ml b/kernel/inductive.ml index e81a1cb587..1eaba49aa9 100644 --- a/kernel/inductive.ml +++ b/kernel/inductive.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -54,9 +54,7 @@ let inductive_paramdecls (mib,u) = Vars.subst_instance_context u mib.mind_params_ctxt let instantiate_inductive_constraints mib u = - let process auctx = - Univ.UContext.constraints (Univ.subst_instance_context u auctx) - in + let process auctx = Univ.AUContext.instantiate u auctx in match mib.mind_universes with | Monomorphic_ind _ -> Univ.Constraint.empty | Polymorphic_ind auctx -> process auctx diff --git a/kernel/inductive.mli b/kernel/inductive.mli index 521ee3c7b7..0dfa8db00e 100644 --- a/kernel/inductive.mli +++ b/kernel/inductive.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/kernel.mllib b/kernel/kernel.mllib index 0813315b5b..9946348541 100644 --- a/kernel/kernel.mllib +++ b/kernel/kernel.mllib @@ -13,9 +13,11 @@ Mod_subst Cbytecodes Copcodes Cemitcodes +Opaqueproof +Declarations +Entries Nativevalues Primitives -Opaqueproof Declareops Retroknowledge Conv_oracle @@ -41,5 +43,4 @@ Nativelibrary Safe_typing Vm Csymtable -Declarations Vconv diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml index 95990bea6a..7b660939b5 100644 --- a/kernel/mod_subst.ml +++ b/kernel/mod_subst.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/mod_subst.mli b/kernel/mod_subst.mli index 6d86b94167..f1d0e42796 100644 --- a/kernel/mod_subst.mli +++ b/kernel/mod_subst.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -107,9 +107,9 @@ val subst_substituted : substitution -> 'a substituted -> 'a substituted (**/**) (* debugging *) val debug_string_of_subst : substitution -> string -val debug_pr_subst : substitution -> Pp.std_ppcmds +val debug_pr_subst : substitution -> Pp.t val debug_string_of_delta : delta_resolver -> string -val debug_pr_delta : delta_resolver -> Pp.std_ppcmds +val debug_pr_delta : delta_resolver -> Pp.t (**/**) (** [subst_mp sub mp] guarantees that whenever the result of the diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml index 79016735bc..0888ccc109 100644 --- a/kernel/mod_typing.ml +++ b/kernel/mod_typing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -72,21 +72,18 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv = (* In the spirit of subtyping.check_constant, we accept any implementations of parameters and opaques terms, as long as they have the right type *) - let uctx = Declareops.universes_of_constant (opaque_tables env) cb in - let uctx = (* Context of the spec *) + let c', univs, ctx' = match cb.const_universes with - | Monomorphic_const _ -> uctx - | Polymorphic_const auctx -> - Univ.instantiate_univ_context auctx - in - let c', univs, ctx' = - if not (Declareops.constant_is_polymorphic cb) then - let env' = Environ.push_context ~strict:true uctx env' in + | Monomorphic_const _ -> + (** We do not add the deferred constraints of the body in the + environment, because they do not appear in the type of the + definition. Any inconsistency will be raised at a later stage + when joining the environment. *) let env' = Environ.push_context ~strict:true ctx env' in let c',cst = match cb.const_body with | Undef _ | OpaqueDef _ -> let j = Typeops.infer env' c in - let typ = Typeops.type_of_constant_type env' cb.const_type in + let typ = cb.const_type in let cst' = Reduction.infer_conv_leq env' (Environ.universes env') j.uj_type typ in j.uj_val, cst' @@ -94,37 +91,30 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv = let c' = Mod_subst.force_constr cs in c, Reduction.infer_conv env' (Environ.universes env') c c' in c', Monomorphic_const ctx, Univ.ContextSet.add_constraints cst (Univ.ContextSet.of_context ctx) - else - let cus, ccst = Univ.UContext.dest uctx in - let newus, cst = Univ.UContext.dest ctx in - let () = - if not (Univ.Instance.length cus == Univ.Instance.length newus) then - error_incorrect_with_constraint lab - in - let inst = Univ.Instance.append cus newus in - let csti = Univ.enforce_eq_instances cus newus cst in - let csta = Univ.Constraint.union csti ccst in - let env' = Environ.push_context ~strict:false (Univ.UContext.make (inst, csta)) env in - let () = if not (UGraph.check_constraints cst (Environ.universes env')) then - error_incorrect_with_constraint lab - in + | Polymorphic_const uctx -> + let subst, ctx = Univ.abstract_universes ctx in + let c = Vars.subst_univs_level_constr subst c in + let () = + if not (UGraph.check_subtype (Environ.universes env) uctx ctx) then + error_incorrect_with_constraint lab + in + (** Terms are compared in a context with De Bruijn universe indices *) + let env' = Environ.push_context ~strict:false (Univ.AUContext.repr uctx) env in let cst = match cb.const_body with | Undef _ | OpaqueDef _ -> let j = Typeops.infer env' c in - let typ = Typeops.type_of_constant_type env' cb.const_type in - let typ = Vars.subst_instance_constr cus typ in + let typ = cb.const_type in let cst' = Reduction.infer_conv_leq env' (Environ.universes env') j.uj_type typ in cst' | Def cs -> - let c' = Vars.subst_instance_constr cus (Mod_subst.force_constr cs) in + let c' = Mod_subst.force_constr cs in let cst' = Reduction.infer_conv env' (Environ.universes env') c c' in cst' in if not (Univ.Constraint.is_empty cst) then error_incorrect_with_constraint lab; - let subst, ctx = Univ.abstract_universes ctx in - Vars.subst_univs_level_constr subst c, Polymorphic_const ctx, Univ.ContextSet.empty + c, Polymorphic_const ctx, Univ.ContextSet.empty in let def = Def (Mod_subst.from_val c') in (* let ctx' = Univ.UContext.make (newus, cst) in *) diff --git a/kernel/mod_typing.mli b/kernel/mod_typing.mli index 5949dad08c..dcabb13346 100644 --- a/kernel/mod_typing.mli +++ b/kernel/mod_typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/modops.ml b/kernel/modops.ml index 33d13f1ba0..a079bc8931 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -49,7 +49,7 @@ type signature_mismatch_error = | IncompatibleInstances | IncompatibleUniverses of Univ.univ_inconsistency | IncompatiblePolymorphism of env * types * types - | IncompatibleConstraints of Univ.constraints + | IncompatibleConstraints of Univ.AUContext.t type module_typing_error = | SignatureMismatch of diff --git a/kernel/modops.mli b/kernel/modops.mli index 4b533c7efd..e2a94b6919 100644 --- a/kernel/modops.mli +++ b/kernel/modops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -108,7 +108,7 @@ type signature_mismatch_error = | IncompatibleInstances | IncompatibleUniverses of Univ.univ_inconsistency | IncompatiblePolymorphism of env * types * types - | IncompatibleConstraints of Univ.constraints + | IncompatibleConstraints of Univ.AUContext.t type module_typing_error = | SignatureMismatch of diff --git a/kernel/names.ml b/kernel/names.ml index d7c0a5e980..e524f4258d 100644 --- a/kernel/names.ml +++ b/kernel/names.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/names.mli b/kernel/names.mli index 004d52d4b3..d111dd3c06 100644 --- a/kernel/names.mli +++ b/kernel/names.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,7 +57,7 @@ sig val to_string : t -> string (** Converts a identifier into an string. *) - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t (** Pretty-printer. *) module Set : Set.S with type elt = t @@ -105,7 +105,7 @@ sig val hcons : t -> t (** Hashconsing over names. *) - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t (** Pretty-printer (print "_" for [Anonymous]. *) end @@ -187,7 +187,7 @@ sig val to_id : t -> Id.t (** Conversion to an identifier. *) - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t (** Pretty-printer. *) module Set : Set.S with type elt = t @@ -286,7 +286,7 @@ sig val debug_to_string : t -> string (** Same as [to_string], but outputs information related to debug. *) - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t (** Comparisons *) val compare : t -> t -> int @@ -365,9 +365,9 @@ sig (** Displaying *) val to_string : t -> string - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t val debug_to_string : t -> string - val debug_print : t -> Pp.std_ppcmds + val debug_print : t -> Pp.t end @@ -447,9 +447,9 @@ sig (** Displaying *) val to_string : t -> string - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t val debug_to_string : t -> string - val debug_print : t -> Pp.std_ppcmds + val debug_print : t -> Pp.t end @@ -609,7 +609,7 @@ val mk_label : string -> label val string_of_label : label -> string (** @deprecated Same as [Label.to_string]. *) -val pr_label : label -> Pp.std_ppcmds +val pr_label : label -> Pp.t (** @deprecated Same as [Label.print]. *) val label_of_id : Id.t -> label @@ -695,7 +695,7 @@ val label : kernel_name -> Label.t val string_of_kn : kernel_name -> string (** @deprecated Same as [KerName.to_string]. *) -val pr_kn : kernel_name -> Pp.std_ppcmds +val pr_kn : kernel_name -> Pp.t (** @deprecated Same as [KerName.print]. *) val kn_ord : kernel_name -> kernel_name -> int @@ -731,7 +731,7 @@ module Projection : sig val map : (constant -> constant) -> t -> t val to_string : t -> string - val print : t -> Pp.std_ppcmds + val print : t -> Pp.t end @@ -776,10 +776,10 @@ val con_with_label : constant -> Label.t -> constant val string_of_con : constant -> string (** @deprecated Same as [Constant.to_string] *) -val pr_con : constant -> Pp.std_ppcmds +val pr_con : constant -> Pp.t (** @deprecated Same as [Constant.print] *) -val debug_pr_con : constant -> Pp.std_ppcmds +val debug_pr_con : constant -> Pp.t (** @deprecated Same as [Constant.debug_print] *) val debug_string_of_con : constant -> string @@ -826,10 +826,10 @@ val mind_modpath : mutual_inductive -> ModPath.t val string_of_mind : mutual_inductive -> string (** @deprecated Same as [MutInd.to_string] *) -val pr_mind : mutual_inductive -> Pp.std_ppcmds +val pr_mind : mutual_inductive -> Pp.t (** @deprecated Same as [MutInd.print] *) -val debug_pr_mind : mutual_inductive -> Pp.std_ppcmds +val debug_pr_mind : mutual_inductive -> Pp.t (** @deprecated Same as [MutInd.debug_print] *) val debug_string_of_mind : mutual_inductive -> string diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml index 4941d64d82..da7fcd6f23 100644 --- a/kernel/nativecode.ml +++ b/kernel/nativecode.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -48,9 +48,9 @@ let fresh_lname n = (** Global names **) type gname = - | Gind of string * pinductive (* prefix, inductive name *) - | Gconstruct of string * pconstructor (* prefix, constructor name *) - | Gconstant of string * pconstant (* prefix, constant name *) + | Gind of string * inductive (* prefix, inductive name *) + | Gconstruct of string * constructor (* prefix, constructor name *) + | Gconstant of string * constant (* prefix, constant name *) | Gproj of string * constant (* prefix, constant name *) | Gcase of label option * int | Gpred of label option * int @@ -64,11 +64,11 @@ type gname = let eq_gname gn1 gn2 = match gn1, gn2 with | Gind (s1, ind1), Gind (s2, ind2) -> - String.equal s1 s2 && Univ.eq_puniverses eq_ind ind1 ind2 + String.equal s1 s2 && eq_ind ind1 ind2 | Gconstruct (s1, c1), Gconstruct (s2, c2) -> - String.equal s1 s2 && Univ.eq_puniverses eq_constructor c1 c2 + String.equal s1 s2 && eq_constructor c1 c2 | Gconstant (s1, c1), Gconstant (s2, c2) -> - String.equal s1 s2 && Univ.eq_puniverses Constant.equal c1 c2 + String.equal s1 s2 && Constant.equal c1 c2 | Gcase (None, i1), Gcase (None, i2) -> Int.equal i1 i2 | Gcase (Some l1, i1), Gcase (Some l2, i2) -> Int.equal i1 i2 && Label.equal l1 l2 | Gpred (None, i1), Gpred (None, i2) -> Int.equal i1 i2 @@ -92,12 +92,12 @@ let dummy_gname = open Hashset.Combine let gname_hash gn = match gn with -| Gind (s, (ind,u)) -> - combinesmall 1 (combine3 (String.hash s) (ind_hash ind) (Univ.Instance.hash u)) -| Gconstruct (s, (c,u)) -> - combinesmall 2 (combine3 (String.hash s) (constructor_hash c) (Univ.Instance.hash u)) -| Gconstant (s, (c,u)) -> - combinesmall 3 (combine3 (String.hash s) (Constant.hash c) (Univ.Instance.hash u)) +| Gind (s, ind) -> + combinesmall 1 (combine (String.hash s) (ind_hash ind)) +| Gconstruct (s, c) -> + combinesmall 2 (combine (String.hash s) (constructor_hash c)) +| Gconstant (s, c) -> + combinesmall 3 (combine (String.hash s) (Constant.hash c)) | Gcase (l, i) -> combinesmall 4 (combine (Option.hash Label.hash l) (Int.hash i)) | Gpred (l, i) -> combinesmall 5 (combine (Option.hash Label.hash l) (Int.hash i)) | Gfixtype (l, i) -> combinesmall 6 (combine (Option.hash Label.hash l) (Int.hash i)) @@ -1068,9 +1068,9 @@ let ml_of_instance instance u = MLlet(lname,def,body) | Lapp(f,args) -> MLapp(ml_of_lam env l f, Array.map (ml_of_lam env l) args) - | Lconst (prefix,c) -> - let args = ml_of_instance env.env_univ (snd c) in - mkMLapp (MLglobal(Gconstant (prefix,c))) args + | Lconst (prefix, (c, u)) -> + let args = ml_of_instance env.env_univ u in + mkMLapp (MLglobal(Gconstant (prefix, c))) args | Lproj (prefix,c) -> MLglobal(Gproj (prefix,c)) | Lprim _ -> let decl,cond,paux = extract_prim (ml_of_lam env l) t in @@ -1281,17 +1281,17 @@ let ml_of_instance instance u = MLconstruct(prefix,cn,args) | Lconstruct (prefix, (cn,u)) -> let uargs = ml_of_instance env.env_univ u in - mkMLapp (MLglobal (Gconstruct (prefix, (cn,u)))) uargs + mkMLapp (MLglobal (Gconstruct (prefix, cn))) uargs | Luint v -> (match v with | UintVal i -> MLapp(MLprimitive Mk_uint, [|MLuint i|]) | UintDigits (prefix,cn,ds) -> - let c = MLglobal (Gconstruct (prefix, (cn, Univ.Instance.empty))) in + let c = MLglobal (Gconstruct (prefix, cn)) in let ds = Array.map (ml_of_lam env l) ds in let i31 = MLapp (MLprimitive Mk_I31_accu, [|c|]) in MLapp(i31, ds) | UintDecomp (prefix,cn,t) -> - let c = MLglobal (Gconstruct (prefix, (cn, Univ.Instance.empty))) in + let c = MLglobal (Gconstruct (prefix, cn)) in let t = ml_of_lam env l t in MLapp (MLprimitive Decomp_uint, [|c;t|])) | Lval v -> @@ -1304,9 +1304,9 @@ let ml_of_instance instance u = in let uarg = MLapp(MLprimitive MLmagic, [|uarg|]) in MLapp(MLprimitive Mk_sort, [|get_sort_code i; uarg|]) - | Lind (prefix, pind) -> - let uargs = ml_of_instance env.env_univ (snd pind) in - mkMLapp (MLglobal (Gind (prefix, pind))) uargs + | Lind (prefix, (ind, u)) -> + let uargs = ml_of_instance env.env_univ u in + mkMLapp (MLglobal (Gind (prefix, ind))) uargs | Llazy -> MLglobal (Ginternal "lazy") | Lforce -> MLglobal (Ginternal "Lazy.force") @@ -1539,11 +1539,11 @@ let string_of_mind mind = string_of_kn (user_mind mind) let string_of_gname g = match g with - | Gind (prefix, ((mind,i), _)) -> + | Gind (prefix, (mind, i)) -> Format.sprintf "%sindaccu_%s_%i" prefix (string_of_mind mind) i - | Gconstruct (prefix, (((mind, i), j), _)) -> + | Gconstruct (prefix, ((mind, i), j)) -> Format.sprintf "%sconstruct_%s_%i_%i" prefix (string_of_mind mind) i (j-1) - | Gconstant (prefix, (c,_)) -> + | Gconstant (prefix, c) -> Format.sprintf "%sconst_%s" prefix (string_of_con c) | Gproj (prefix, c) -> Format.sprintf "%sproj_%s" prefix (string_of_con c) @@ -1754,9 +1754,8 @@ let pp_mllam fmt l = | Coq_primitive (op,None) -> Format.fprintf fmt "no_check_%s" (Primitives.to_string op) | Coq_primitive (op, Some (prefix,kn)) -> - let u = Univ.Instance.empty in Format.fprintf fmt "%s %a" (Primitives.to_string op) - pp_mllam (MLglobal (Gconstant (prefix,(kn,u)))) + pp_mllam (MLglobal (Gconstant (prefix, kn))) in Format.fprintf fmt "@[%a@]" pp_mllam l @@ -1862,10 +1861,10 @@ and compile_named env sigma univ auxdefs id = let compile_constant env sigma prefix ~interactive con cb = match cb.const_proj with | None -> - let u = + let no_univs = match cb.const_universes with - | Monomorphic_const _ -> Univ.Instance.empty - | Polymorphic_const ctx -> Univ.AUContext.instance ctx + | Monomorphic_const _ -> true + | Polymorphic_const ctx -> Int.equal (Univ.AUContext.size ctx) 0 in begin match cb.const_body with | Def t -> @@ -1880,7 +1879,7 @@ let compile_constant env sigma prefix ~interactive con cb = in let l = con_label con in let auxdefs,code = - if Univ.Instance.is_empty u then compile_with_fv env sigma None [] (Some l) code + if no_univs then compile_with_fv env sigma None [] (Some l) code else let univ = fresh_univ () in let (auxdefs,code) = compile_with_fv env sigma (Some univ) [] (Some l) code in @@ -1888,25 +1887,24 @@ let compile_constant env sigma prefix ~interactive con cb = in if !Flags.debug then Feedback.msg_debug (Pp.str "Generated mllambda code"); let code = - optimize_stk (Glet(Gconstant ("",(con,u)),code)::auxdefs) + optimize_stk (Glet(Gconstant ("", con),code)::auxdefs) in if !Flags.debug then Feedback.msg_debug (Pp.str "Optimized mllambda code"); code, name | _ -> let i = push_symbol (SymbConst con) in let args = - if Univ.Instance.is_empty u then [|get_const_code i; MLarray [||]|] + if no_univs then [|get_const_code i; MLarray [||]|] else [|get_const_code i|] in (* let t = mkMLlam [|univ|] (mkMLapp (MLprimitive Mk_const) *) - [Glet(Gconstant ("",(con,u)), mkMLapp (MLprimitive Mk_const) args)], + [Glet(Gconstant ("", con), mkMLapp (MLprimitive Mk_const) args)], if interactive then LinkedInteractive prefix else Linked prefix end | Some pb -> - let u = Univ.Instance.empty in let mind = pb.proj_ind in let ind = (mind,0) in let mib = lookup_mind mind env in @@ -1933,7 +1931,7 @@ let compile_constant env sigma prefix ~interactive con cb = let gn = Gproj ("",con) in let fargs = Array.init (pb.proj_npars + 1) (fun _ -> fresh_lname Anonymous) in let arg = fargs.(pb.proj_npars) in - Glet(Gconstant ("",(con,u)), mkMLlam fargs (MLapp (MLglobal gn, [|MLlocal + Glet(Gconstant ("", con), mkMLlam fargs (MLapp (MLglobal gn, [|MLlocal arg|]))):: [Glet(gn, mkMLlam [|c_uid|] code)], Linked prefix @@ -1961,14 +1959,14 @@ let param_name = Name (id_of_string "params") let arg_name = Name (id_of_string "arg") let compile_mind prefix ~interactive mb mind stack = - let u = Declareops.inductive_polymorphic_instance mb in + let u = Declareops.inductive_polymorphic_context mb in let f i stack ob = let gtype = Gtype((mind, i), Array.map snd ob.mind_reloc_tbl) in let j = push_symbol (SymbInd (mind,i)) in - let name = Gind ("", ((mind, i), u)) in + let name = Gind ("", (mind, i)) in let accu = let args = - if Univ.Instance.is_empty u then + if Int.equal (Univ.AUContext.size u) 0 then [|get_ind_code j; MLarray [||]|] else [|get_ind_code j|] in @@ -1980,7 +1978,7 @@ let compile_mind prefix ~interactive mb mind stack = let add_construct j acc (_,arity) = let args = Array.init arity (fun k -> {lname = arg_name; luid = k}) in let c = (mind,i), (j+1) in - Glet(Gconstruct ("",(c,u)), + Glet(Gconstruct ("", c), mkMLlam (Array.append params args) (MLconstruct("", c, Array.map (fun id -> MLlocal id) args)))::acc in diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli index 77d9c33f8d..ae6fb1bd6b 100644 --- a/kernel/nativecode.mli +++ b/kernel/nativecode.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml index fe9f393f63..d2f050d3bc 100644 --- a/kernel/nativeconv.ml +++ b/kernel/nativeconv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativeconv.mli b/kernel/nativeconv.mli index 63b1eb0586..fbbcce7449 100644 --- a/kernel/nativeconv.mli +++ b/kernel/nativeconv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativeinstr.mli b/kernel/nativeinstr.mli index 41e79a5355..cb79877e8b 100644 --- a/kernel/nativeinstr.mli +++ b/kernel/nativeinstr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml index 72d9c48513..508112b35d 100644 --- a/kernel/nativelambda.ml +++ b/kernel/nativelambda.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelambda.mli b/kernel/nativelambda.mli index c33574408b..bfa3bf9418 100644 --- a/kernel/nativelambda.mli +++ b/kernel/nativelambda.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml index f6c94158f8..02e02b031a 100644 --- a/kernel/nativelib.ml +++ b/kernel/nativelib.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli index 12ad3cf2f7..e8b51dc366 100644 --- a/kernel/nativelib.mli +++ b/kernel/nativelib.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml index 246b00da40..3e273dde20 100644 --- a/kernel/nativelibrary.ml +++ b/kernel/nativelibrary.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativelibrary.mli b/kernel/nativelibrary.mli index 7d01640b29..f327ba224a 100644 --- a/kernel/nativelibrary.mli +++ b/kernel/nativelibrary.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml index 7ffb48221b..7463a30feb 100644 --- a/kernel/nativevalues.ml +++ b/kernel/nativevalues.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/nativevalues.mli b/kernel/nativevalues.mli index f4396659ec..49b1e122d5 100644 --- a/kernel/nativevalues.mli +++ b/kernel/nativevalues.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/opaqueproof.ml b/kernel/opaqueproof.ml index 3e15ff7401..5e20c1b514 100644 --- a/kernel/opaqueproof.ml +++ b/kernel/opaqueproof.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/opaqueproof.mli b/kernel/opaqueproof.mli index be1f4b13f0..a0418a022f 100644 --- a/kernel/opaqueproof.mli +++ b/kernel/opaqueproof.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml index 48d7ee9ec3..7b4fb4e869 100644 --- a/kernel/pre_env.ml +++ b/kernel/pre_env.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli index 866790367d..f2a009b868 100644 --- a/kernel/pre_env.mli +++ b/kernel/pre_env.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/primitives.ml b/kernel/primitives.ml index 27732c00cb..14c11bf107 100644 --- a/kernel/primitives.ml +++ b/kernel/primitives.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/primitives.mli b/kernel/primitives.mli index 86e86a5e5a..8cdffb6702 100644 --- a/kernel/primitives.mli +++ b/kernel/primitives.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/reduction.ml b/kernel/reduction.ml index 605e9f314c..2bf9f43a5a 100644 --- a/kernel/reduction.ml +++ b/kernel/reduction.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -680,8 +680,7 @@ let infer_check_conv_constructors let check_inductive_instances cv_pb cumi u u' univs = let length_ind_instance = - Univ.Instance.length - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi)) + Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi) in let ind_subtypctx = Univ.ACumulativityInfo.subtyp_context cumi in if not ((length_ind_instance = Univ.Instance.length u) && @@ -690,16 +689,14 @@ let check_inductive_instances cv_pb cumi u u' univs = else let comp_cst = let comp_subst = (Univ.Instance.append u u') in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) + Univ.AUContext.instantiate comp_subst ind_subtypctx in let comp_cst = match cv_pb with CONV -> let comp_cst' = let comp_subst = (Univ.Instance.append u' u) in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) + Univ.AUContext.instantiate comp_subst ind_subtypctx in Univ.Constraint.union comp_cst comp_cst' | CUMUL -> comp_cst @@ -767,8 +764,7 @@ let infer_convert_instances ~flex u u' (univs,cstrs) = let infer_inductive_instances cv_pb cumi u u' (univs, cstrs) = let length_ind_instance = - Univ.Instance.length - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi)) + Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi) in let ind_subtypctx = Univ.ACumulativityInfo.subtyp_context cumi in if not ((length_ind_instance = Univ.Instance.length u) && @@ -777,16 +773,15 @@ let infer_inductive_instances cv_pb cumi u u' (univs, cstrs) = else let comp_cst = let comp_subst = (Univ.Instance.append u u') in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) + Univ.AUContext.instantiate comp_subst ind_subtypctx in let comp_cst = match cv_pb with CONV -> let comp_cst' = let comp_subst = (Univ.Instance.append u' u) in - Univ.UContext.constraints - (Univ.subst_instance_context comp_subst ind_subtypctx) in + Univ.AUContext.instantiate comp_subst ind_subtypctx + in Univ.Constraint.union comp_cst comp_cst' | CUMUL -> comp_cst in diff --git a/kernel/reduction.mli b/kernel/reduction.mli index b6d88c2b9b..253c0874f2 100644 --- a/kernel/reduction.mli +++ b/kernel/reduction.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/retroknowledge.ml b/kernel/retroknowledge.ml index ea53d00d7b..5fbd914f3f 100644 --- a/kernel/retroknowledge.ml +++ b/kernel/retroknowledge.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/retroknowledge.mli b/kernel/retroknowledge.mli index 905a05fe53..18a12a4ef1 100644 --- a/kernel/retroknowledge.mli +++ b/kernel/retroknowledge.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml index 946222ef2f..04051f2e23 100644 --- a/kernel/safe_typing.ml +++ b/kernel/safe_typing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -382,12 +382,13 @@ let safe_push_named d env = let push_named_def (id,de) senv = - let c,typ,univs = - match Term_typing.translate_local_def senv.revstruct senv.env id de with - | c, typ, Monomorphic_const ctx -> c, typ, ctx - | _, _, Polymorphic_const _ -> assert false + let open Entries in + let trust = Term_typing.SideEffects senv.revstruct in + let c,typ,univs = Term_typing.translate_local_def trust senv.env id de in + let poly = match de.Entries.const_entry_universes with + | Monomorphic_const_entry _ -> false + | Polymorphic_const_entry _ -> true in - let poly = de.Entries.const_entry_polymorphic in let univs = Univ.ContextSet.of_context univs in let c, univs = match c with | Def c -> Mod_subst.force_constr c, univs @@ -492,12 +493,16 @@ let add_field ((l,sfb) as field) gn senv = let update_resolver f senv = { senv with modresolver = f senv.modresolver } (** Insertion of constants and parameters in environment *) +type 'a effect_entry = +| EffectEntry : private_constants effect_entry +| PureEntry : unit effect_entry + type global_declaration = - | ConstantEntry of bool * private_constants Entries.constant_entry + | ConstantEntry : 'a effect_entry * 'a Entries.constant_entry -> global_declaration | GlobalRecipe of Cooking.recipe type exported_private_constant = - constant * private_constants Entries.constant_entry * private_constant_role + constant * private_constant_role let add_constant_aux no_section senv (kn, cb) = let l = pi3 (Constant.repr3 kn) in @@ -521,30 +526,29 @@ let add_constant_aux no_section senv (kn, cb) = in senv'' +let export_private_constants ~in_section ce senv = + let exported, ce = Term_typing.export_side_effects senv.revstruct senv.env ce in + let bodies = List.map (fun (kn, cb, _) -> (kn, cb)) exported in + let exported = List.map (fun (kn, _, r) -> (kn, r)) exported in + let no_section = not in_section in + let senv = List.fold_left (add_constant_aux no_section) senv bodies in + (ce, exported), senv + let add_constant dir l decl senv = let kn = make_con senv.modpath dir l in let no_section = DirPath.is_empty dir in - let seff_to_export, decl = - match decl with - | ConstantEntry (true, ce) -> - let exports, ce = - Term_typing.export_side_effects senv.revstruct senv.env ce in - exports, ConstantEntry (false, ce) - | _ -> [], decl - in - let senv = - List.fold_left (add_constant_aux no_section) senv - (List.map (fun (kn,cb,_,_) -> kn, cb) seff_to_export) in let senv = let cb = match decl with - | ConstantEntry (export_seff,ce) -> - Term_typing.translate_constant senv.revstruct senv.env kn ce + | ConstantEntry (EffectEntry, ce) -> + Term_typing.translate_constant (Term_typing.SideEffects senv.revstruct) senv.env kn ce + | ConstantEntry (PureEntry, ce) -> + Term_typing.translate_constant Term_typing.Pure senv.env kn ce | GlobalRecipe r -> let cb = Term_typing.translate_recipe senv.env kn r in if no_section then Declareops.hcons_const_body cb else cb in add_constant_aux no_section senv (kn, cb) in - (kn, List.map (fun (kn,_,ce,r) -> kn, ce, r) seff_to_export), senv + kn, senv (** Insertion of inductive types *) diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli index efeb98bd25..752fdd793e 100644 --- a/kernel/safe_typing.mli +++ b/kernel/safe_typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -67,7 +67,7 @@ val mk_pure_proof : Constr.constr -> private_constants Entries.proof_output val inline_private_constants_in_constr : Environ.env -> Constr.constr -> private_constants -> Constr.constr val inline_private_constants_in_definition_entry : - Environ.env -> private_constants Entries.definition_entry -> private_constants Entries.definition_entry + Environ.env -> private_constants Entries.definition_entry -> unit Entries.definition_entry val universes_of_private : private_constants -> Univ.universe_context_set list @@ -94,19 +94,26 @@ val push_named_def : (** Insertion of global axioms or definitions *) +type 'a effect_entry = +| EffectEntry : private_constants effect_entry +| PureEntry : unit effect_entry + type global_declaration = - (* bool: export private constants *) - | ConstantEntry of bool * private_constants Entries.constant_entry + | ConstantEntry : 'a effect_entry * 'a Entries.constant_entry -> global_declaration | GlobalRecipe of Cooking.recipe type exported_private_constant = - constant * private_constants Entries.constant_entry * private_constant_role + constant * private_constant_role + +val export_private_constants : in_section:bool -> + private_constants Entries.constant_entry -> + (unit Entries.constant_entry * exported_private_constant list) safe_transformer (** returns the main constant plus a list of auxiliary constants (empty unless one requires the side effects to be exported) *) val add_constant : DirPath.t -> Label.t -> global_declaration -> - (constant * exported_private_constant list) safe_transformer + constant safe_transformer (** Adding an inductive type *) diff --git a/kernel/sorts.ml b/kernel/sorts.ml index 62013b38f1..cf5207e8dc 100644 --- a/kernel/sorts.ml +++ b/kernel/sorts.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/sorts.mli b/kernel/sorts.mli index eb4697ad6d..3426d6fd3c 100644 --- a/kernel/sorts.mli +++ b/kernel/sorts.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 1bd9d6e495..b311165f10 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -80,10 +80,8 @@ let make_labmap mp list = List.fold_right add_one list empty_labmap -let check_conv_error error why cst poly u f env a1 a2 = +let check_conv_error error why cst poly f env a1 a2 = try - let a1 = Vars.subst_instance_constr u a1 in - let a2 = Vars.subst_instance_constr u a2 in let cst' = f env (Environ.universes env) a1 a2 in if poly then if Constraint.is_empty cst' then cst @@ -92,36 +90,42 @@ let check_conv_error error why cst poly u f env a1 a2 = with NotConvertible -> error why | Univ.UniverseInconsistency e -> error (IncompatibleUniverses e) +let check_polymorphic_instance error env auctx1 auctx2 = + if not (Univ.AUContext.size auctx1 == Univ.AUContext.size auctx2) then + error IncompatibleInstances + else if not (UGraph.check_subtype (Environ.universes env) auctx2 auctx1) then + error (IncompatibleConstraints auctx1) + else + Environ.push_context ~strict:false (Univ.AUContext.repr auctx2) env + (* for now we do not allow reorderings *) let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2= let kn1 = KerName.make2 mp1 l in let kn2 = KerName.make2 mp2 l in let error why = error_signature_mismatch l spec2 why in - let check_conv why cst poly u f = check_conv_error error why cst poly u f in + let check_conv why cst poly f = check_conv_error error why cst poly f in let mib1 = match info1 with | IndType ((_,0), mib) -> Declareops.subst_mind_body subst1 mib | _ -> error (InductiveFieldExpected mib2) in - let u = - let process inst inst' = - if Univ.Instance.equal inst inst' then inst else error IncompatibleInstances - in + let env, inst = match mib1.mind_universes, mib2.mind_universes with - | Monomorphic_ind _, Monomorphic_ind _ -> Univ.Instance.empty + | Monomorphic_ind _, Monomorphic_ind _ -> env, Univ.Instance.empty | Polymorphic_ind auctx, Polymorphic_ind auctx' -> - process - (Univ.AUContext.instance auctx) (Univ.AUContext.instance auctx') + let env = check_polymorphic_instance error env auctx auctx' in + env, Univ.make_abstract_instance auctx' | Cumulative_ind cumi, Cumulative_ind cumi' -> - process - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi)) - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi')) + let auctx = Univ.ACumulativityInfo.univ_context cumi in + let auctx' = Univ.ACumulativityInfo.univ_context cumi' in + let env = check_polymorphic_instance error env auctx auctx' in + env, Univ.make_abstract_instance auctx' | _ -> error (CumulativeStatusExpected (Declareops.inductive_is_cumulative mib2)) in let mib2 = Declareops.subst_mind_body subst2 mib2 in - let check_inductive_type cst name env t1 t2 = + let check_inductive_type cst name t1 t2 = (* Due to template polymorphism, the conclusions of t1 and t2, if in Type, are generated as the least upper bounds @@ -154,7 +158,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2 error (NotConvertibleInductiveField name) | _ -> (s1, s2) in check_conv (NotConvertibleInductiveField name) - cst (inductive_is_polymorphic mib1) u infer_conv_leq env (mkArity (ctx1,s1)) (mkArity (ctx2,s2)) + cst (inductive_is_polymorphic mib1) infer_conv_leq env (mkArity (ctx1,s1)) (mkArity (ctx2,s2)) in let check_packet cst p1 p2 = @@ -172,21 +176,20 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2 (* nparams done *) (* params_ctxt done because part of the inductive types *) (* Don't check the sort of the type if polymorphic *) - let ty1, cst1 = constrained_type_of_inductive env ((mib1,p1),u) in - let ty2, cst2 = constrained_type_of_inductive env ((mib2,p2),u) in - let cst = Constraint.union cst1 (Constraint.union cst2 cst) in - let cst = check_inductive_type cst p2.mind_typename env ty1 ty2 in + let ty1 = type_of_inductive env ((mib1, p1), inst) in + let ty2 = type_of_inductive env ((mib2, p2), inst) in + let cst = check_inductive_type cst p2.mind_typename ty1 ty2 in cst in let mind = mind_of_kn kn1 in let check_cons_types i cst p1 p2 = Array.fold_left3 (fun cst id t1 t2 -> check_conv (NotConvertibleConstructorField id) cst - (inductive_is_polymorphic mib1) u infer_conv env t1 t2) + (inductive_is_polymorphic mib1) infer_conv env t1 t2) cst p2.mind_consnames - (arities_of_specif (mind,u) (mib1,p1)) - (arities_of_specif (mind,u) (mib2,p2)) + (arities_of_specif (mind, inst) (mib1, p1)) + (arities_of_specif (mind, inst) (mib2, p2)) in let check f test why = if not (test (f mib1) (f mib2)) then error (why (f mib2)) in check (fun mib -> mib.mind_finite<>Decl_kinds.CoFinite) (==) (fun x -> FiniteInductiveFieldExpected x); @@ -242,8 +245,8 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2 let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = let error why = error_signature_mismatch l spec2 why in - let check_conv cst poly u f = check_conv_error error cst poly u f in - let check_type poly u cst env t1 t2 = + let check_conv cst poly f = check_conv_error error cst poly f in + let check_type poly cst env t1 t2 = let err = NotConvertibleTypeField (env, t1, t2) in @@ -290,7 +293,7 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = t1,t2 else (t1,t2) in - check_conv err cst poly u infer_conv_leq env t1 t2 + check_conv err cst poly infer_conv_leq env t1 t2 in match info1 with | Constant cb1 -> @@ -298,48 +301,21 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = let cb1 = Declareops.subst_const_body subst1 cb1 in let cb2 = Declareops.subst_const_body subst2 cb2 in (* Start by checking universes *) - let poly = - if not (Declareops.constant_is_polymorphic cb1 - == Declareops.constant_is_polymorphic cb2) then - error (PolymorphicStatusExpected (Declareops.constant_is_polymorphic cb2)) - else Declareops.constant_is_polymorphic cb2 - in - let cst', env', u = + let poly, env = match cb1.const_universes, cb2.const_universes with | Monomorphic_const _, Monomorphic_const _ -> - cst, env, Univ.Instance.empty + false, env | Polymorphic_const auctx1, Polymorphic_const auctx2 -> - begin - let ctx1 = Univ.instantiate_univ_context auctx1 in - let ctx2 = Univ.instantiate_univ_context auctx2 in - let inst1, ctx1 = Univ.UContext.dest ctx1 in - let inst2, ctx2 = Univ.UContext.dest ctx2 in - if not (Univ.Instance.length inst1 == Univ.Instance.length inst2) then - error IncompatibleInstances - else - let cstrs = Univ.enforce_eq_instances inst1 inst2 cst in - let cstrs = Univ.Constraint.union cstrs ctx2 in - try - (* The environment with the expected universes plus equality - of the body instances with the expected instance *) - let ctxi = Univ.Instance.append inst1 inst2 in - let ctx = Univ.UContext.make (ctxi, cstrs) in - let env = Environ.push_context ctx env in - (* Check that the given definition does not add any constraint over - the expected ones, so that it can be used in place of - the original. *) - if UGraph.check_constraints ctx1 (Environ.universes env) then - cstrs, env, inst2 - else error (IncompatibleConstraints ctx1) - with Univ.UniverseInconsistency incon -> - error (IncompatibleUniverses incon) - end - | _ -> assert false + true, check_polymorphic_instance error env auctx1 auctx2 + | Monomorphic_const _, Polymorphic_const _ -> + error (PolymorphicStatusExpected true) + | Polymorphic_const _, Monomorphic_const _ -> + error (PolymorphicStatusExpected false) in (* Now check types *) - let typ1 = Typeops.type_of_constant_type env' cb1.const_type in - let typ2 = Typeops.type_of_constant_type env' cb2.const_type in - let cst = check_type poly u cst env' typ1 typ2 in + let typ1 = cb1.const_type in + let typ2 = cb2.const_type in + let cst = check_type poly cst env typ1 typ2 in (* Now we check the bodies: - A transparent constant can only be implemented by a compatible transparent constant. @@ -356,40 +332,19 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = Anyway [check_conv] will handle that afterwards. *) let c1 = Mod_subst.force_constr lc1 in let c2 = Mod_subst.force_constr lc2 in - check_conv NotConvertibleBodyField cst poly u infer_conv env' c1 c2)) + check_conv NotConvertibleBodyField cst poly infer_conv env c1 c2)) | IndType ((kn,i),mind1) -> - ignore (CErrors.user_err Pp.(str @@ + CErrors.user_err Pp.(str @@ "The kernel does not recognize yet that a parameter can be " ^ "instantiated by an inductive type. Hint: you can rename the " ^ "inductive type and give a definition to map the old name to the new " ^ - "name.")); - let () = assert (List.is_empty mind1.mind_hyps && List.is_empty cb2.const_hyps) in - if Declareops.constant_has_body cb2 then error DefinitionFieldExpected; - let u1 = inductive_polymorphic_instance mind1 in - let arity1,cst1 = constrained_type_of_inductive env - ((mind1,mind1.mind_packets.(i)),u1) in - let cst2 = - Declareops.constraints_of_constant (Environ.opaque_tables env) cb2 in - let typ2 = Typeops.type_of_constant_type env cb2.const_type in - let cst = Constraint.union cst (Constraint.union cst1 cst2) in - let error = NotConvertibleTypeField (env, arity1, typ2) in - check_conv error cst false Univ.Instance.empty infer_conv_leq env arity1 typ2 - | IndConstr (((kn,i),j) as cstr,mind1) -> - ignore (CErrors.user_err Pp.(str @@ + "name.") + | IndConstr (((kn,i),j),mind1) -> + CErrors.user_err Pp.(str @@ "The kernel does not recognize yet that a parameter can be " ^ "instantiated by a constructor. Hint: you can rename the " ^ "constructor and give a definition to map the old name to the new " ^ - "name.")); - let () = assert (List.is_empty mind1.mind_hyps && List.is_empty cb2.const_hyps) in - if Declareops.constant_has_body cb2 then error DefinitionFieldExpected; - let u1 = inductive_polymorphic_instance mind1 in - let ty1,cst1 = constrained_type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in - let cst2 = - Declareops.constraints_of_constant (Environ.opaque_tables env) cb2 in - let ty2 = Typeops.type_of_constant_type env cb2.const_type in - let cst = Constraint.union cst (Constraint.union cst1 cst2) in - let error = NotConvertibleTypeField (env, ty1, ty2) in - check_conv error cst false Univ.Instance.empty infer_conv env ty1 ty2 + "name.") let rec check_modules cst env msb1 msb2 subst1 subst2 = let mty1 = module_type_of_module msb1 in diff --git a/kernel/subtyping.mli b/kernel/subtyping.mli index a00eb87329..b24c20aa02 100644 --- a/kernel/subtyping.mli +++ b/kernel/subtyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,5 +11,3 @@ open Declarations open Environ val check_subtypes : env -> module_type_body -> module_type_body -> constraints - - diff --git a/kernel/term.ml b/kernel/term.ml index b90718358e..0e0af2f59d 100644 --- a/kernel/term.ml +++ b/kernel/term.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/term.mli b/kernel/term.mli index e729439f01..d5aaf6ad06 100644 --- a/kernel/term.mli +++ b/kernel/term.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml index 5370bcea43..3f42c348fc 100644 --- a/kernel/term_typing.ml +++ b/kernel/term_typing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -21,7 +21,6 @@ open Environ open Entries open Typeops -module RelDecl = Context.Rel.Declaration module NamedDecl = Context.Named.Declaration (* Insertion of constants and parameters in environment. *) @@ -77,6 +76,10 @@ end type side_effects = SideEffects.t +type _ trust = +| Pure : unit trust +| SideEffects : structure_body -> side_effects trust + let uniq_seff_rev = SideEffects.repr let uniq_seff l = List.rev (SideEffects.repr l) @@ -124,15 +127,14 @@ let inline_side_effects env body ctx side_eff = match cb.const_universes with | Monomorphic_const cnstctx -> (** Abstract over the term at the top of the proof *) - let ty = Typeops.type_of_constant_type env cb.const_type in + let ty = cb.const_type in let subst = Cmap_env.add c (Inr var) subst in let univs = Univ.ContextSet.of_context cnstctx in let ctx = Univ.ContextSet.union ctx univs in (subst, var + 1, ctx, (cname c, b, ty, opaque) :: args) | Polymorphic_const auctx -> (** Inline the term to emulate universe polymorphism *) - let data = (Univ.AUContext.instance auctx, b) in - let subst = Cmap_env.add c (Inl data) subst in + let subst = Cmap_env.add c (Inl b) subst in (subst, var, ctx, args) in let (subst, len, ctx, args) = List.fold_left fold (Cmap_env.empty, 1, ctx, []) side_eff in @@ -142,7 +144,7 @@ let inline_side_effects env body ctx side_eff = let data = try Some (Cmap_env.find c subst) with Not_found -> None in begin match data with | None -> t - | Some (Inl (inst, b)) -> + | Some (Inl b) -> (** [b] is closed but may refer to other constants *) subst_const i k (Vars.subst_instance_constr u b) | Some (Inr n) -> @@ -233,7 +235,7 @@ let abstract_constant_universes abstract uctx = let sbst, auctx = Univ.abstract_universes uctx in sbst, Polymorphic_const auctx -let infer_declaration ~trust env kn dcl = +let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry) = match dcl with | ParameterEntry (ctx,poly,(t,uctx),nl) -> let env = push_context ~strict:(not poly) uctx env in @@ -244,7 +246,14 @@ let infer_declaration ~trust env kn dcl = in let c = Typeops.assumption_of_judgment env j in let t = hcons_constr (Vars.subst_univs_level_constr usubst c) in - Undef nl, RegularArity t, None, univs, false, ctx + { + Cooking.cook_body = Undef nl; + cook_type = t; + cook_proj = None; + cook_universes = univs; + cook_inline = false; + cook_context = ctx; + } (** Definition [c] is opaque (Qed), non polymorphic and with a specified type, so we delay the typing and hash consing of its body. @@ -252,56 +261,69 @@ let infer_declaration ~trust env kn dcl = delay even in the polymorphic case. *) | DefinitionEntry ({ const_entry_type = Some typ; const_entry_opaque = true; - const_entry_polymorphic = false} as c) -> - let env = push_context ~strict:true c.const_entry_universes env in + const_entry_universes = Monomorphic_const_entry univs } as c) -> + let env = push_context ~strict:true univs env in let { const_entry_body = body; const_entry_feedback = feedback_id } = c in let tyj = infer_type env typ in let proofterm = Future.chain ~pure:true body (fun ((body,uctx),side_eff) -> - let body, uctx, signatures = - inline_side_effects env body uctx side_eff in - let valid_signatures = check_signatures trust signatures in - let env = push_context_set uctx env in - let j = + let j, uctx = match trust with + | Pure -> + let env = push_context_set uctx env in + let j = infer env body in + let _ = judge_of_cast env j DEFAULTcast tyj in + j, uctx + | SideEffects mb -> + let (body, uctx, signatures) = inline_side_effects env body uctx side_eff in + let valid_signatures = check_signatures mb signatures in + let env = push_context_set uctx env in let body,env,ectx = skip_trusted_seff valid_signatures body env in let j = infer env body in - unzip ectx j in - let subst = Univ.LMap.empty in - let _ = judge_of_cast env j DEFAULTcast tyj in - assert (eq_constr typ tyj.utj_val); + let j = unzip ectx j in + let _ = judge_of_cast env j DEFAULTcast tyj in + j, uctx + in let c = hcons_constr j.uj_val in - let _typ = RegularArity (Vars.subst_univs_level_constr subst typ) in feedback_completion_typecheck feedback_id; c, uctx) in let def = OpaqueDef (Opaqueproof.create proofterm) in - def, RegularArity typ, None, - (Monomorphic_const c.const_entry_universes), - c.const_entry_inline_code, c.const_entry_secctx + { + Cooking.cook_body = def; + cook_type = typ; + cook_proj = None; + cook_universes = Monomorphic_const univs; + cook_inline = c.const_entry_inline_code; + cook_context = c.const_entry_secctx; + } (** Other definitions have to be processed immediately. *) | DefinitionEntry c -> let { const_entry_type = typ; const_entry_opaque = opaque } = c in let { const_entry_body = body; const_entry_feedback = feedback_id } = c in let (body, ctx), side_eff = Future.join body in - let univsctx = Univ.ContextSet.of_context c.const_entry_universes in - let body, ctx, _ = inline_side_effects env body - (Univ.ContextSet.union univsctx ctx) side_eff in - let env = push_context_set ~strict:(not c.const_entry_polymorphic) ctx env in - let abstract = c.const_entry_polymorphic && not (Option.is_empty kn) in + let poly, univs = match c.const_entry_universes with + | Monomorphic_const_entry univs -> false, univs + | Polymorphic_const_entry univs -> true, univs + in + let univsctx = Univ.ContextSet.of_context univs in + let ctx = Univ.ContextSet.union univsctx ctx in + let body, ctx, _ = match trust with + | Pure -> body, ctx, [] + | SideEffects _ -> inline_side_effects env body ctx side_eff + in + let env = push_context_set ~strict:(not poly) ctx env in + let abstract = poly && not (Option.is_empty kn) in let usubst, univs = abstract_constant_universes abstract (Univ.ContextSet.to_context ctx) in let j = infer env body in let typ = match typ with | None -> - if not c.const_entry_polymorphic then (* Old-style polymorphism *) - make_polymorphic_if_constant_for_ind env j - else RegularArity (Vars.subst_univs_level_constr usubst j.uj_type) + Vars.subst_univs_level_constr usubst j.uj_type | Some t -> let tj = infer_type env t in let _ = judge_of_cast env j DEFAULTcast tj in - assert (eq_constr t tj.utj_val); - RegularArity (Vars.subst_univs_level_constr usubst t) + Vars.subst_univs_level_constr usubst t in let def = hcons_constr (Vars.subst_univs_level_constr usubst j.uj_val) in let def = @@ -309,7 +331,14 @@ let infer_declaration ~trust env kn dcl = else Def (Mod_subst.from_val def) in feedback_completion_typecheck feedback_id; - def, typ, None, univs, c.const_entry_inline_code, c.const_entry_secctx + { + Cooking.cook_body = def; + cook_type = typ; + cook_proj = None; + cook_universes = univs; + cook_inline = c.const_entry_inline_code; + cook_context = c.const_entry_secctx; + } | ProjectionEntry {proj_entry_ind = ind; proj_entry_arg = i} -> let mib, _ = Inductive.lookup_mind_specif env (ind,0) in @@ -329,16 +358,14 @@ let infer_declaration ~trust env kn dcl = Polymorphic_const (Univ.ACumulativityInfo.univ_context acumi) in let term, typ = pb.proj_eta in - Def (Mod_subst.from_val (hcons_constr term)), RegularArity typ, Some pb, - univs, false, None - -let global_vars_set_constant_type env = function - | RegularArity t -> global_vars_set env t - | TemplateArity (ctx,_) -> - Context.Rel.fold_outside - (RelDecl.fold_constr - (fun t c -> Id.Set.union (global_vars_set env t) c)) - ctx ~init:Id.Set.empty + { + Cooking.cook_body = Def (Mod_subst.from_val (hcons_constr term)); + cook_type = typ; + cook_proj = Some pb; + cook_universes = univs; + cook_inline = false; + cook_context = None; + } let record_aux env s_ty s_bo suggested_expr = let in_ty = keep_hyps env s_ty in @@ -354,7 +381,9 @@ let record_aux env s_ty s_bo suggested_expr = let suggest_proof_using = ref (fun _ _ _ _ _ -> "") let set_suggest_proof_using f = suggest_proof_using := f -let build_constant_declaration kn env (def,typ,proj,univs,inline_code,ctx) = +let build_constant_declaration kn env result = + let open Cooking in + let typ = result.cook_type in let check declared inferred = let mk_set l = List.fold_right Id.Set.add (List.map NamedDecl.get_id l) Id.Set.empty in let inferred_set, declared_set = mk_set inferred, mk_set declared in @@ -381,11 +410,12 @@ let build_constant_declaration kn env (def,typ,proj,univs,inline_code,ctx) = (* We try to postpone the computation of used section variables *) let hyps, def = let context_ids = List.map NamedDecl.get_id (named_context env) in - match ctx with + let def = result.cook_body in + match result.cook_context with | None when not (List.is_empty context_ids) -> (* No declared section vars, and non-empty section context: we must look at the body NOW, if any *) - let ids_typ = global_vars_set_constant_type env typ in + let ids_typ = global_vars_set env typ in let ids_def = match def with | Undef _ -> Idset.empty | Def cs -> global_vars_set env (Mod_subst.force_constr cs) @@ -413,20 +443,21 @@ let build_constant_declaration kn env (def,typ,proj,univs,inline_code,ctx) = match def with | Undef _ as x -> x (* nothing to check *) | Def cs as x -> - let ids_typ = global_vars_set_constant_type env typ in + let ids_typ = global_vars_set env typ in let ids_def = global_vars_set env (Mod_subst.force_constr cs) in let inferred = keep_hyps env (Idset.union ids_typ ids_def) in check declared inferred; x | OpaqueDef lc -> (* In this case we can postpone the check *) OpaqueDef (Opaqueproof.iter_direct_opaque (fun c -> - let ids_typ = global_vars_set_constant_type env typ in + let ids_typ = global_vars_set env typ in let ids_def = global_vars_set env c in let inferred = keep_hyps env (Idset.union ids_typ ids_def) in check declared inferred) lc) in + let univs = result.cook_universes in let tps = let res = - match proj with + match result.cook_proj with | None -> compile_constant_body env univs def | Some pb -> (* The compilation of primitive projections is a bit tricky, because @@ -439,10 +470,10 @@ let build_constant_declaration kn env (def,typ,proj,univs,inline_code,ctx) = { const_hyps = hyps; const_body = def; const_type = typ; - const_proj = proj; + const_proj = result.cook_proj; const_body_code = None; const_universes = univs; - const_inline_code = inline_code; + const_inline_code = result.cook_inline; const_typing_flags = Environ.typing_flags env; } in @@ -453,10 +484,10 @@ let build_constant_declaration kn env (def,typ,proj,univs,inline_code,ctx) = { const_hyps = hyps; const_body = def; const_type = typ; - const_proj = proj; + const_proj = result.cook_proj; const_body_code = tps; const_universes = univs; - const_inline_code = inline_code; + const_inline_code = result.cook_inline; const_typing_flags = Environ.typing_flags env } (*s Global and local constant declaration. *) @@ -466,11 +497,12 @@ let translate_constant mb env kn ce = (infer_declaration ~trust:mb env (Some kn) ce) let constant_entry_of_side_effect cb u = - let poly, univs = + let univs = match cb.const_universes with - | Monomorphic_const ctx -> false, ctx + | Monomorphic_const uctx -> + Monomorphic_const_entry uctx | Polymorphic_const auctx -> - true, Univ.instantiate_univ_context auctx + Polymorphic_const_entry (Univ.AUContext.repr auctx) in let pt = match cb.const_body, u with @@ -478,12 +510,10 @@ let constant_entry_of_side_effect cb u = | Def b, `Nothing -> Mod_subst.force_constr b, Univ.ContextSet.empty | _ -> assert false in DefinitionEntry { - const_entry_body = Future.from_val (pt, empty_seff); + const_entry_body = Future.from_val (pt, ()); const_entry_secctx = None; const_entry_feedback = None; - const_entry_type = - (match cb.const_type with RegularArity t -> Some t | _ -> None); - const_entry_polymorphic = poly; + const_entry_type = Some cb.const_type; const_entry_universes = univs; const_entry_opaque = Declareops.is_opaque cb; const_entry_inline_code = cb.const_inline_code } @@ -502,17 +532,18 @@ type side_effect_role = | Schema of inductive * string type exported_side_effect = - constant * constant_body * side_effects constant_entry * side_effect_role + constant * constant_body * side_effect_role let export_side_effects mb env ce = match ce with - | ParameterEntry _ | ProjectionEntry _ -> [], ce + | ParameterEntry e -> [], ParameterEntry e + | ProjectionEntry e -> [], ProjectionEntry e | DefinitionEntry c -> let { const_entry_body = body } = c in let _, eff = Future.force body in let ce = DefinitionEntry { c with const_entry_body = Future.chain ~pure:true body - (fun (b_ctx, _) -> b_ctx, empty_seff) } in + (fun (b_ctx, _) -> b_ctx, ()) } in let not_exists (c,_,_,_) = try ignore(Environ.lookup_constant c env); false with Not_found -> true in @@ -552,8 +583,8 @@ let export_side_effects mb env ce = let env, cbs = List.fold_left (fun (env,cbs) (kn, ocb, u, r) -> let ce = constant_entry_of_side_effect ocb u in - let cb = translate_constant mb env kn ce in - (push_seff env (kn, cb,`Nothing, Subproof),(kn,cb,ce,r) :: cbs)) + let cb = translate_constant Pure env kn ce in + (push_seff env (kn, cb,`Nothing, Subproof),(kn,cb,r) :: cbs)) (env,[]) cbs in translate_seff sl rest (cbs @ acc) env | Some sl, cbs :: rest -> @@ -561,7 +592,7 @@ let export_side_effects mb env ce = let cbs = List.map turn_direct cbs in let env = List.fold_left push_seff env cbs in let ecbs = List.map (fun (kn,cb,u,r) -> - kn, cb, constant_entry_of_side_effect cb u, r) cbs in + kn, cb, r) cbs in translate_seff (Some (sl-cbs_len)) rest (ecbs @ acc) env in translate_seff trusted seff [] env @@ -580,11 +611,11 @@ let translate_recipe env kn r = build_constant_declaration kn env (Cooking.cook_constant ~hcons env r) let translate_local_def mb env id centry = - let def,typ,proj,univs,inline_code,ctx = - infer_declaration ~trust:mb env None (DefinitionEntry centry) in - let typ = type_of_constant_type env typ in - if ctx = None && !Flags.compilation_mode = Flags.BuildVo then begin - match def with + let open Cooking in + let decl = infer_declaration ~trust:mb env None (DefinitionEntry centry) in + let typ = decl.cook_type in + if Option.is_empty decl.cook_context && !Flags.compilation_mode = Flags.BuildVo then begin + match decl.cook_body with | Undef _ -> () | Def _ -> () | OpaqueDef lc -> @@ -597,7 +628,11 @@ let translate_local_def mb env id centry = env ids_def ids_typ context_ids in record_aux env ids_typ ids_def expr end; - def, typ, univs + let univs = match decl.cook_universes with + | Monomorphic_const ctx -> ctx + | Polymorphic_const _ -> assert false + in + decl.cook_body, typ, univs (* Insertion of inductive types. *) @@ -607,7 +642,7 @@ let inline_entry_side_effects env ce = { ce with const_entry_body = Future.chain ~pure:true ce.const_entry_body (fun ((body, ctx), side_eff) -> let body, ctx',_ = inline_side_effects env body ctx side_eff in - (body, ctx'), empty_seff); + (body, ctx'), ()); } let inline_side_effects env body side_eff = diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli index 075389ea53..24153343e7 100644 --- a/kernel/term_typing.mli +++ b/kernel/term_typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,8 +14,12 @@ open Entries type side_effects -val translate_local_def : structure_body -> env -> Id.t -> side_effects definition_entry -> - constant_def * types * constant_universes +type _ trust = +| Pure : unit trust +| SideEffects : structure_body -> side_effects trust + +val translate_local_def : 'a trust -> env -> Id.t -> 'a definition_entry -> + constant_def * types * Univ.universe_context val translate_local_assum : env -> types -> types @@ -26,7 +30,7 @@ val inline_side_effects : env -> constr -> side_effects -> constr redexes. *) val inline_entry_side_effects : - env -> side_effects definition_entry -> side_effects definition_entry + env -> side_effects definition_entry -> unit definition_entry (** Same as {!inline_side_effects} but applied to entries. Only modifies the {!Entries.const_entry_body} field. It is meant to get a term out of a not yet type checked proof. *) @@ -43,7 +47,7 @@ val uniq_seff : side_effects -> side_effect list val equal_eff : side_effect -> side_effect -> bool val translate_constant : - structure_body -> env -> constant -> side_effects constant_entry -> + 'a trust -> env -> constant -> 'a constant_entry -> constant_body type side_effect_role = @@ -51,7 +55,7 @@ type side_effect_role = | Schema of inductive * string type exported_side_effect = - constant * constant_body * side_effects constant_entry * side_effect_role + constant * constant_body * side_effect_role (* Given a constant entry containing side effects it exports them (either * by re-checking them or trusting them). Returns the constant bodies to @@ -59,10 +63,7 @@ type exported_side_effect = * needs to be translated as usual after this step. *) val export_side_effects : structure_body -> env -> side_effects constant_entry -> - exported_side_effect list * side_effects constant_entry - -val constant_entry_of_side_effect : - constant_body -> seff_env -> side_effects constant_entry + exported_side_effect list * unit constant_entry val translate_mind : env -> mutual_inductive -> mutual_inductive_entry -> mutual_inductive_body @@ -71,8 +72,8 @@ val translate_recipe : env -> constant -> Cooking.recipe -> constant_body (** Internal functions, mentioned here for debug purpose only *) -val infer_declaration : trust:structure_body -> env -> constant option -> - side_effects constant_entry -> Cooking.result +val infer_declaration : trust:'a trust -> env -> constant option -> + 'a constant_entry -> Cooking.result val build_constant_declaration : constant -> env -> Cooking.result -> constant_body diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml index 5e17638152..bbaf569d39 100644 --- a/kernel/type_errors.ml +++ b/kernel/type_errors.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli index bd6032716f..1b2ccf8f82 100644 --- a/kernel/type_errors.mli +++ b/kernel/type_errors.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/typeops.ml b/kernel/typeops.ml index e08f3362db..044877e82a 100644 --- a/kernel/typeops.ml +++ b/kernel/typeops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -111,36 +111,17 @@ let check_hyps_inclusion env f c sign = (* Type of constants *) -let type_of_constant_type_knowing_parameters env t paramtyps = - match t with - | RegularArity t -> t - | TemplateArity (sign,ar) -> - let ctx = List.rev sign in - let ctx,s = instantiate_universes env ctx ar paramtyps in - mkArity (List.rev ctx,s) - -let type_of_constant_knowing_parameters env (kn,u as cst) args = +let type_of_constant env (kn,u as cst) = let cb = lookup_constant kn env in let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in let ty, cu = constant_type env cst in - let ty = type_of_constant_type_knowing_parameters env ty args in let () = check_constraints cu env in ty -let type_of_constant_knowing_parameters_in env (kn,u as cst) args = +let type_of_constant_in env (kn,u as cst) = let cb = lookup_constant kn env in let () = check_hyps_inclusion env mkConstU cst cb.const_hyps in - let ty = constant_type_in env cst in - type_of_constant_type_knowing_parameters env ty args - -let type_of_constant env cst = - type_of_constant_knowing_parameters env cst [||] - -let type_of_constant_in env cst = - type_of_constant_knowing_parameters_in env cst [||] - -let type_of_constant_type env t = - type_of_constant_type_knowing_parameters env t [||] + constant_type_in env cst (* Type of a lambda-abstraction. *) @@ -369,9 +350,6 @@ let rec execute env cstr = | Ind ind when Environ.template_polymorphic_pind ind env -> let args = Array.map (fun t -> lazy t) argst in type_of_inductive_knowing_parameters env ind args - | Const cst when Environ.template_polymorphic_pconstant cst env -> - let args = Array.map (fun t -> lazy t) argst in - type_of_constant_knowing_parameters env cst args | _ -> (* No template polymorphism *) execute env f @@ -509,8 +487,6 @@ let judge_of_relative env k = make_judge (mkRel k) (type_of_relative env k) let judge_of_variable env x = make_judge (mkVar x) (type_of_variable env x) let judge_of_constant env cst = make_judge (mkConstU cst) (type_of_constant env cst) -let judge_of_constant_knowing_parameters env cst args = - make_judge (mkConstU cst) (type_of_constant_knowing_parameters env cst args) let judge_of_projection env p cj = make_judge (mkProj (p,cj.uj_val)) (type_of_projection env p cj.uj_val cj.uj_type) @@ -559,34 +535,3 @@ let type_of_projection_constant env (p,u) = Vars.subst_instance_constr u pb.proj_type else pb.proj_type | None -> raise (Invalid_argument "type_of_projection: not a projection") - -(* Instantiation of terms on real arguments. *) - -(* Make a type polymorphic if an arity *) - -let extract_level env p = - let _,c = dest_prod_assum env p in - match kind_of_term c with Sort (Type u) -> Univ.Universe.level u | _ -> None - -let extract_context_levels env l = - let fold l = function - | RelDecl.LocalAssum (_,p) -> extract_level env p :: l - | RelDecl.LocalDef _ -> l - in - List.fold_left fold [] l - -let make_polymorphic_if_constant_for_ind env {uj_val = c; uj_type = t} = - let params, ccl = dest_prod_assum env t in - match kind_of_term ccl with - | Sort (Type u) -> - let ind, l = decompose_app (whd_all env c) in - if isInd ind && List.is_empty l then - let mis = lookup_mind_specif env (fst (destInd ind)) in - let nparams = Inductive.inductive_params mis in - let paramsl = CList.lastn nparams params in - let param_ccls = extract_context_levels env paramsl in - let s = { template_param_levels = param_ccls; template_level = u} in - TemplateArity (params,s) - else RegularArity t - | _ -> - RegularArity t diff --git a/kernel/typeops.mli b/kernel/typeops.mli index 007acae604..a8f7fba9a0 100644 --- a/kernel/typeops.mli +++ b/kernel/typeops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,6 @@ open Univ open Term open Environ open Entries -open Declarations (** {6 Typing functions (not yet tagged as safe) } @@ -53,9 +52,6 @@ val judge_of_variable : env -> variable -> unsafe_judgment val judge_of_constant : env -> pconstant -> unsafe_judgment -val judge_of_constant_knowing_parameters : - env -> pconstant -> types Lazy.t array -> unsafe_judgment - (** {6 type of an applied projection } *) val judge_of_projection : env -> Names.projection -> unsafe_judgment -> unsafe_judgment @@ -98,21 +94,9 @@ val judge_of_case : env -> case_info -> unsafe_judgment -> unsafe_judgment -> unsafe_judgment array -> unsafe_judgment -val type_of_constant_type : env -> constant_type -> types - val type_of_projection_constant : env -> Names.projection puniverses -> types val type_of_constant_in : env -> pconstant -> types -val type_of_constant_type_knowing_parameters : - env -> constant_type -> types Lazy.t array -> types - -val type_of_constant_knowing_parameters_in : - env -> pconstant -> types Lazy.t array -> types - -(** Make a type polymorphic if an arity *) -val make_polymorphic_if_constant_for_ind : env -> unsafe_judgment -> - constant_type - (** Check that hyps are included in env and fails with error otherwise *) val check_hyps_inclusion : env -> ('a -> constr) -> 'a -> Context.Named.t -> unit diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml index 487257a776..9793dd881d 100644 --- a/kernel/uGraph.ml +++ b/kernel/uGraph.ml @@ -830,6 +830,18 @@ let sort_universes g = in normalize_universes g +(** Subtyping of polymorphic contexts *) + +let check_subtype univs ctxT ctx = + if AUContext.size ctx == AUContext.size ctx then + let (inst, cst) = UContext.dest (AUContext.repr ctx) in + let cstT = UContext.constraints (AUContext.repr ctxT) in + let push accu v = add_universe v false accu in + let univs = Array.fold_left push univs (Instance.to_array inst) in + let univs = merge_constraints cstT univs in + check_constraints cst univs + else false + (** Instances *) let check_eq_instances g t1 t2 = diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli index 935a3cab4a..2fe5550184 100644 --- a/kernel/uGraph.mli +++ b/kernel/uGraph.mli @@ -53,9 +53,13 @@ val check_constraints : constraints -> universes -> bool val check_eq_instances : Instance.t check_function (** Check equality of instances w.r.t. a universe graph *) +val check_subtype : AUContext.t check_function +(** [check_subtype univ ctx1 ctx2] checks whether [ctx2] is an instance of + [ctx1]. *) + (** {6 Pretty-printing of universes. } *) -val pr_universes : (Level.t -> Pp.std_ppcmds) -> universes -> Pp.std_ppcmds +val pr_universes : (Level.t -> Pp.t) -> universes -> Pp.t (** {6 Dumping to a file } *) diff --git a/kernel/univ.ml b/kernel/univ.ml index 8cbb20a051..d915fb8c98 100644 --- a/kernel/univ.ml +++ b/kernel/univ.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -892,7 +892,7 @@ module Instance : sig val subst_fn : universe_level_subst_fn -> t -> t - val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds + val pr : (Level.t -> Pp.t) -> t -> Pp.t val levels : t -> LSet.t end = struct @@ -988,6 +988,31 @@ let enforce_eq_instances x y = (Pp.str " instances of different lengths.")); CArray.fold_right2 enforce_eq_level ax ay +let subst_instance_level s l = + match l.Level.data with + | Level.Var n -> s.(n) + | _ -> l + +let subst_instance_instance s i = + Array.smartmap (fun l -> subst_instance_level s l) i + +let subst_instance_universe s u = + let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in + let u' = Universe.smartmap f u in + if u == u' then u + else Universe.sort u' + +let subst_instance_constraint s (u,d,v as c) = + let u' = subst_instance_level s u in + let v' = subst_instance_level s v in + if u' == u && v' == v then c + else (u',d,v') + +let subst_instance_constraints s csts = + Constraint.fold + (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) + csts Constraint.empty + type universe_instance = Instance.t type 'a puniverses = 'a * Instance.t @@ -1031,7 +1056,18 @@ end type universe_context = UContext.t let hcons_universe_context = UContext.hcons -module AUContext = UContext +module AUContext = +struct + include UContext + + let repr (inst, cst) = + (Array.mapi (fun i l -> Level.var i) inst, cst) + + let instantiate inst (u, cst) = + assert (Array.length u = Array.length inst); + subst_instance_constraints inst cst + +end type abstract_universe_context = AUContext.t let hcons_abstract_universe_context = AUContext.hcons @@ -1256,39 +1292,6 @@ let subst_univs_constraints subst csts = (fun c cstrs -> subst_univs_constraint subst c cstrs) csts Constraint.empty -let subst_instance_level s l = - match l.Level.data with - | Level.Var n -> s.(n) - | _ -> l - -let subst_instance_instance s i = - Array.smartmap (fun l -> subst_instance_level s l) i - -let subst_instance_universe s u = - let f x = Universe.Expr.map (fun u -> subst_instance_level s u) x in - let u' = Universe.smartmap f u in - if u == u' then u - else Universe.sort u' - -let subst_instance_constraint s (u,d,v as c) = - let u' = subst_instance_level s u in - let v' = subst_instance_level s v in - if u' == u && v' == v then c - else (u',d,v') - -let subst_instance_constraints s csts = - Constraint.fold - (fun c csts -> Constraint.add (subst_instance_constraint s c) csts) - csts Constraint.empty - -(** Substitute instance inst for ctx in csts *) -let instantiate_univ_context (ctx, csts) = - (ctx, subst_instance_constraints ctx csts) - -(** Substitute instance inst for ctx in universe constraints and subtyping constraints *) -let instantiate_cumulativity_info (univcst, subtpcst) = - (instantiate_univ_context univcst, instantiate_univ_context subtpcst) - let make_instance_subst i = let arr = Instance.to_array i in Array.fold_left_i (fun i acc l -> @@ -1378,19 +1381,3 @@ let explain_universe_inconsistency prl (o,u,v,p) = let compare_levels = Level.compare let eq_levels = Level.equal let equal_universes = Universe.equal - - -let subst_instance_constraints = - if Flags.profile then - let key = Profile.declare_profile "subst_instance_constraints" in - Profile.profile2 key subst_instance_constraints - else subst_instance_constraints - -let subst_instance_context = - let subst_instance_context_body inst (inner_inst, inner_constr) = - (inner_inst, subst_instance_constraints inst inner_constr) - in - if Flags.profile then - let key = Profile.declare_profile "subst_instance_constraints" in - Profile.profile2 key subst_instance_context_body - else subst_instance_context_body diff --git a/kernel/univ.mli b/kernel/univ.mli index ecc72701d4..a4f2e26b63 100644 --- a/kernel/univ.mli +++ b/kernel/univ.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -37,7 +37,7 @@ sig (** Create a new universe level from a unique identifier and an associated module path. *) - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t (** Pretty-printing *) val to_string : t -> string @@ -56,7 +56,7 @@ module LSet : sig include CSig.SetS with type elt = universe_level - val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds + val pr : (Level.t -> Pp.t) -> t -> Pp.t (** Pretty-printing *) end @@ -86,10 +86,10 @@ sig val make : Level.t -> t (** Create a universe representing the given level. *) - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t (** Pretty-printing *) - val pr_with : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds + val pr_with : (Level.t -> Pp.t) -> t -> Pp.t val is_level : t -> bool (** Test if the universe is a level or an algebraic universe. *) @@ -127,7 +127,7 @@ type universe = Universe.t (** Alias name. *) -val pr_uni : universe -> Pp.std_ppcmds +val pr_uni : universe -> Pp.t (** The universes hierarchy: Type 0- = Prop <= Type 0 = Set <= Type 1 <= ... Typing of universes: Type 0-, Type 0 : Type 1; Type i : Type (i+1) if i>0 *) @@ -218,7 +218,7 @@ sig (** [subst_union x y] favors the bindings of the first map that are [Some], otherwise takes y's bindings. *) - val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds + val pr : ('a -> Pp.t) -> 'a t -> Pp.t (** Pretty-printing *) end @@ -270,7 +270,7 @@ sig val subst_fn : universe_level_subst_fn -> t -> t (** Substitution by a level-to-level function. *) - val pr : (Level.t -> Pp.std_ppcmds) -> t -> Pp.std_ppcmds + val pr : (Level.t -> Pp.t) -> t -> Pp.t (** Pretty-printing, no comments *) val levels : t -> LSet.t @@ -319,15 +319,24 @@ module AUContext : sig type t + val repr : t -> UContext.t + (** [repr ctx] is [(Var(0), ... Var(n-1) |= cstr] where [n] is the length of + the context and [cstr] the abstracted constraints. *) + val empty : t + val is_empty : t -> bool + (** Don't use. *) val instance : t -> Instance.t - + val size : t -> int (** Keeps the order of the instances *) val union : t -> t -> t + val instantiate : Instance.t -> t -> Constraint.t + (** Generate the set of instantiated constraints **) + end type abstract_universe_context = AUContext.t @@ -442,7 +451,6 @@ val subst_univs_constraints : universe_subst_fn -> constraints -> constraints (** Substitution of instances *) val subst_instance_instance : universe_instance -> universe_instance -> universe_instance val subst_instance_universe : universe_instance -> universe -> universe -val subst_instance_context : universe_instance -> abstract_universe_context -> universe_context val make_instance_subst : universe_instance -> universe_level_subst val make_inverse_instance_subst : universe_instance -> universe_level_subst @@ -453,26 +461,20 @@ val abstract_cumulativity_info : cumulativity_info -> universe_level_subst * abs val make_abstract_instance : abstract_universe_context -> universe_instance -(** Get the instantiated graph. *) -val instantiate_univ_context : abstract_universe_context -> universe_context - -(** Get the instantiated graphs for both universe constraints and subtyping constraints. *) -val instantiate_cumulativity_info : abstract_cumulativity_info -> cumulativity_info - (** {6 Pretty-printing of universes. } *) -val pr_constraint_type : constraint_type -> Pp.std_ppcmds -val pr_constraints : (Level.t -> Pp.std_ppcmds) -> constraints -> Pp.std_ppcmds -val pr_universe_context : (Level.t -> Pp.std_ppcmds) -> universe_context -> Pp.std_ppcmds -val pr_cumulativity_info : (Level.t -> Pp.std_ppcmds) -> cumulativity_info -> Pp.std_ppcmds -val pr_abstract_universe_context : (Level.t -> Pp.std_ppcmds) -> abstract_universe_context -> Pp.std_ppcmds -val pr_abstract_cumulativity_info : (Level.t -> Pp.std_ppcmds) -> abstract_cumulativity_info -> Pp.std_ppcmds -val pr_universe_context_set : (Level.t -> Pp.std_ppcmds) -> universe_context_set -> Pp.std_ppcmds -val explain_universe_inconsistency : (Level.t -> Pp.std_ppcmds) -> - univ_inconsistency -> Pp.std_ppcmds - -val pr_universe_level_subst : universe_level_subst -> Pp.std_ppcmds -val pr_universe_subst : universe_subst -> Pp.std_ppcmds +val pr_constraint_type : constraint_type -> Pp.t +val pr_constraints : (Level.t -> Pp.t) -> constraints -> Pp.t +val pr_universe_context : (Level.t -> Pp.t) -> universe_context -> Pp.t +val pr_cumulativity_info : (Level.t -> Pp.t) -> cumulativity_info -> Pp.t +val pr_abstract_universe_context : (Level.t -> Pp.t) -> abstract_universe_context -> Pp.t +val pr_abstract_cumulativity_info : (Level.t -> Pp.t) -> abstract_cumulativity_info -> Pp.t +val pr_universe_context_set : (Level.t -> Pp.t) -> universe_context_set -> Pp.t +val explain_universe_inconsistency : (Level.t -> Pp.t) -> + univ_inconsistency -> Pp.t + +val pr_universe_level_subst : universe_level_subst -> Pp.t +val pr_universe_subst : universe_subst -> Pp.t (** {6 Hash-consing } *) diff --git a/kernel/vars.ml b/kernel/vars.ml index baf8fa31f6..d0dad02ece 100644 --- a/kernel/vars.ml +++ b/kernel/vars.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/vars.mli b/kernel/vars.mli index df5c55118f..59dc09a75d 100644 --- a/kernel/vars.mli +++ b/kernel/vars.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/vconv.mli b/kernel/vconv.mli index ff01735c0b..f4e680c690 100644 --- a/kernel/vconv.mli +++ b/kernel/vconv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/vm.ml b/kernel/vm.ml index 21c1225cc4..6b7a86d6f9 100644 --- a/kernel/vm.ml +++ b/kernel/vm.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/kernel/vm.mli b/kernel/vm.mli index 6e9579aa46..df638acc1f 100644 --- a/kernel/vm.mli +++ b/kernel/vm.mli @@ -50,9 +50,9 @@ type whd = (** For debugging purposes only *) -val pr_atom : atom -> Pp.std_ppcmds -val pr_whd : whd -> Pp.std_ppcmds -val pr_stack : stack -> Pp.std_ppcmds +val pr_atom : atom -> Pp.t +val pr_whd : whd -> Pp.t +val pr_stack : stack -> Pp.t (** Constructors *) diff --git a/lib/aux_file.ml b/lib/aux_file.ml index 09a254e9d9..b16e60da58 100644 --- a/lib/aux_file.ml +++ b/lib/aux_file.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/aux_file.mli b/lib/aux_file.mli index a7960fa169..1ee51312df 100644 --- a/lib/aux_file.mli +++ b/lib/aux_file.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/bigint.ml b/lib/bigint.ml index 1ecc2ce2cc..4f8b95d592 100644 --- a/lib/bigint.ml +++ b/lib/bigint.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/bigint.mli b/lib/bigint.mli index a1dc660771..2a5a5f122d 100644 --- a/lib/bigint.mli +++ b/lib/bigint.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cEphemeron.ml b/lib/cEphemeron.ml index 890e02dc4e..8b253a7901 100644 --- a/lib/cEphemeron.ml +++ b/lib/cEphemeron.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cEphemeron.mli b/lib/cEphemeron.mli index 76cd7a5a8a..d8a1f27573 100644 --- a/lib/cEphemeron.mli +++ b/lib/cEphemeron.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cErrors.ml b/lib/cErrors.ml index 8ef11a2cdd..3f4e8aa12f 100644 --- a/lib/cErrors.ml +++ b/lib/cErrors.ml @@ -14,7 +14,7 @@ let push = Backtrace.add_backtrace (* Errors *) -exception Anomaly of string option * std_ppcmds (* System errors *) +exception Anomaly of string option * Pp.t (* System errors *) let _ = let pr = function @@ -33,7 +33,7 @@ let is_anomaly = function | Anomaly _ -> true | _ -> false -exception UserError of string option * std_ppcmds (* User errors *) +exception UserError of string option * Pp.t (* User errors *) let todo s = prerr_string ("TODO: "^s^"\n") @@ -41,7 +41,7 @@ let user_err ?loc ?hdr strm = Loc.raise ?loc (UserError (hdr, strm)) let invalid_arg ?loc s = Loc.raise ?loc (Invalid_argument s) -exception AlreadyDeclared of std_ppcmds (* for already declared Schemes *) +exception AlreadyDeclared of Pp.t (* for already declared Schemes *) let alreadydeclared pps = raise (AlreadyDeclared(pps)) exception Timeout diff --git a/lib/cErrors.mli b/lib/cErrors.mli index ca0838575e..f3253979f2 100644 --- a/lib/cErrors.mli +++ b/lib/cErrors.mli @@ -6,8 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -open Pp - (** This modules implements basic manipulations of errors for use throughout Coq's code. *) @@ -21,10 +19,10 @@ val push : exn -> Exninfo.iexn [Anomaly] is used for system errors and [UserError] for the user's ones. *) -val make_anomaly : ?label:string -> std_ppcmds -> exn +val make_anomaly : ?label:string -> Pp.t -> exn (** Create an anomaly. *) -val anomaly : ?loc:Loc.t -> ?label:string -> std_ppcmds -> 'a +val anomaly : ?loc:Loc.t -> ?label:string -> Pp.t -> 'a (** Raise an anomaly, with an optional location and an optional label identifying the anomaly. *) @@ -33,16 +31,16 @@ val is_anomaly : exn -> bool This is mostly provided for compatibility. Please avoid doing specific tricks with anomalies thanks to it. See rather [noncritical] below. *) -exception UserError of string option * std_ppcmds +exception UserError of string option * Pp.t (** Main error signaling exception. It carries a header plus a pretty printing doc *) -val user_err : ?loc:Loc.t -> ?hdr:string -> std_ppcmds -> 'a +val user_err : ?loc:Loc.t -> ?hdr:string -> Pp.t -> 'a (** Main error raising primitive. [user_err ?loc ?hdr pp] signals an error [pp] with optional header and location [hdr] [loc] *) -exception AlreadyDeclared of std_ppcmds -val alreadydeclared : std_ppcmds -> 'a +exception AlreadyDeclared of Pp.t +val alreadydeclared : Pp.t -> 'a val invalid_arg : ?loc:Loc.t -> string -> 'a @@ -74,16 +72,16 @@ exception Quit exception Unhandled -val register_handler : (exn -> Pp.std_ppcmds) -> unit +val register_handler : (exn -> Pp.t) -> unit (** The standard exception printer *) -val print : ?info:Exninfo.info -> exn -> Pp.std_ppcmds -val iprint : Exninfo.iexn -> Pp.std_ppcmds +val print : ?info:Exninfo.info -> exn -> Pp.t +val iprint : Exninfo.iexn -> Pp.t (** Same as [print], except that the "Please report" part of an anomaly isn't printed (used in Ltac debugging). *) -val print_no_report : exn -> Pp.std_ppcmds -val iprint_no_report : Exninfo.iexn -> Pp.std_ppcmds +val print_no_report : exn -> Pp.t +val iprint_no_report : Exninfo.iexn -> Pp.t (** Critical exceptions should not be caught and ignored by mistake by inner functions during a [vernacinterp]. They should be handled @@ -100,9 +98,9 @@ val handled : exn -> bool val error : string -> 'a [@@ocaml.deprecated "use [user_err] instead"] -val errorlabstrm : string -> std_ppcmds -> 'a +val errorlabstrm : string -> Pp.t -> 'a [@@ocaml.deprecated "use [user_err ~hdr] instead"] -val user_err_loc : Loc.t * string * std_ppcmds -> 'a +val user_err_loc : Loc.t * string * Pp.t -> 'a [@@ocaml.deprecated "use [user_err ~loc] instead"] diff --git a/lib/cMap.ml b/lib/cMap.ml index ba0873ffa7..0ecb40209c 100644 --- a/lib/cMap.ml +++ b/lib/cMap.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cMap.mli b/lib/cMap.mli index 2838b374ec..f65036139b 100644 --- a/lib/cMap.mli +++ b/lib/cMap.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cSet.ml b/lib/cSet.ml index 037cdc3568..ed65edf16e 100644 --- a/lib/cSet.ml +++ b/lib/cSet.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cSet.mli b/lib/cSet.mli index 2452bb60e5..2eb9bce869 100644 --- a/lib/cSet.mli +++ b/lib/cSet.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cString.ml b/lib/cString.ml index 7048dbb81b..f2242460e8 100644 --- a/lib/cString.ml +++ b/lib/cString.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cString.mli b/lib/cString.mli index b30f26abe7..29d3a44995 100644 --- a/lib/cString.mli +++ b/lib/cString.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cThread.ml b/lib/cThread.ml index 9f642b3cec..0221e690e8 100644 --- a/lib/cThread.ml +++ b/lib/cThread.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cThread.mli b/lib/cThread.mli index 36477a1160..66f039bb52 100644 --- a/lib/cThread.mli +++ b/lib/cThread.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cUnix.ml b/lib/cUnix.ml index 2542b9751b..867f86a746 100644 --- a/lib/cUnix.ml +++ b/lib/cUnix.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cUnix.mli b/lib/cUnix.mli index c6bcf63475..a394814041 100644 --- a/lib/cUnix.mli +++ b/lib/cUnix.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml index d004fd6711..ff71452672 100644 --- a/lib/cWarnings.ml +++ b/lib/cWarnings.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -35,28 +35,6 @@ let add_warning_in_category ~name ~category = in Hashtbl.replace categories category (name::ws) -let create ~name ~category ?(default=Enabled) pp = - Hashtbl.add warnings name { default; category; status = default }; - add_warning_in_category ~name ~category; - if default <> Disabled then - add_warning_in_category ~name ~category:"default"; - fun ?loc x -> - let w = Hashtbl.find warnings name in - let loc = Option.append loc !current_loc in - match w.status with - | Disabled -> () - | AsError -> CErrors.user_err ?loc (pp x) - | Enabled -> - let msg = - pp x ++ spc () ++ str "[" ++ str name ++ str "," ++ - str category ++ str "]" - in - Feedback.msg_warning ?loc msg - -let warn_unknown_warning = - create ~name:"unknown-warning" ~category:"toplevel" - (fun name -> strbrk "Unknown warning name: " ++ str name) - let set_warning_status ~name status = try let w = Hashtbl.find warnings name in @@ -111,12 +89,6 @@ let set_status ~name status = 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 @@ -143,10 +115,9 @@ let uniquize_flags_rev 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. *) +(** [normalize_flags] removes redundant warnings. Unknown warnings are kept + because they may be declared in a plugin that will be linked later. *) 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 @@ -179,3 +150,27 @@ let parse_flags s = let set_flags s = reset_default_warnings (); let s = parse_flags s in flags := s + +(* Adds a warning to the [warnings] and [category] tables. We then reparse the + warning flags string, because the warning being created might have been set + already. *) +let create ~name ~category ?(default=Enabled) pp = + Hashtbl.replace warnings name { default; category; status = default }; + add_warning_in_category ~name ~category; + if default <> Disabled then + add_warning_in_category ~name ~category:"default"; + (* We re-parse and also re-normalize the flags, because the category of the + new warning is now known. *) + set_flags !flags; + fun ?loc x -> + let w = Hashtbl.find warnings name in + let loc = Option.append loc !current_loc in + match w.status with + | Disabled -> () + | AsError -> CErrors.user_err ?loc (pp x) + | Enabled -> + let msg = + pp x ++ spc () ++ str "[" ++ str name ++ str "," ++ + str category ++ str "]" + in + Feedback.msg_warning ?loc msg diff --git a/lib/cWarnings.mli b/lib/cWarnings.mli index c1fb5d6042..ba152a19b6 100644 --- a/lib/cWarnings.mli +++ b/lib/cWarnings.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,7 +11,7 @@ type status = Disabled | Enabled | AsError val set_current_loc : Loc.t option -> unit val create : name:string -> category:string -> ?default:status -> - ('a -> Pp.std_ppcmds) -> ?loc:Loc.t -> 'a -> unit + ('a -> Pp.t) -> ?loc:Loc.t -> 'a -> unit val get_flags : unit -> string val set_flags : string -> unit diff --git a/lib/canary.ml b/lib/canary.ml index c01bc15879..0ed1d28f37 100644 --- a/lib/canary.ml +++ b/lib/canary.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/canary.mli b/lib/canary.mli index 21949e7359..904b88213c 100644 --- a/lib/canary.mli +++ b/lib/canary.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/control.ml b/lib/control.ml index bf0e1b1cd7..f5d7df204e 100644 --- a/lib/control.ml +++ b/lib/control.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -48,7 +48,7 @@ let windows_timeout n f e = let exited = ref false in let thread init = while not !killed do - let cur = Unix.time () in + let cur = Unix.gettimeofday () in if float_of_int n <= cur -. init then begin interrupt := true; exited := true; @@ -57,12 +57,12 @@ let windows_timeout n f e = Thread.delay 0.5 done in - let init = Unix.time () in + let init = Unix.gettimeofday () in let _id = Thread.create thread init in try let res = f () in let () = killed := true in - let cur = Unix.time () in + let cur = Unix.gettimeofday () in (** The thread did not interrupt, but the computation took longer than expected. *) let () = if float_of_int n <= cur -. init then begin diff --git a/lib/control.mli b/lib/control.mli index 681df313bc..337cdf67b0 100644 --- a/lib/control.mli +++ b/lib/control.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/coqProject_file.ml4 b/lib/coqProject_file.ml4 index 97aa90e07d..13de731f54 100644 --- a/lib/coqProject_file.ml4 +++ b/lib/coqProject_file.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -73,9 +73,6 @@ let rec post_canonize f = if dir = Filename.current_dir_name then f else post_canonize dir else f -(* Avoid Sys.is_directory raise an exception (if the file does not exists) *) -let is_directory f = Sys.file_exists f && Sys.is_directory f - (********************* parser *******************************************) exception Parsing_error of string @@ -106,6 +103,15 @@ let parse f = res ;; +(* Copy from minisys.ml, since we don't see that file here *) +let exists_dir dir = + let rec strip_trailing_slash dir = + let len = String.length dir in + if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\') + then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in + try Sys.is_directory (strip_trailing_slash dir) with Sys_error _ -> false + + let process_cmd_line orig_dir proj args = let orig_dir = (* avoids turning foo.v in ./foo.v *) if orig_dir = "." then "" else orig_dir in @@ -173,7 +179,7 @@ let process_cmd_line orig_dir proj args = | f :: r -> let f = CUnix.correct_path f orig_dir in let proj = - if is_directory f then { proj with subdirs = proj.subdirs @ [f] } + if exists_dir f then { proj with subdirs = proj.subdirs @ [f] } else match CUnix.get_extension f with | ".v" -> { proj with v_files = proj.v_files @ [f] } | ".ml" -> { proj with ml_files = proj.ml_files @ [f] } diff --git a/lib/coqProject_file.mli b/lib/coqProject_file.mli index 19fc9227ae..23a27a54ab 100644 --- a/lib/coqProject_file.mli +++ b/lib/coqProject_file.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/deque.ml b/lib/deque.ml index ac89a35b15..373269b4f5 100644 --- a/lib/deque.ml +++ b/lib/deque.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/deque.mli b/lib/deque.mli index 6963f1dbac..23cb1e4919 100644 --- a/lib/deque.mli +++ b/lib/deque.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/dyn.ml b/lib/dyn.ml index 65d1442ac6..6bd43455f6 100644 --- a/lib/dyn.ml +++ b/lib/dyn.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/dyn.mli b/lib/dyn.mli index 448b11a18f..e43c8a9bcf 100644 --- a/lib/dyn.mli +++ b/lib/dyn.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/envars.ml b/lib/envars.ml index 47baf66a69..68604ae6c9 100644 --- a/lib/envars.ml +++ b/lib/envars.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/envars.mli b/lib/envars.mli index 18b7676ce7..09f2b4ca19 100644 --- a/lib/envars.mli +++ b/lib/envars.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/explore.ml b/lib/explore.ml index aa7bddf2b4..7da077e968 100644 --- a/lib/explore.ml +++ b/lib/explore.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,7 +14,7 @@ module type SearchProblem = sig type state val branching : state -> state list val success : state -> bool - val pp : state -> std_ppcmds + val pp : state -> Pp.t end module Make = functor(S : SearchProblem) -> struct diff --git a/lib/explore.mli b/lib/explore.mli index 2b273e12b2..5875246ffc 100644 --- a/lib/explore.mli +++ b/lib/explore.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -27,7 +27,7 @@ module type SearchProblem = sig val success : state -> bool - val pp : state -> Pp.std_ppcmds + val pp : state -> Pp.t end diff --git a/lib/feedback.ml b/lib/feedback.ml index f6abf65120..54d16a9be3 100644 --- a/lib/feedback.ml +++ b/lib/feedback.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -32,7 +32,7 @@ type feedback_content = (* Extra metadata *) | Custom of Loc.t option * string * xml (* Generic messages *) - | Message of level * Loc.t option * Pp.std_ppcmds + | Message of level * Loc.t option * Pp.t type feedback = { id : Stateid.t; diff --git a/lib/feedback.mli b/lib/feedback.mli index dc104132a0..45a02d384a 100644 --- a/lib/feedback.mli +++ b/lib/feedback.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -40,7 +40,7 @@ type feedback_content = (* Extra metadata *) | Custom of Loc.t option * string * xml (* Generic messages *) - | Message of level * Loc.t option * Pp.std_ppcmds + | Message of level * Loc.t option * Pp.t type feedback = { id : Stateid.t; (* The document part concerned *) @@ -78,20 +78,20 @@ relaxed. *) (* Should we advertise these functions more? Should they be the ONLY allowed way to output something? *) -val msg_info : ?loc:Loc.t -> Pp.std_ppcmds -> unit +val msg_info : ?loc:Loc.t -> Pp.t -> unit (** Message that displays information, usually in verbose mode, such as [Foobar is defined] *) -val msg_notice : ?loc:Loc.t -> Pp.std_ppcmds -> unit +val msg_notice : ?loc:Loc.t -> Pp.t -> unit (** Message that should be displayed, such as [Print Foo] or [Show Bar]. *) -val msg_warning : ?loc:Loc.t -> Pp.std_ppcmds -> unit +val msg_warning : ?loc:Loc.t -> Pp.t -> unit (** Message indicating that something went wrong, but without serious consequences. *) -val msg_error : ?loc:Loc.t -> Pp.std_ppcmds -> unit +val msg_error : ?loc:Loc.t -> Pp.t -> unit (** Message indicating that something went really wrong, though still recoverable; otherwise an exception would have been raised. *) -val msg_debug : ?loc:Loc.t -> Pp.std_ppcmds -> unit +val msg_debug : ?loc:Loc.t -> Pp.t -> unit (** For debugging purposes *) diff --git a/lib/flags.ml b/lib/flags.ml index 46bbba8e55..027ba16f0e 100644 --- a/lib/flags.ml +++ b/lib/flags.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -106,7 +106,7 @@ let we_are_parsing = ref false (* Current means no particular compatibility consideration. For correct comparisons, this constructor should remain the last one. *) -type compat_version = VOld | V8_5 | V8_6 | Current +type compat_version = VOld | V8_5 | V8_6 | V8_7 | Current let compat_version = ref Current @@ -120,6 +120,9 @@ let version_compare v1 v2 = match v1, v2 with | V8_6, V8_6 -> 0 | V8_6, _ -> -1 | _, V8_6 -> 1 + | V8_7, V8_7 -> 0 + | V8_7, _ -> -1 + | _, V8_7 -> 1 | Current, Current -> 0 let version_strictly_greater v = version_compare !compat_version v > 0 @@ -129,6 +132,7 @@ let pr_version = function | VOld -> "old" | V8_5 -> "8.5" | V8_6 -> "8.6" + | V8_7 -> "8.7" | Current -> "current" (* Translate *) @@ -163,9 +167,9 @@ let use_polymorphic_flag () = let make_polymorphic_flag b = local_polymorphic_flag := Some b -let inductive_cumulativity = ref false -let make_inductive_cumulativity b = inductive_cumulativity := b -let is_inductive_cumulativity () = !inductive_cumulativity +let polymorphic_inductive_cumulativity = ref false +let make_polymorphic_inductive_cumulativity b = polymorphic_inductive_cumulativity := b +let is_polymorphic_inductive_cumulativity () = !polymorphic_inductive_cumulativity (** [program_mode] tells that Program mode has been activated, either globally via [Set Program] or locally via the Program command prefix. *) diff --git a/lib/flags.mli b/lib/flags.mli index 5e78f0a041..5af563b46e 100644 --- a/lib/flags.mli +++ b/lib/flags.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -77,7 +77,7 @@ val raw_print : bool ref (* Univ print flag, never set anywere. Maybe should belong to Univ? *) val univ_print : bool ref -type compat_version = VOld | V8_5 | V8_6 | Current +type compat_version = VOld | V8_5 | V8_6 | V8_7 | Current val compat_version : compat_version ref val version_compare : compat_version -> compat_version -> int val version_strictly_greater : compat_version -> bool @@ -119,9 +119,9 @@ val is_universe_polymorphism : unit -> bool val make_polymorphic_flag : bool -> unit val use_polymorphic_flag : unit -> bool -(** Global inductive cumulativity flag. *) -val make_inductive_cumulativity : bool -> unit -val is_inductive_cumulativity : unit -> bool +(** Global polymorphic inductive cumulativity flag. *) +val make_polymorphic_inductive_cumulativity : bool -> unit +val is_polymorphic_inductive_cumulativity : unit -> bool val warn : bool ref val make_warn : bool -> unit diff --git a/lib/future.ml b/lib/future.ml index 8bef1e58e1..d9463aa0f1 100644 --- a/lib/future.ml +++ b/lib/future.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/future.mli b/lib/future.mli index 2a025ae844..acfce51a07 100644 --- a/lib/future.mli +++ b/lib/future.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -154,7 +154,7 @@ val purify : ('a -> 'b) -> 'a -> 'b val transactify : ('a -> 'b) -> 'a -> 'b (** Debug: print a computation given an inner printing function. *) -val print : ('a -> Pp.std_ppcmds) -> 'a computation -> Pp.std_ppcmds +val print : ('a -> Pp.t) -> 'a computation -> Pp.t type freeze (* These functions are needed to get rid of side effects. @@ -162,5 +162,5 @@ type freeze deal with the whole system state. *) val set_freeze : (unit -> freeze) -> (freeze -> unit) -> unit -val customize_not_ready_msg : (string -> Pp.std_ppcmds) -> unit -val customize_not_here_msg : (string -> Pp.std_ppcmds) -> unit +val customize_not_ready_msg : (string -> Pp.t) -> unit +val customize_not_here_msg : (string -> Pp.t) -> unit diff --git a/lib/genarg.ml b/lib/genarg.ml index 377ff81827..b78fe40373 100644 --- a/lib/genarg.ml +++ b/lib/genarg.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -58,7 +58,7 @@ fun t1 t2 -> match t1, t2 with end | _ -> None -let rec pr_genarg_type : type a b c. (a, b, c) genarg_type -> std_ppcmds = function +let rec pr_genarg_type : type a b c. (a, b, c) genarg_type -> Pp.t = function | ListArg t -> pr_genarg_type t ++ spc () ++ str "list" | OptArg t -> pr_genarg_type t ++ spc () ++ str "opt" | PairArg (t1, t2) -> diff --git a/lib/genarg.mli b/lib/genarg.mli index d7ad9b93b4..7fa71299e3 100644 --- a/lib/genarg.mli +++ b/lib/genarg.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -146,7 +146,7 @@ val abstract_argument_type_eq : ('a, 'l) abstract_argument_type -> ('b, 'l) abstract_argument_type -> ('a, 'b) CSig.eq option -val pr_argument_type : argument_type -> Pp.std_ppcmds +val pr_argument_type : argument_type -> Pp.t (** Print a human-readable representation for a given type. *) val genarg_tag : 'a generic_argument -> argument_type diff --git a/lib/hMap.ml b/lib/hMap.ml index ea76e74272..c69efdb711 100644 --- a/lib/hMap.ml +++ b/lib/hMap.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hMap.mli b/lib/hMap.mli index c4e6a08e1b..c77bfced88 100644 --- a/lib/hMap.mli +++ b/lib/hMap.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hashcons.ml b/lib/hashcons.ml index 0ee3ec6277..ee22325811 100644 --- a/lib/hashcons.ml +++ b/lib/hashcons.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hashcons.mli b/lib/hashcons.mli index 150899cef5..fbd2ebcf9a 100644 --- a/lib/hashcons.mli +++ b/lib/hashcons.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hashset.ml b/lib/hashset.ml index af33544dc6..7f96627a68 100644 --- a/lib/hashset.ml +++ b/lib/hashset.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -181,7 +181,7 @@ module Make (E : EqType) = let sz = Weak.length bucket in let rec loop i = if i >= sz then ifnotfound index - else if h = hashes.(i) then begin + else if Int.equal h hashes.(i) then begin match Weak.get bucket i with | Some v when E.eq v d -> v | _ -> loop (i + 1) diff --git a/lib/hashset.mli b/lib/hashset.mli index 733c89621c..ec79205a5c 100644 --- a/lib/hashset.mli +++ b/lib/hashset.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/heap.ml b/lib/heap.ml index 97ccadeba8..a6109972d7 100644 --- a/lib/heap.ml +++ b/lib/heap.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/heap.mli b/lib/heap.mli index 0e77a3a068..93d504c5ac 100644 --- a/lib/heap.mli +++ b/lib/heap.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hook.ml b/lib/hook.ml index a370fe3578..14ca27bcf1 100644 --- a/lib/hook.ml +++ b/lib/hook.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/hook.mli b/lib/hook.mli index 50347f334f..df38abc53b 100644 --- a/lib/hook.mli +++ b/lib/hook.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/iStream.ml b/lib/iStream.ml index 26a666e176..d3a54332a1 100644 --- a/lib/iStream.ml +++ b/lib/iStream.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/iStream.mli b/lib/iStream.mli index 50f5389ba2..cd7940e8d3 100644 --- a/lib/iStream.mli +++ b/lib/iStream.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/int.ml b/lib/int.ml index 70bd742427..63f62154d8 100644 --- a/lib/int.ml +++ b/lib/int.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/int.mli b/lib/int.mli index 93d1be1f7d..b65367f7d4 100644 --- a/lib/int.mli +++ b/lib/int.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/loc.ml b/lib/loc.ml index ee759bdfc1..9f036d90f9 100644 --- a/lib/loc.ml +++ b/lib/loc.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/loc.mli b/lib/loc.mli index edcf701bf2..1fbaae8368 100644 --- a/lib/loc.mli +++ b/lib/loc.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/minisys.ml b/lib/minisys.ml index f15021c655..1ed017e489 100644 --- a/lib/minisys.ml +++ b/lib/minisys.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -44,7 +44,11 @@ let ok_dirname f = (* Check directory can be opened *) let exists_dir dir = - try Sys.is_directory dir with Sys_error _ -> false + let rec strip_trailing_slash dir = + let len = String.length dir in + if len > 0 && (dir.[len-1] = '/' || dir.[len-1] = '\\') + then strip_trailing_slash (String.sub dir 0 (len-1)) else dir in + try Sys.is_directory (strip_trailing_slash dir) with Sys_error _ -> false let apply_subdir f path name = (* we avoid all files and subdirs starting by '.' (e.g. .svn) *) diff --git a/lib/option.ml b/lib/option.ml index 50fdd079dc..7cedffef08 100644 --- a/lib/option.ml +++ b/lib/option.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/option.mli b/lib/option.mli index f06ad9f1d1..c4d1ebc3a7 100644 --- a/lib/option.mli +++ b/lib/option.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -39,7 +39,9 @@ type doc_view = (* Following discussion on #390, we play on the safe side and make the internal representation opaque here. *) type t = doc_view + type std_ppcmds = t +[@@ocaml.deprecated "alias of Pp.t"] let repr x = x let unrepr x = x @@ -153,7 +155,7 @@ let rec pr_com ft s = | None -> () (* pretty printing functions *) -let pp_with ft = +let pp_with ft pp = let cpp_open_box = function | Pp_hbox n -> Format.pp_open_hbox ft () | Pp_vbox n -> Format.pp_open_vbox ft n @@ -175,7 +177,7 @@ let pp_with ft = pp_cmd s; pp_close_tag ft () in - try pp_cmd + try pp_cmd pp with reraise -> let reraise = Backtrace.add_backtrace reraise in let () = Format.pp_print_flush ft () in @@ -220,23 +222,25 @@ let prlist pr l = Ppcmd_glue (List.map pr l) if a strict behavior is needed, use [prlist_strict] instead. evaluation is done from left to right. *) -let prlist_sep_lastsep no_empty sep lastsep elem = - let rec start = function - |[] -> mt () - |[e] -> elem e - |h::t -> let e = elem h in - if no_empty && ismt e then start t else - let rec aux = function - |[] -> mt () - |h::t -> - let e = elem h and r = aux t in - if no_empty && ismt e then r else - if ismt r - then let s = lastsep () in s ++ e - else let s = sep () in s ++ e ++ r - in let r = aux t in e ++ r - in start - +let prlist_sep_lastsep no_empty sep_thunk lastsep_thunk elem l = + let sep = sep_thunk () in + let lastsep = lastsep_thunk () in + let elems = List.map elem l in + let filtered_elems = + if no_empty then + List.filter (fun e -> not (ismt e)) elems + else + elems + in + let rec insert_seps es = + match es with + | [] -> mt () + | [e] -> e + | h::[e] -> h ++ lastsep ++ e + | h::t -> h ++ sep ++ insert_seps t + in + insert_seps filtered_elems + let prlist_strict pr l = prlist_sep_lastsep true mt mt pr l (* [prlist_with_sep sep pr [a ; ... ; c]] outputs [pr a ++ sep() ++ ... ++ sep() ++ pr c] *) diff --git a/lib/pp.mli b/lib/pp.mli index 45834dade5..2d11cad86e 100644 --- a/lib/pp.mli +++ b/lib/pp.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,7 @@ (** Pretty printing guidelines ******************************************) (* *) -(* `Pp.t` or `Pp.std_ppcmds` is the main pretty printing document type *) +(* `Pp.t` is the main pretty printing document type *) (* in the Coq system. Documents are composed laying out boxes, and *) (* users can add arbitrary tag metadata that backends are free *) (* to interpret. *) @@ -39,7 +39,9 @@ type pp_tag = string (* Following discussion on #390, we play on the safe side and make the internal representation opaque here. *) type t + type std_ppcmds = t +[@@ocaml.deprecated "alias of Pp.t"] type block_type = | Pp_hbox of int @@ -58,124 +60,127 @@ type doc_view = | Ppcmd_force_newline | Ppcmd_comment of string list -val repr : std_ppcmds -> doc_view -val unrepr : doc_view -> std_ppcmds +val repr : t -> doc_view +val unrepr : doc_view -> t (** {6 Formatting commands} *) -val str : string -> std_ppcmds -val brk : int * int -> std_ppcmds -val fnl : unit -> std_ppcmds -val ws : int -> std_ppcmds -val mt : unit -> std_ppcmds -val ismt : std_ppcmds -> bool +val str : string -> t +val brk : int * int -> t +val fnl : unit -> t +val ws : int -> t +val mt : unit -> t +val ismt : t -> bool -val comment : string list -> std_ppcmds +val comment : string list -> t (** {6 Manipulation commands} *) -val app : std_ppcmds -> std_ppcmds -> std_ppcmds +val app : t -> t -> t (** Concatenation. *) -val seq : std_ppcmds list -> std_ppcmds +val seq : t list -> t (** Multi-Concatenation. *) -val (++) : std_ppcmds -> std_ppcmds -> std_ppcmds +val (++) : t -> t -> t (** Infix alias for [app]. *) (** {6 Derived commands} *) -val spc : unit -> std_ppcmds -val cut : unit -> std_ppcmds -val align : unit -> std_ppcmds -val int : int -> std_ppcmds -val real : float -> std_ppcmds -val bool : bool -> std_ppcmds -val qstring : string -> std_ppcmds -val qs : string -> std_ppcmds -val quote : std_ppcmds -> std_ppcmds -val strbrk : string -> std_ppcmds +val spc : unit -> t +val cut : unit -> t +val align : unit -> t +val int : int -> t +val real : float -> t +val bool : bool -> t +val qstring : string -> t +val qs : string -> t +val quote : t -> t +val strbrk : string -> t (** {6 Boxing commands} *) -val h : int -> std_ppcmds -> std_ppcmds -val v : int -> std_ppcmds -> std_ppcmds -val hv : int -> std_ppcmds -> std_ppcmds -val hov : int -> std_ppcmds -> std_ppcmds +val h : int -> t -> t +val v : int -> t -> t +val hv : int -> t -> t +val hov : int -> t -> t (** {6 Tagging} *) -val tag : pp_tag -> std_ppcmds -> std_ppcmds +val tag : pp_tag -> t -> t (** {6 Printing combinators} *) -val pr_comma : unit -> std_ppcmds +val pr_comma : unit -> t (** Well-spaced comma. *) -val pr_semicolon : unit -> std_ppcmds +val pr_semicolon : unit -> t (** Well-spaced semicolon. *) -val pr_bar : unit -> std_ppcmds +val pr_bar : unit -> t (** Well-spaced pipe bar. *) -val pr_arg : ('a -> std_ppcmds) -> 'a -> std_ppcmds +val pr_arg : ('a -> t) -> 'a -> t (** Adds a space in front of its argument. *) -val pr_non_empty_arg : ('a -> std_ppcmds) -> 'a -> std_ppcmds +val pr_non_empty_arg : ('a -> t) -> 'a -> t (** Adds a space in front of its argument if non empty. *) -val pr_opt : ('a -> std_ppcmds) -> 'a option -> std_ppcmds +val pr_opt : ('a -> t) -> 'a option -> t (** Inner object preceded with a space if [Some], nothing otherwise. *) -val pr_opt_no_spc : ('a -> std_ppcmds) -> 'a option -> std_ppcmds +val pr_opt_no_spc : ('a -> t) -> 'a option -> t (** Same as [pr_opt] but without the leading space. *) -val pr_nth : int -> std_ppcmds +val pr_nth : int -> t (** Ordinal number with the correct suffix (i.e. "st", "nd", "th", etc.). *) -val prlist : ('a -> std_ppcmds) -> 'a list -> std_ppcmds +val prlist : ('a -> t) -> 'a list -> t (** Concatenation of the list contents, without any separator. Unlike all other functions below, [prlist] works lazily. If a strict behavior is needed, use [prlist_strict] instead. *) -val prlist_strict : ('a -> std_ppcmds) -> 'a list -> std_ppcmds +val prlist_strict : ('a -> t) -> 'a list -> t (** Same as [prlist], but strict. *) val prlist_with_sep : - (unit -> std_ppcmds) -> ('a -> std_ppcmds) -> 'a list -> std_ppcmds + (unit -> t) -> ('a -> t) -> 'a list -> t (** [prlist_with_sep sep pr [a ; ... ; c]] outputs - [pr a ++ sep() ++ ... ++ sep() ++ pr c]. *) + [pr a ++ sep () ++ ... ++ sep () ++ pr c]. + where the thunk sep is memoized, rather than being called each place + its result is used. +*) -val prvect : ('a -> std_ppcmds) -> 'a array -> std_ppcmds +val prvect : ('a -> t) -> 'a array -> t (** As [prlist], but on arrays. *) -val prvecti : (int -> 'a -> std_ppcmds) -> 'a array -> std_ppcmds +val prvecti : (int -> 'a -> t) -> 'a array -> t (** Indexed version of [prvect]. *) val prvect_with_sep : - (unit -> std_ppcmds) -> ('a -> std_ppcmds) -> 'a array -> std_ppcmds + (unit -> t) -> ('a -> t) -> 'a array -> t (** As [prlist_with_sep], but on arrays. *) val prvecti_with_sep : - (unit -> std_ppcmds) -> (int -> 'a -> std_ppcmds) -> 'a array -> std_ppcmds + (unit -> t) -> (int -> 'a -> t) -> 'a array -> t (** Indexed version of [prvect_with_sep]. *) -val pr_enum : ('a -> std_ppcmds) -> 'a list -> std_ppcmds +val pr_enum : ('a -> t) -> 'a list -> t (** [pr_enum pr [a ; b ; ... ; c]] outputs [pr a ++ str "," ++ pr b ++ str "," ++ ... ++ str "and" ++ pr c]. *) -val pr_sequence : ('a -> std_ppcmds) -> 'a list -> std_ppcmds +val pr_sequence : ('a -> t) -> 'a list -> t (** Sequence of objects separated by space (unless an element is empty). *) -val surround : std_ppcmds -> std_ppcmds +val surround : t -> t (** Surround with parenthesis. *) -val pr_vertical_list : ('b -> std_ppcmds) -> 'b list -> std_ppcmds +val pr_vertical_list : ('b -> t) -> 'b list -> t (** {6 Main renderers, to formatter and to string } *) (** [pp_with fmt pp] Print [pp] to [fmt] and don't flush [fmt] *) -val pp_with : Format.formatter -> std_ppcmds -> unit +val pp_with : Format.formatter -> t -> unit -val string_of_ppcmds : std_ppcmds -> string +val string_of_ppcmds : t -> string diff --git a/lib/profile.ml b/lib/profile.ml index d620fe69c4..0bc226a450 100644 --- a/lib/profile.ml +++ b/lib/profile.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -85,6 +85,9 @@ let init_alloc = ref 0.0 let reset_profile () = List.iter reset_record !prof_table let init_profile () = + (* We test Flags.profile as a way to support declaring profiled + functions in plugins *) + if !prof_table <> [] || Flags.profile then begin let outside = create_record () in stack := [outside]; last_alloc := get_alloc (); @@ -92,6 +95,7 @@ let init_profile () = init_time := get_time (); outside.tottime <- - !init_time; outside.owntime <- - !init_time + end let ajoute n o = o.owntime <- o.owntime + n.owntime; @@ -317,15 +321,15 @@ let adjust_time ov_bc ov_ad e = owntime = e.owntime - int_of_float (ad_imm +. bc_imm) } let close_profile print = - let dw = spent_alloc () in - let t = get_time () in - match !stack with - | [outside] -> - outside.tottime <- outside.tottime + t; - outside.owntime <- outside.owntime + t; - ajoute_ownalloc outside dw; - ajoute_totalloc outside dw; - if !prof_table <> [] then begin + if !prof_table <> [] then begin + let dw = spent_alloc () in + let t = get_time () in + match !stack with + | [outside] -> + outside.tottime <- outside.tottime + t; + outside.owntime <- outside.owntime + t; + ajoute_ownalloc outside dw; + ajoute_totalloc outside dw; let ov_bc = time_overhead_B_C () (* B+C overhead *) in let ov_ad = time_overhead_A_D () (* A+D overhead *) in let adjust (n,e) = (n, adjust_time ov_bc ov_ad e) in @@ -346,8 +350,8 @@ let close_profile print = in if print then format_profile updated_data; init_profile () - end - | _ -> failwith "Inconsistency" + | _ -> failwith "Inconsistency" + end let print_profile () = close_profile true @@ -358,9 +362,6 @@ let declare_profile name = prof_table := (name,e)::!prof_table; e -(* Default initialization, may be overridden *) -let _ = init_profile () - (******************************) (* Entry points for profiling *) let profile1 e f a = diff --git a/lib/profile.mli b/lib/profile.mli index 3328d7ea3c..cae4397a11 100644 --- a/lib/profile.mli +++ b/lib/profile.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/remoteCounter.ml b/lib/remoteCounter.ml index 11f151a609..4358d6b2bc 100644 --- a/lib/remoteCounter.ml +++ b/lib/remoteCounter.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/remoteCounter.mli b/lib/remoteCounter.mli index 1b0fa6a00e..c262e50e5b 100644 --- a/lib/remoteCounter.mli +++ b/lib/remoteCounter.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/rtree.ml b/lib/rtree.ml index f89b98c046..6d3875fac4 100644 --- a/lib/rtree.ml +++ b/lib/rtree.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/rtree.mli b/lib/rtree.mli index e27134c3b6..1a916bbaf0 100644 --- a/lib/rtree.mli +++ b/lib/rtree.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -78,7 +78,7 @@ val map : ('a -> 'b) -> 'a t -> 'b t val smartmap : ('a -> 'a) -> 'a t -> 'a t (** A rather simple minded pretty-printer *) -val pp_tree : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds +val pp_tree : ('a -> Pp.t) -> 'a t -> Pp.t val eq_rtree : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** @deprecated Same as [Rtree.equal] *) diff --git a/lib/spawn.ml b/lib/spawn.ml index 4d7e78d861..0cf163e737 100644 --- a/lib/spawn.ml +++ b/lib/spawn.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/spawn.mli b/lib/spawn.mli index 9b86b09549..a131715e9d 100644 --- a/lib/spawn.mli +++ b/lib/spawn.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/system.ml b/lib/system.ml index e0e2c829d9..12eacf2eaf 100644 --- a/lib/system.ml +++ b/lib/system.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/system.mli b/lib/system.mli index 214369095c..7281de97c9 100644 --- a/lib/system.mli +++ b/lib/system.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -96,7 +96,7 @@ type time val get_time : unit -> time val time_difference : time -> time -> float (** in seconds *) -val fmt_time_difference : time -> time -> Pp.std_ppcmds +val fmt_time_difference : time -> time -> Pp.t val with_time : bool -> ('a -> 'b) -> 'a -> 'b diff --git a/lib/terminal.ml b/lib/terminal.ml index de21f10280..34efddfbca 100644 --- a/lib/terminal.ml +++ b/lib/terminal.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -35,6 +35,8 @@ type style = { italic : bool option; underline : bool option; negative : bool option; + prefix : string option; + suffix : string option; } let set o1 o2 = match o1 with @@ -51,9 +53,11 @@ let default = { italic = None; underline = None; negative = None; + prefix = None; + suffix = None; } -let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style () = +let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style ?prefix ?suffix () = let st = match style with | None -> default | Some st -> st @@ -65,6 +69,8 @@ let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style () = italic = set st.italic italic; underline = set st.underline underline; negative = set st.negative negative; + prefix = set st.prefix prefix; + suffix = set st.suffix suffix; } let merge s1 s2 = @@ -75,6 +81,8 @@ let merge s1 s2 = italic = set s1.italic s2.italic; underline = set s1.underline s2.underline; negative = set s1.negative s2.negative; + prefix = set s1.prefix s2.prefix; + suffix = set s1.suffix s2.suffix; } let base_color = function @@ -168,6 +176,8 @@ let reset_style = { italic = Some false; underline = Some false; negative = Some false; + prefix = None; + suffix = None; } let has_style t = diff --git a/lib/terminal.mli b/lib/terminal.mli index e0fd7f2284..b1b76e6e2a 100644 --- a/lib/terminal.mli +++ b/lib/terminal.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -35,11 +35,14 @@ type style = { italic : bool option; underline : bool option; negative : bool option; + prefix : string option; + suffix : string option; } val make : ?fg_color:color -> ?bg_color:color -> ?bold:bool -> ?italic:bool -> ?underline:bool -> - ?negative:bool -> ?style:style -> unit -> style + ?negative:bool -> ?style:style -> + ?prefix:string -> ?suffix:string -> unit -> style (** Create a style from the given flags. It is derived from the optional [style] argument if given. *) diff --git a/lib/trie.ml b/lib/trie.ml index 0309fde9b2..0b0ba27613 100644 --- a/lib/trie.ml +++ b/lib/trie.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/trie.mli b/lib/trie.mli index de67e8f967..a87acc8a69 100644 --- a/lib/trie.mli +++ b/lib/trie.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/unicode.mli b/lib/unicode.mli index 2609e1968f..c7d7424801 100644 --- a/lib/unicode.mli +++ b/lib/unicode.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/unionfind.ml b/lib/unionfind.ml index 6e131d8fbd..f9c92d6a8e 100644 --- a/lib/unionfind.ml +++ b/lib/unionfind.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/unionfind.mli b/lib/unionfind.mli index ea249ae2e8..b242232edb 100644 --- a/lib/unionfind.mli +++ b/lib/unionfind.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/util.mli b/lib/util.mli index 56ec5394eb..d910e7e28e 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/lib/xml_datatype.mli b/lib/xml_datatype.mli index a8e37935ba..c55f8c2f3e 100644 --- a/lib/xml_datatype.mli +++ b/lib/xml_datatype.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/coqlib.ml b/library/coqlib.ml index 0cb8c7afcf..8787738af9 100644 --- a/library/coqlib.ml +++ b/library/coqlib.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/coqlib.mli b/library/coqlib.mli index 716d97c9d0..1e3c37a9ed 100644 --- a/library/coqlib.mli +++ b/library/coqlib.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/declaremods.ml b/library/declaremods.ml index 187b749b87..e7aa5bd0d6 100644 --- a/library/declaremods.ml +++ b/library/declaremods.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/declaremods.mli b/library/declaremods.mli index 3917fe8d64..005594b8d8 100644 --- a/library/declaremods.mli +++ b/library/declaremods.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -121,7 +121,7 @@ val iter_all_segments : (Libnames.object_name -> Libobject.obj -> unit) -> unit -val debug_print_modtab : unit -> Pp.std_ppcmds +val debug_print_modtab : unit -> Pp.t (** For printing modules, [process_module_binding] adds names of bound module (and its components) to Nametab. It also loads diff --git a/library/decls.ml b/library/decls.ml index 2952c258a5..973fe144dd 100644 --- a/library/decls.ml +++ b/library/decls.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/decls.mli b/library/decls.mli index 1ca7f89469..478f0bca0d 100644 --- a/library/decls.mli +++ b/library/decls.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/dischargedhypsmap.ml b/library/dischargedhypsmap.ml index cea1fd7d6e..1673e13cca 100644 --- a/library/dischargedhypsmap.ml +++ b/library/dischargedhypsmap.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/dischargedhypsmap.mli b/library/dischargedhypsmap.mli index ea4a9424e5..69bb6744e5 100644 --- a/library/dischargedhypsmap.mli +++ b/library/dischargedhypsmap.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/global.ml b/library/global.ml index 6d80012f47..963c977417 100644 --- a/library/global.ml +++ b/library/global.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -86,6 +86,7 @@ let push_context b c = globalize0 (Safe_typing.push_context b c) let set_engagement c = globalize0 (Safe_typing.set_engagement c) let set_typing_flags c = globalize0 (Safe_typing.set_typing_flags c) +let export_private_constants ~in_section cd = globalize (Safe_typing.export_private_constants ~in_section cd) let add_constant dir id d = globalize (Safe_typing.add_constant dir (i2l id) d) let add_mind dir id mie = globalize (Safe_typing.add_mind dir (i2l id) mie) let add_modtype id me inl = globalize (Safe_typing.add_modtype (i2l id) me inl) @@ -122,12 +123,22 @@ let lookup_modtype kn = lookup_modtype kn (env()) let exists_objlabel id = Safe_typing.exists_objlabel id (safe_env ()) let opaque_tables () = Environ.opaque_tables (env ()) -let body_of_constant_body cb = Declareops.body_of_constant (opaque_tables ()) cb + +let instantiate cb c = + let open Declarations in + match cb.const_universes with + | Monomorphic_const _ -> c, Univ.AUContext.empty + | Polymorphic_const ctx -> c, ctx + +let body_of_constant_body cb = + let open Declarations in + let otab = opaque_tables () in + match cb.const_body with + | Undef _ -> None + | Def c -> Some (instantiate cb (Mod_subst.force_constr c)) + | OpaqueDef o -> Some (instantiate cb (Opaqueproof.force_proof otab o)) + let body_of_constant cst = body_of_constant_body (lookup_constant cst) -let constraints_of_constant_body cb = - Declareops.constraints_of_constant (opaque_tables ()) cb -let universes_of_constant_body cb = - Declareops.universes_of_constant (opaque_tables ()) cb (** Operations on kernel names *) @@ -163,54 +174,52 @@ open Globnames (** Build a fresh instance for a given context, its associated substitution and the instantiated constraints. *) -let type_of_global_unsafe r = - let env = env() in +let constr_of_global_in_context env r = + let open Constr in match r with - | VarRef id -> Environ.named_type id env - | ConstRef c -> - let cb = Environ.lookup_constant c env in - let univs = - Declareops.universes_of_polymorphic_constant - (Environ.opaque_tables env) cb in - let ty = Typeops.type_of_constant_type env cb.Declarations.const_type in - Vars.subst_instance_constr (Univ.UContext.instance univs) ty + | VarRef id -> mkVar id, Univ.AUContext.empty + | ConstRef c -> + let cb = Environ.lookup_constant c env in + let univs = Declareops.constant_polymorphic_context cb in + mkConstU (c, Univ.make_abstract_instance univs), univs | IndRef ind -> - let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in - let inst = Declareops.inductive_polymorphic_instance mib in - Inductive.type_of_inductive env (specif, inst) + let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in + let univs = Declareops.inductive_polymorphic_context mib in + mkIndU (ind, Univ.make_abstract_instance univs), univs | ConstructRef cstr -> - let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in - let inst = Declareops.inductive_polymorphic_instance mib in - Inductive.type_of_constructor (cstr,inst) specif + let (mib,oib as specif) = + Inductive.lookup_mind_specif env (inductive_of_constructor cstr) + in + let univs = Declareops.inductive_polymorphic_context mib in + mkConstructU (cstr, Univ.make_abstract_instance univs), univs let type_of_global_in_context env r = match r with - | VarRef id -> Environ.named_type id env, Univ.UContext.empty + | VarRef id -> Environ.named_type id env, Univ.AUContext.empty | ConstRef c -> - let cb = Environ.lookup_constant c env in - let univs = - Declareops.universes_of_polymorphic_constant - (Environ.opaque_tables env) cb in - Typeops.type_of_constant_type env cb.Declarations.const_type, univs + let cb = Environ.lookup_constant c env in + let univs = Declareops.constant_polymorphic_context cb in + cb.Declarations.const_type, univs | IndRef ind -> - let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in - let univs = Declareops.inductive_polymorphic_context mib in - Inductive.type_of_inductive env (specif, Univ.UContext.instance univs), univs + let (mib, oib as specif) = Inductive.lookup_mind_specif env ind in + let univs = Declareops.inductive_polymorphic_context mib in + let inst = Univ.make_abstract_instance univs in + let env = Environ.push_context ~strict:false (Univ.AUContext.repr univs) env in + Inductive.type_of_inductive env (specif, inst), univs | ConstructRef cstr -> let (mib,oib as specif) = Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in let univs = Declareops.inductive_polymorphic_context mib in - let inst = Univ.UContext.instance univs in + let inst = Univ.make_abstract_instance univs in Inductive.type_of_constructor (cstr,inst) specif, univs let universes_of_global env r = match r with - | VarRef id -> Univ.UContext.empty + | VarRef id -> Univ.AUContext.empty | ConstRef c -> let cb = Environ.lookup_constant c env in - Declareops.universes_of_polymorphic_constant - (Environ.opaque_tables env) cb + Declareops.constant_polymorphic_context cb | IndRef ind -> let (mib, oib) = Inductive.lookup_mind_specif env ind in Declareops.inductive_polymorphic_context mib @@ -245,7 +254,7 @@ let is_template_polymorphic r = let env = env() in match r with | VarRef id -> false - | ConstRef c -> Environ.template_polymorphic_constant c env + | ConstRef c -> false | IndRef ind -> Environ.template_polymorphic_ind ind env | ConstructRef cstr -> Environ.template_polymorphic_ind (inductive_of_constructor cstr) env diff --git a/library/global.mli b/library/global.mli index a4a38ce846..c777691d11 100644 --- a/library/global.mli +++ b/library/global.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -34,9 +34,12 @@ val set_typing_flags : Declarations.typing_flags -> unit val push_named_assum : (Id.t * Constr.types * bool) Univ.in_universe_context_set -> unit val push_named_def : (Id.t * Safe_typing.private_constants Entries.definition_entry) -> Univ.universe_context_set +val export_private_constants : in_section:bool -> + Safe_typing.private_constants Entries.constant_entry -> + unit Entries.constant_entry * Safe_typing.exported_private_constant list + val add_constant : - DirPath.t -> Id.t -> Safe_typing.global_declaration -> - constant * Safe_typing.exported_private_constant list + DirPath.t -> Id.t -> Safe_typing.global_declaration -> constant val add_mind : DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> mutual_inductive @@ -89,12 +92,15 @@ val constant_of_delta_kn : kernel_name -> constant val mind_of_delta_kn : kernel_name -> mutual_inductive val opaque_tables : unit -> Opaqueproof.opaquetab -val body_of_constant : constant -> Term.constr option -val body_of_constant_body : Declarations.constant_body -> Term.constr option -val constraints_of_constant_body : - Declarations.constant_body -> Univ.constraints -val universes_of_constant_body : - Declarations.constant_body -> Univ.universe_context + +val body_of_constant : constant -> (Term.constr * Univ.AUContext.t) option +(** Returns the body of the constant if it has any, and the polymorphic context + it lives in. For monomorphic constant, the latter is empty, and for + polymorphic constants, the term contains De Bruijn universe variables that + need to be instantiated. *) + +val body_of_constant_body : Declarations.constant_body -> (Term.constr * Univ.AUContext.t) option +(** Same as {!body_of_constant} but on {!Declarations.constant_body}. *) (** Global universe name <-> level mapping *) type universe_names = @@ -126,26 +132,22 @@ val is_polymorphic : Globnames.global_reference -> bool val is_template_polymorphic : Globnames.global_reference -> bool val is_type_in_type : Globnames.global_reference -> bool -val type_of_global_in_context : Environ.env -> - Globnames.global_reference -> Constr.types Univ.in_universe_context -(** Returns the type of the constant in its global or local universe +val constr_of_global_in_context : Environ.env -> + Globnames.global_reference -> Constr.types * Univ.AUContext.t +(** Returns the type of the constant in its local universe context. The type should not be used without pushing it's universe context in the environmnent of usage. For non-universe-polymorphic constants, it does not matter. *) -val type_of_global_unsafe : Globnames.global_reference -> Constr.types -(** Returns the type of the constant, forgetting its universe context if - it is polymorphic, use with care: for polymorphic constants, the - type cannot be used to produce a term used by the kernel. For safe - handling of polymorphic global references, one should look at a - particular instantiation of the reference, in some particular - universe context (part of an [env] or [evar_map]), see - e.g. [type_of_constant_in]. If you want to create a fresh instance - of the reference and get its type look at [Evd.fresh_global] or - [Evarutil.new_global] and [Retyping.get_type_of]. *) +val type_of_global_in_context : Environ.env -> + Globnames.global_reference -> Constr.types * Univ.AUContext.t +(** Returns the type of the constant in its local universe + context. The type should not be used without pushing it's universe + context in the environmnent of usage. For non-universe-polymorphic + constants, it does not matter. *) (** Returns the universe context of the global reference (whatever its polymorphic status is). *) -val universes_of_global : Globnames.global_reference -> Univ.universe_context +val universes_of_global : Globnames.global_reference -> Univ.abstract_universe_context (** {6 Retroknowledge } *) diff --git a/library/globnames.ml b/library/globnames.ml index 9aeb379737..dc9541a0d5 100644 --- a/library/globnames.ml +++ b/library/globnames.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/globnames.mli b/library/globnames.mli index f4956e3df2..0b5971b6e1 100644 --- a/library/globnames.mli +++ b/library/globnames.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/goptions.ml b/library/goptions.ml index a305214e82..184c6fa119 100644 --- a/library/goptions.ml +++ b/library/goptions.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,10 +57,10 @@ module MakeTable = val table : (string * key table_of_A) list ref val encode : key -> t val subst : substitution -> t -> t - val printer : t -> std_ppcmds + val printer : t -> Pp.t val key : option_name val title : string - val member_message : t -> bool -> std_ppcmds + val member_message : t -> bool -> Pp.t end) -> struct type option_mark = @@ -131,7 +131,7 @@ module type StringConvertArg = sig val key : option_name val title : string - val member_message : string -> bool -> std_ppcmds + val member_message : string -> bool -> Pp.t end module StringConvert = functor (A : StringConvertArg) -> @@ -161,10 +161,10 @@ sig val compare : t -> t -> int val encode : reference -> t val subst : substitution -> t -> t - val printer : t -> std_ppcmds + val printer : t -> Pp.t val key : option_name val title : string - val member_message : t -> bool -> std_ppcmds + val member_message : t -> bool -> Pp.t end module RefConvert = functor (A : RefConvertArg) -> diff --git a/library/goptions.mli b/library/goptions.mli index f612c4e369..cec7250f1f 100644 --- a/library/goptions.mli +++ b/library/goptions.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,7 +43,6 @@ All options are synchronized with the document. *) -open Pp open Libnames open Mod_subst @@ -64,7 +63,7 @@ module MakeStringTable : (A : sig val key : option_name val title : string - val member_message : string -> bool -> std_ppcmds + val member_message : string -> bool -> Pp.t end) -> sig val active : string -> bool @@ -88,10 +87,10 @@ module MakeRefTable : val compare : t -> t -> int val encode : reference -> t val subst : substitution -> t -> t - val printer : t -> std_ppcmds + val printer : t -> Pp.t val key : option_name val title : string - val member_message : t -> bool -> std_ppcmds + val member_message : t -> bool -> Pp.t end) -> sig val active : A.t -> bool @@ -177,6 +176,6 @@ type option_state = { } val get_tables : unit -> option_state OptionMap.t -val print_tables : unit -> std_ppcmds +val print_tables : unit -> Pp.t val error_undeclared_key : option_name -> 'a diff --git a/library/heads.ml b/library/heads.ml index 6aee63c744..c12fa94791 100644 --- a/library/heads.ml +++ b/library/heads.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -128,11 +128,11 @@ let compute_head = function let is_Def = function Declarations.Def _ -> true | _ -> false in let body = if cb.Declarations.const_proj = None && is_Def cb.Declarations.const_body - then Declareops.body_of_constant (Environ.opaque_tables env) cb else None + then Global.body_of_constant cst else None in (match body with | None -> RigidHead (RigidParameter cst) - | Some c -> kind_of_head env c) + | Some (c, _) -> kind_of_head env c) | EvalVarRef id -> (match Global.lookup_named id with | LocalDef (_,c,_) when not (Decls.variable_opacity id) -> diff --git a/library/heads.mli b/library/heads.mli index 5acf5f54f7..1ce66c841e 100644 --- a/library/heads.mli +++ b/library/heads.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/keys.ml b/library/keys.ml index c9e325ee57..be53aabaa4 100644 --- a/library/keys.ml +++ b/library/keys.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/keys.mli b/library/keys.mli index 6abac4de44..d5dc0e2a1f 100644 --- a/library/keys.mli +++ b/library/keys.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -19,5 +19,5 @@ val equiv_keys : key -> key -> bool val constr_key : ('a -> ('a, 't, 'u, 'i) Constr.kind_of_term) -> 'a -> key option (** Compute the head key of a term. *) -val pr_keys : (global_reference -> Pp.std_ppcmds) -> Pp.std_ppcmds +val pr_keys : (global_reference -> Pp.t) -> Pp.t (** Pretty-print the mapping *) diff --git a/library/kindops.ml b/library/kindops.ml index 623d2537aa..882f620862 100644 --- a/library/kindops.ml +++ b/library/kindops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/kindops.mli b/library/kindops.mli index 3e95eaa7d9..77979c9159 100644 --- a/library/kindops.mli +++ b/library/kindops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/lib.ml b/library/lib.ml index 8127316d73..a24d20c681 100644 --- a/library/lib.ml +++ b/library/lib.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -465,9 +465,10 @@ let add_section_replacement f g poly hyps = let () = check_same_poly poly vars in let sechyps,ctx = extract_hyps (vars,hyps) in let ctx = Univ.ContextSet.to_context ctx in + let inst = Univ.UContext.instance ctx in let subst, ctx = Univ.abstract_universes ctx in let args = instance_from_variable_context (List.rev sechyps) in - sectab := (vars,f (Univ.AUContext.instance ctx,args) exps, + sectab := (vars,f (inst,args) exps, g (sechyps,subst,ctx) abs)::sl let add_section_kn poly kn = @@ -644,3 +645,16 @@ let discharge_con cst = let discharge_inductive (kn,i) = (discharge_kn kn,i) + +let discharge_abstract_universe_context (_, subst, abs_ctx) auctx = + let open Univ in + let len = LMap.cardinal subst in + let rec gen_subst i acc = + if i < 0 then acc + else + let acc = LMap.add (Level.var i) (Level.var (i + len)) acc in + gen_subst (pred i) acc + in + let subst = gen_subst (AUContext.size auctx - 1) subst in + let auctx = Univ.subst_univs_level_abstract_universe_context subst auctx in + subst, AUContext.union abs_ctx auctx diff --git a/library/lib.mli b/library/lib.mli index 284d339801..f1c9bfca24 100644 --- a/library/lib.mli +++ b/library/lib.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -183,3 +183,5 @@ val discharge_kn : Names.mutual_inductive -> Names.mutual_inductive val discharge_con : Names.constant -> Names.constant val discharge_global : Globnames.global_reference -> Globnames.global_reference val discharge_inductive : Names.inductive -> Names.inductive +val discharge_abstract_universe_context : + abstr_info -> Univ.AUContext.t -> Univ.universe_level_subst * Univ.AUContext.t diff --git a/library/libnames.ml b/library/libnames.ml index 50f28b0205..0453f15e87 100644 --- a/library/libnames.ml +++ b/library/libnames.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/libnames.mli b/library/libnames.mli index 57013ef82e..1b351290a4 100644 --- a/library/libnames.mli +++ b/library/libnames.mli @@ -1,20 +1,19 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) open Util -open Pp open Loc open Names (** {6 Dirpaths } *) (** FIXME: ought to be in Names.dir_path *) -val pr_dirpath : DirPath.t -> Pp.std_ppcmds +val pr_dirpath : DirPath.t -> Pp.t val dirpath_of_string : string -> DirPath.t val string_of_dirpath : DirPath.t -> string @@ -58,7 +57,7 @@ val basename : full_path -> Id.t (** Parsing and printing of section path as ["coq_root.module.id"] *) val path_of_string : string -> full_path val string_of_path : full_path -> string -val pr_path : full_path -> std_ppcmds +val pr_path : full_path -> Pp.t module Spmap : CSig.MapS with type key = full_path @@ -77,7 +76,7 @@ val repr_qualid : qualid -> DirPath.t * Id.t val qualid_eq : qualid -> qualid -> bool -val pr_qualid : qualid -> std_ppcmds +val pr_qualid : qualid -> Pp.t val string_of_qualid : qualid -> string val qualid_of_string : string -> qualid @@ -124,7 +123,7 @@ type reference = val eq_reference : reference -> reference -> bool val qualid_of_reference : reference -> qualid located val string_of_reference : reference -> string -val pr_reference : reference -> std_ppcmds +val pr_reference : reference -> Pp.t val loc_of_reference : reference -> Loc.t option val join_reference : reference -> reference -> reference diff --git a/library/libobject.ml b/library/libobject.ml index 897591762c..013c6fa0a5 100644 --- a/library/libobject.ml +++ b/library/libobject.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/libobject.mli b/library/libobject.mli index 51b9af059f..6f935bffea 100644 --- a/library/libobject.mli +++ b/library/libobject.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -56,6 +56,9 @@ open Mod_subst rebuild the non volatile content of a section from the data collected by the discharge function + Any type defined as a persistent object must be pure (e.g. no references) and + marshallable by the OCaml Marshal module (e.g. no closures). + *) type 'a substitutivity = diff --git a/library/library.ml b/library/library.ml index db05ad2b7b..20ecc2c229 100644 --- a/library/library.ml +++ b/library/library.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/library.mli b/library/library.mli index b9044b60dd..604167804d 100644 --- a/library/library.mli +++ b/library/library.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/loadpath.ml b/library/loadpath.ml index ad429ea840..757e972b1a 100644 --- a/library/loadpath.ml +++ b/library/loadpath.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/loadpath.mli b/library/loadpath.mli index 4e79edbdcf..26ed30674a 100644 --- a/library/loadpath.mli +++ b/library/loadpath.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/nameops.ml b/library/nameops.ml index 0b5dfd8d0e..adfe6f5a5d 100644 --- a/library/nameops.ml +++ b/library/nameops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/nameops.mli b/library/nameops.mli index abfc09db8d..89aba24476 100644 --- a/library/nameops.mli +++ b/library/nameops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -106,13 +106,13 @@ val name_max : Name.t -> Name.t -> Name.t val name_cons : Name.t -> Id.t list -> Id.t list (** @deprecated Same as [Name.cons] *) -val pr_name : Name.t -> Pp.std_ppcmds +val pr_name : Name.t -> Pp.t (** @deprecated Same as [Name.print] *) -val pr_id : Id.t -> Pp.std_ppcmds +val pr_id : Id.t -> Pp.t (** @deprecated Same as [Names.Id.print] *) -val pr_lab : Label.t -> Pp.std_ppcmds +val pr_lab : Label.t -> Pp.t (** some preset paths *) @@ -127,5 +127,5 @@ val coq_string : string (** "Coq" *) val default_root_prefix : DirPath.t (** Metavariables *) -val pr_meta : Term.metavariable -> Pp.std_ppcmds +val pr_meta : Term.metavariable -> Pp.t val string_of_meta : Term.metavariable -> string diff --git a/library/nametab.ml b/library/nametab.ml index 93e9c03cee..68fdbb4f38 100644 --- a/library/nametab.ml +++ b/library/nametab.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/nametab.mli b/library/nametab.mli index 095ac4f9df..025a63b1ce 100644 --- a/library/nametab.mli +++ b/library/nametab.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Names open Libnames open Globnames @@ -155,7 +154,7 @@ val basename_of_global : global_reference -> Id.t (** Printing of global references using names as short as possible. @raise Not_found when the reference is not in the global tables. *) -val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds +val pr_global_env : Id.Set.t -> global_reference -> Pp.t (** The [shortest_qualid] functions given an object with [user_name] diff --git a/library/states.ml b/library/states.ml index 95bd819d66..03e4610a6d 100644 --- a/library/states.ml +++ b/library/states.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/states.mli b/library/states.mli index 12c71c9991..780a4e8dc8 100644 --- a/library/states.mli +++ b/library/states.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/summary.ml b/library/summary.ml index c7bf95fd41..69eff830da 100644 --- a/library/summary.ml +++ b/library/summary.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/library/summary.mli b/library/summary.mli index 1b57613cb7..d093d95f29 100644 --- a/library/summary.mli +++ b/library/summary.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,6 +14,8 @@ type marshallable = | `No (* Full data will be store in memory, e.g. for Undo *) | `Shallow ] (* Only part of the data will be marshalled to a slave process *) +(** Types of global Coq states. The ['a] type should be pure and marshallable by + the standard OCaml marshalling function. *) type 'a summary_declaration = { (** freeze_function [true] is for marshalling to disk. * e.g. lazy must be forced *) diff --git a/library/univops.ml b/library/univops.ml index 60c12f0d81..3bafb824d1 100644 --- a/library/univops.ml +++ b/library/univops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ open Term open Univ -open Declarations let universes_of_constr c = let rec aux s c = @@ -21,44 +20,6 @@ let universes_of_constr c = | _ -> fold_constr aux s c in aux LSet.empty c -let universes_of_inductive mind = - let process auctx = - let u = Univ.AUContext.instance auctx in - let univ_of_one_ind oind = - let arity_univs = - Context.Rel.fold_outside - (fun decl unvs -> - Univ.LSet.union - (Context.Rel.Declaration.fold_constr - (fun cnstr unvs -> - let cnstr = Vars.subst_instance_constr u cnstr in - Univ.LSet.union - (universes_of_constr cnstr) unvs) - decl Univ.LSet.empty) unvs) - oind.mind_arity_ctxt ~init:Univ.LSet.empty - in - Array.fold_left (fun unvs cns -> - let cns = Vars.subst_instance_constr u cns in - Univ.LSet.union (universes_of_constr cns) unvs) arity_univs - oind.mind_nf_lc - in - let univs = - Array.fold_left - (fun unvs pk -> - Univ.LSet.union - (univ_of_one_ind pk) unvs - ) - Univ.LSet.empty mind.mind_packets - in - let mindcnt = Univ.UContext.constraints (Univ.instantiate_univ_context auctx) in - let univs = Univ.LSet.union univs (Univ.universes_of_constraints mindcnt) in - univs - in - match mind.mind_universes with - | Monomorphic_ind _ -> LSet.empty - | Polymorphic_ind auctx -> process auctx - | Cumulative_ind cumi -> process (Univ.ACumulativityInfo.univ_context cumi) - let restrict_universe_context (univs,csts) s = (* Universes that are not necessary to typecheck the term. E.g. univs introduced by tactics and not used in the proof term. *) diff --git a/library/univops.mli b/library/univops.mli index 5b499c75bc..09147cb41c 100644 --- a/library/univops.mli +++ b/library/univops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,10 +8,8 @@ open Term open Univ -open Declarations (** Shrink a universe context to a restricted set of variables *) val universes_of_constr : constr -> universe_set -val universes_of_inductive : mutual_inductive_body -> universe_set val restrict_universe_context : universe_context_set -> universe_set -> universe_context_set diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4 index 4629058083..5fcbb43b6f 100644 --- a/parsing/cLexer.ml4 +++ b/parsing/cLexer.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli index 1a1c302f23..09c9d8ee45 100644 --- a/parsing/cLexer.mli +++ b/parsing/cLexer.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/egramcoq.ml b/parsing/egramcoq.ml index 35ffa20d08..ec422c58db 100644 --- a/parsing/egramcoq.ml +++ b/parsing/egramcoq.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -354,7 +354,7 @@ type (_, _) ty_symbol = type ('self, _, 'r) ty_rule = | TyStop : ('self, 'r, 'r) ty_rule | TyNext : ('self, 'a, 'r) ty_rule * ('self, 'b) ty_symbol -> ('self, 'b -> 'a, 'r) ty_rule -| TyMark : int * bool * ('self, 'a, 'r) ty_rule -> ('self, 'a, 'r) ty_rule +| TyMark : int * bool * int * ('self, 'a, 'r) ty_rule -> ('self, 'a, 'r) ty_rule type 'r gen_eval = Loc.t -> 'r env -> 'r @@ -368,18 +368,27 @@ let rec ty_eval : type s a. (s, a, Loc.t -> s) ty_rule -> s gen_eval -> s env -> | TyNext (rem, TyNonTerm (forpat, e, _, true)) -> fun f env v -> ty_eval rem f (push_item forpat e env v) -| TyMark (n, b, rem) -> +| TyMark (n, b, p, rem) -> fun f env -> let heads, constrs = List.chop n env.constrs in - let constrlists = - if b then (heads @ List.hd env.constrlists) :: List.tl env.constrlists - else heads :: env.constrlists + let constrlists, constrs = + if b then + (* We rearrange constrs = c1..cn rem and constrlists = [d1..dr e1..ep] rem' into + constrs = e1..ep rem and constrlists [c1..cn d1..dr] rem' *) + let constrlist = List.hd env.constrlists in + let constrlist, tail = List.chop (List.length constrlist - p) constrlist in + (heads @ constrlist) :: List.tl env.constrlists, tail @ constrs + else + (* We rearrange constrs = c1..cn e1..ep rem into + constrs = e1..ep rem and add a constr list [c1..cn] *) + let constrlist, tail = List.chop (n - p) heads in + constrlist :: env.constrlists, tail @ constrs in ty_eval rem f { env with constrs; constrlists; } let rec ty_erase : type s a r. (s, a, r) ty_rule -> (s, a, r) Extend.rule = function | TyStop -> Stop -| TyMark (_, _, r) -> ty_erase r +| TyMark (_, _, _, r) -> ty_erase r | TyNext (rem, TyTerm tok) -> Next (ty_erase rem, Atoken tok) | TyNext (rem, TyNonTerm (_, _, s, _)) -> Next (ty_erase rem, s) @@ -398,9 +407,9 @@ let make_ty_rule assoc from forpat prods = let s = symbol_of_entry assoc from e in let bind = match var with None -> false | Some _ -> true in AnyTyRule (TyNext (r, TyNonTerm (forpat, e, s, bind))) - | GramConstrListMark (n, b) :: rem -> + | GramConstrListMark (n, b, p) :: rem -> let AnyTyRule r = make_ty_rule rem in - AnyTyRule (TyMark (n, b, r)) + AnyTyRule (TyMark (n, b, p, r)) in make_ty_rule (List.rev prods) diff --git a/parsing/egramcoq.mli b/parsing/egramcoq.mli index 0a0430ba6c..248de3348e 100644 --- a/parsing/egramcoq.mli +++ b/parsing/egramcoq.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/egramml.ml b/parsing/egramml.ml index 07c77619fe..cf9485b73b 100644 --- a/parsing/egramml.ml +++ b/parsing/egramml.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/egramml.mli b/parsing/egramml.mli index 030d396059..7414773d37 100644 --- a/parsing/egramml.mli +++ b/parsing/egramml.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4 index de76118026..f637e9746c 100644 --- a/parsing/g_constr.ml4 +++ b/parsing/g_constr.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4 index c77d6e204e..891c232ee0 100644 --- a/parsing/g_prim.ml4 +++ b/parsing/g_prim.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4 index e96a68bc69..42b5bfa935 100644 --- a/parsing/g_proofs.ml4 +++ b/parsing/g_proofs.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4 index fe8f517a73..93a778274d 100644 --- a/parsing/g_vernac.ml4 +++ b/parsing/g_vernac.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -168,8 +168,13 @@ GEXTEND Gram let indl=List.map (fun ((a,b,c,d),e) -> ((a,b,c,k,d),e)) indl in let cum = match cum with - Some b -> b - | None -> Flags.is_inductive_cumulativity () + Some true -> LocalCumulativity + | Some false -> LocalNonCumulativity + | None -> + if Flags.is_polymorphic_inductive_cumulativity () then + GlobalCumulativity + else + GlobalNonCumulativity in VernacInductive (cum, priv,f,indl) | "Fixpoint"; recs = LIST1 rec_definition SEP "with" -> diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml index 20601f900b..81f02bf955 100644 --- a/parsing/pcoq.ml +++ b/parsing/pcoq.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli index 9fb3daabaf..445818e130 100644 --- a/parsing/pcoq.mli +++ b/parsing/pcoq.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/tok.ml b/parsing/tok.ml index f4b60aeec4..0917e8d6dc 100644 --- a/parsing/tok.ml +++ b/parsing/tok.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/parsing/tok.mli b/parsing/tok.mli index b9286c53e2..59a79dcd22 100644 --- a/parsing/tok.mli +++ b/parsing/tok.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/.merlin b/plugins/.merlin new file mode 100644 index 0000000000..dd6678ba09 --- /dev/null +++ b/plugins/.merlin @@ -0,0 +1,2 @@ +REC +FLG -open API diff --git a/plugins/btauto/g_btauto.ml4 b/plugins/btauto/g_btauto.ml4 index 2980274487..23b91507c9 100644 --- a/plugins/btauto/g_btauto.ml4 +++ b/plugins/btauto/g_btauto.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml index 00e80d041f..6281b2675e 100644 --- a/plugins/btauto/refl_btauto.ml +++ b/plugins/btauto/refl_btauto.ml @@ -1,5 +1,3 @@ -open API - let contrib_name = "btauto" let init_constant dir s = diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml index 39fb8feeb8..1828213227 100644 --- a/plugins/cc/ccalgo.ml +++ b/plugins/cc/ccalgo.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,6 @@ (* Downey,Sethi and Tarjan. *) (* Plus some e-matching and constructor handling by P. Corbineau *) -open API open CErrors open Util open Pp diff --git a/plugins/cc/ccalgo.mli b/plugins/cc/ccalgo.mli index 51e2301fe6..f904aa3e68 100644 --- a/plugins/cc/ccalgo.mli +++ b/plugins/cc/ccalgo.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Term open Names @@ -121,7 +120,7 @@ val term_equal : term -> term -> bool val constr_of_term : term -> constr -val debug : (unit -> Pp.std_ppcmds) -> unit +val debug : (unit -> Pp.t) -> unit val forest : state -> forest @@ -170,7 +169,7 @@ val find_instances : state -> (quant_eq * int array) list val execute : bool -> state -> explanation option -val pr_idx_term : forest -> int -> Pp.std_ppcmds +val pr_idx_term : forest -> int -> Pp.t val empty_forest: unit -> forest diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml index eecb7bc983..a43a167e86 100644 --- a/plugins/cc/ccproof.ml +++ b/plugins/cc/ccproof.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,6 @@ (* This file uses the (non-compressed) union-find structure to generate *) (* proof-trees that will be transformed into proof-terms in cctac.ml4 *) -open API open CErrors open Term open Ccalgo diff --git a/plugins/cc/ccproof.mli b/plugins/cc/ccproof.mli index 4e4d42f869..9f53123db1 100644 --- a/plugins/cc/ccproof.mli +++ b/plugins/cc/ccproof.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Ccalgo open Term diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml index 0f5b806644..4934b0750b 100644 --- a/plugins/cc/cctac.ml +++ b/plugins/cc/cctac.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (* This file is the interface between the c-c algorithm and Coq *) -open API open Evd open Names open Inductiveops diff --git a/plugins/cc/cctac.mli b/plugins/cc/cctac.mli index ef32d2b83e..b4bb62be8e 100644 --- a/plugins/cc/cctac.mli +++ b/plugins/cc/cctac.mli @@ -7,7 +7,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open EConstr val proof_tac: Ccproof.proof -> unit Proofview.tactic diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4 index 43b150c346..6ed4672ce3 100644 --- a/plugins/cc/g_congruence.ml4 +++ b/plugins/cc/g_congruence.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Ltac_plugin open Cctac open Stdarg diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml index 31cbc8e25f..1524079f42 100644 --- a/plugins/derive/derive.ml +++ b/plugins/derive/derive.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Context.Named.Declaration let map_const_entry_body (f:Term.constr->Term.constr) (x:Safe_typing.private_constants Entries.const_entry_body) diff --git a/plugins/derive/derive.mli b/plugins/derive/derive.mli index 3a7e7b837d..690a7c5083 100644 --- a/plugins/derive/derive.mli +++ b/plugins/derive/derive.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API - (** [start_deriving f suchthat lemma] starts a proof of [suchthat] (which can contain references to [f]) in the context extended by [f:=?x]. When the proof ends, [f] is defined as the value of [?x] diff --git a/plugins/derive/g_derive.ml4 b/plugins/derive/g_derive.ml4 index 445923e01b..df701ed802 100644 --- a/plugins/derive/g_derive.ml4 +++ b/plugins/derive/g_derive.ml4 @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Stdarg (*i camlp4deps: "grammar/grammar.cma" i*) diff --git a/plugins/extraction/ExtrOcamlBasic.v b/plugins/extraction/ExtrOcamlBasic.v index dfdc498638..8c9ec5b9c2 100644 --- a/plugins/extraction/ExtrOcamlBasic.v +++ b/plugins/extraction/ExtrOcamlBasic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlBigIntConv.v b/plugins/extraction/ExtrOcamlBigIntConv.v index 78ee460856..6de2a92e81 100644 --- a/plugins/extraction/ExtrOcamlBigIntConv.v +++ b/plugins/extraction/ExtrOcamlBigIntConv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v index fcfea352a7..fe6eb7780f 100644 --- a/plugins/extraction/ExtrOcamlIntConv.v +++ b/plugins/extraction/ExtrOcamlIntConv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlNatBigInt.v b/plugins/extraction/ExtrOcamlNatBigInt.v index e0837be621..01da8401fc 100644 --- a/plugins/extraction/ExtrOcamlNatBigInt.v +++ b/plugins/extraction/ExtrOcamlNatBigInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlNatInt.v b/plugins/extraction/ExtrOcamlNatInt.v index 80da72d43f..ef4b2bfca6 100644 --- a/plugins/extraction/ExtrOcamlNatInt.v +++ b/plugins/extraction/ExtrOcamlNatInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v index 64ca6c85d0..a0f4b679c2 100644 --- a/plugins/extraction/ExtrOcamlString.v +++ b/plugins/extraction/ExtrOcamlString.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlZBigInt.v b/plugins/extraction/ExtrOcamlZBigInt.v index 66f188c84e..84c0eff5da 100644 --- a/plugins/extraction/ExtrOcamlZBigInt.v +++ b/plugins/extraction/ExtrOcamlZBigInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/ExtrOcamlZInt.v b/plugins/extraction/ExtrOcamlZInt.v index c93cfb9d46..c4f4664092 100644 --- a/plugins/extraction/ExtrOcamlZInt.v +++ b/plugins/extraction/ExtrOcamlZInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/Extraction.v b/plugins/extraction/Extraction.v index ab1416b1d6..1374a91abf 100644 --- a/plugins/extraction/Extraction.v +++ b/plugins/extraction/Extraction.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/big.ml b/plugins/extraction/big.ml index 44b81d762c..2bd70ff4d5 100644 --- a/plugins/extraction/big.ml +++ b/plugins/extraction/big.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml index e66bf7e1b7..9772ebd641 100644 --- a/plugins/extraction/common.ml +++ b/plugins/extraction/common.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Pp open Util open Names diff --git a/plugins/extraction/common.mli b/plugins/extraction/common.mli index 004019e168..356bad98ba 100644 --- a/plugins/extraction/common.mli +++ b/plugins/extraction/common.mli @@ -1,39 +1,37 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Globnames open Miniml -open Pp (** By default, in module Format, you can do horizontal placing of blocks even if they include newlines, as long as the number of chars in the blocks are less that a line length. To avoid this awkward situation, we attach a big virtual size to [fnl] newlines. *) -val fnl : unit -> std_ppcmds -val fnl2 : unit -> std_ppcmds -val space_if : bool -> std_ppcmds +val fnl : unit -> Pp.t +val fnl2 : unit -> Pp.t +val space_if : bool -> Pp.t -val pp_par : bool -> std_ppcmds -> std_ppcmds +val pp_par : bool -> Pp.t -> Pp.t (** [pp_apply] : a head part applied to arguments, possibly with parenthesis *) -val pp_apply : std_ppcmds -> bool -> std_ppcmds list -> std_ppcmds +val pp_apply : Pp.t -> bool -> Pp.t list -> Pp.t (** Same as [pp_apply], but with also protection of the head by parenthesis *) -val pp_apply2 : std_ppcmds -> bool -> std_ppcmds list -> std_ppcmds +val pp_apply2 : Pp.t -> bool -> Pp.t list -> Pp.t -val pp_tuple_light : (bool -> 'a -> std_ppcmds) -> 'a list -> std_ppcmds -val pp_tuple : ('a -> std_ppcmds) -> 'a list -> std_ppcmds -val pp_boxed_tuple : ('a -> std_ppcmds) -> 'a list -> std_ppcmds +val pp_tuple_light : (bool -> 'a -> Pp.t) -> 'a list -> Pp.t +val pp_tuple : ('a -> Pp.t) -> 'a list -> Pp.t +val pp_boxed_tuple : ('a -> Pp.t) -> 'a list -> Pp.t -val pr_binding : Id.t list -> std_ppcmds +val pr_binding : Id.t list -> Pp.t val rename_id : Id.t -> Id.Set.t -> Id.t @@ -81,4 +79,4 @@ val mk_ind : string -> string -> MutInd.t val is_native_char : ml_ast -> bool val get_native_char : ml_ast -> char -val pp_native_char : ml_ast -> std_ppcmds +val pp_native_char : ml_ast -> Pp.t diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml index 40ef6601d4..89c2a0ae30 100644 --- a/plugins/extraction/extract_env.ml +++ b/plugins/extraction/extract_env.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Miniml open Term open Declarations @@ -133,7 +132,7 @@ let rec add_labels mp = function exception Impossible let check_arity env cb = - let t = Typeops.type_of_constant_type env cb.const_type in + let t = cb.const_type in if Reduction.is_arity env t then raise Impossible let check_fix env cb i = @@ -176,26 +175,32 @@ let factor_fix env l cb msb = (hack proposed by Elie) *) -let expand_mexpr env mp me = +let expand_mexpr env mpo me = let inl = Some (Flags.get_inline_level()) in - Mod_typing.translate_mse env (Some mp) inl me + Mod_typing.translate_mse env mpo inl me -(** Ad-hoc update of environment, inspired by [Mod_type.check_with_aux_def]. - To check with Elie. *) - -let rec mp_of_mexpr = function - | MEident mp -> mp - | MEwith (seb,_) -> mp_of_mexpr seb - | _ -> assert false +let expand_modtype env mp me = + let inl = Some (Flags.get_inline_level()) in + Mod_typing.translate_modtype env mp inl ([],me) let no_delta = Mod_subst.empty_delta_resolver -let env_for_mtb_with_def env mp me idl = +let flatten_modtype env mp me_alg struc_opt = + match struc_opt with + | Some me -> me, no_delta + | None -> + let mtb = expand_modtype env mp me_alg in + mtb.mod_type, mtb.mod_delta + +(** Ad-hoc update of environment, inspired by [Mod_typing.check_with_aux_def]. +*) + +let env_for_mtb_with_def env mp me reso idl = let struc = Modops.destr_nofunctor me in let l = Label.of_id (List.hd idl) in let spot = function (l',SFBconst _) -> Label.equal l l' | _ -> false in let before = fst (List.split_when spot struc) in - Modops.add_structure mp before no_delta env + Modops.add_structure mp before reso env let make_cst resolver mp l = Mod_subst.constant_of_delta_kn resolver (KerName.make2 mp l) @@ -235,20 +240,24 @@ let rec extract_structure_spec env mp reso = function [extract_mexpression_spec] should come from a [mod_type_alg] field. This way, any encountered [MEident] should be a true module type. *) -and extract_mexpr_spec env mp1 (me_struct,me_alg) = match me_alg with +and extract_mexpr_spec env mp1 (me_struct_o,me_alg) = match me_alg with | MEident mp -> Visit.add_mp_all mp; MTident mp | MEwith(me',WithDef(idl,(c,ctx)))-> - let env' = env_for_mtb_with_def env (mp_of_mexpr me') me_struct idl in - let mt = extract_mexpr_spec env mp1 (me_struct,me') in + let me_struct,delta = flatten_modtype env mp1 me' me_struct_o in + let env' = env_for_mtb_with_def env mp1 me_struct delta idl in + let mt = extract_mexpr_spec env mp1 (None,me') in (match extract_with_type env' c with (* cb may contain some kn *) | None -> mt - | Some (vl,typ) -> MTwith(mt,ML_With_type(idl,vl,typ))) + | Some (vl,typ) -> + type_iter_references Visit.add_ref typ; + MTwith(mt,ML_With_type(idl,vl,typ))) | MEwith(me',WithMod(idl,mp))-> Visit.add_mp_all mp; - MTwith(extract_mexpr_spec env mp1 (me_struct,me'), ML_With_module(idl,mp)) + MTwith(extract_mexpr_spec env mp1 (None,me'), ML_With_module(idl,mp)) | MEapply _ -> (* No higher-order module type in OCaml : we use the expanded version *) - extract_msignature_spec env mp1 no_delta (*TODO*) me_struct + let me_struct,delta = flatten_modtype env mp1 me_alg me_struct_o in + extract_msignature_spec env mp1 delta me_struct and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with | MoreFunctor (mbid, mtb, me_alg') -> @@ -259,8 +268,8 @@ and extract_mexpression_spec env mp1 (me_struct,me_alg) = match me_alg with let mp = MPbound mbid in let env' = Modops.add_module_type mp mtb env in MTfunsig (mbid, extract_mbody_spec env mp mtb, - extract_mexpression_spec env' mp1 (me_struct',me_alg')) - | NoFunctor m -> extract_mexpr_spec env mp1 (me_struct,m) + extract_mexpression_spec env' mp1 (me_struct',me_alg')) + | NoFunctor m -> extract_mexpr_spec env mp1 (Some me_struct,m) and extract_msignature_spec env mp1 reso = function | NoFunctor struc -> @@ -336,7 +345,7 @@ and extract_mexpr env mp = function (* In Haskell/Scheme, we expand everything. For now, we also extract everything, dead code will be removed later (see [Modutil.optimize_struct]. *) - let sign,_,delta,_ = expand_mexpr env mp me in + let sign,_,delta,_ = expand_mexpr env (Some mp) me in extract_msignature env mp delta ~all:true sign | MEident mp -> if is_modfile mp && not (modular ()) then error_MPfile_as_mod mp false; @@ -686,3 +695,35 @@ let structure_for_compute c = let struc = optimize_struct (refs,[]) (mono_environment refs []) in let flatstruc = List.map snd (List.flatten (List.map snd struc)) in flatstruc, ast, mlt + +(* For the test-suite : + extraction to a temporary file + run ocamlc on it *) + +let compile f = + try + let args = ["ocamlc";"-I";Filename.dirname f;"-c";f^"i";f] in + let res = CUnix.sys_command (Envars.ocamlfind ()) args in + match res with + | Unix.WEXITED 0 -> () + | Unix.WEXITED n | Unix.WSIGNALED n | Unix.WSTOPPED n -> + CErrors.user_err + Pp.(str "Compilation of file " ++ str f ++ + str " failed with exit code " ++ int n) + with Unix.Unix_error (e,_,_) -> + CErrors.user_err + Pp.(str "Compilation of file " ++ str f ++ + str " failed with error " ++ str (Unix.error_message e)) + +let remove f = + if Sys.file_exists f then Sys.remove f + +let extract_and_compile l = + if lang () != Ocaml then + CErrors.user_err (Pp.str "This command only works with OCaml extraction"); + let f = Filename.temp_file "testextraction" ".ml" in + let () = full_extraction (Some f) l in + let () = compile f in + let () = remove f; remove (f^"i") in + let base = Filename.chop_suffix f ".ml" in + let () = remove (base^".cmo"); remove (base^".cmi") in + Feedback.msg_notice (str "Extracted code successfully compiled") diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli index 4f0ed953c6..5769ff1176 100644 --- a/plugins/extraction/extract_env.mli +++ b/plugins/extraction/extract_env.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*s This module declares the extraction commands. *) -open API open Names open Libnames open Globnames @@ -18,6 +17,10 @@ val full_extraction : string option -> reference list -> unit val separate_extraction : reference list -> unit val extraction_library : bool -> Id.t -> unit +(* For the test-suite : extraction to a temporary file + ocamlc on it *) + +val extract_and_compile : reference list -> unit + (* For debug / external output via coqtop.byte + Drop : *) val mono_environment : @@ -26,7 +29,7 @@ val mono_environment : (* Used by the Relation Extraction plugin *) val print_one_decl : - Miniml.ml_structure -> ModPath.t -> Miniml.ml_decl -> Pp.std_ppcmds + Miniml.ml_structure -> ModPath.t -> Miniml.ml_decl -> Pp.t (* Used by Extraction Compute *) diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml index 2b7199a763..7644b49ceb 100644 --- a/plugins/extraction/extraction.ml +++ b/plugins/extraction/extraction.ml @@ -1,13 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (*i*) -open API open Util open Names open Term @@ -296,7 +295,11 @@ let rec extract_type env db j c args = | Ind ((kn,i),u) -> let s = (extract_ind env kn).ind_packets.(i).ip_sign in extract_type_app env db (IndRef (kn,i),s) args - | Case _ | Fix _ | CoFix _ | Proj _ -> Tunknown + | Proj (p,t) -> + (* Let's try to reduce, if it hasn't already been done. *) + if Projection.unfolded p then Tunknown + else extract_type env db j (Term.mkProj (Projection.unfold p, t)) args + | Case _ | Fix _ | CoFix _ -> Tunknown | _ -> assert false (*s Auxiliary function dealing with type application. @@ -519,7 +522,7 @@ and mlt_env env r = match r with match lookup_typedef kn cb with | Some _ as o -> o | None -> - let typ = Typeops.type_of_constant_type env cb.const_type + let typ = cb.const_type (* FIXME not sure if we should instantiate univs here *) in match flag_of_type env typ with | Info,TypeScheme -> @@ -544,7 +547,7 @@ let record_constant_type env kn opt_typ = | Some schema -> schema | None -> let typ = match opt_typ with - | None -> Typeops.type_of_constant_type env cb.const_type + | None -> cb.const_type | Some typ -> typ in let mlt = extract_type env [] 1 typ [] in @@ -970,7 +973,7 @@ let extract_fixpoint env vkn (fi,ti,ci) = let extract_constant env kn cb = let r = ConstRef kn in - let typ = Typeops.type_of_constant_type env cb.const_type in + let typ = cb.const_type in let warn_info () = if not (is_custom r) then add_info_axiom r in let warn_log () = if not (constant_has_body cb) then add_log_axiom r in @@ -1026,7 +1029,7 @@ let extract_constant env kn cb = let extract_constant_spec env kn cb = let r = ConstRef kn in - let typ = Typeops.type_of_constant_type env cb.const_type in + let typ = cb.const_type in try match flag_of_type env typ with | (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype)) diff --git a/plugins/extraction/extraction.mli b/plugins/extraction/extraction.mli index 26268fb177..e1d43f3405 100644 --- a/plugins/extraction/extraction.mli +++ b/plugins/extraction/extraction.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*s Extraction from Coq terms to Miniml. *) -open API open Names open Term open Declarations diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4 index 76b435410b..23452febdc 100644 --- a/plugins/extraction/g_extraction.ml4 +++ b/plugins/extraction/g_extraction.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,7 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API.Pcoq.Prim +open Pcoq.Prim DECLARE PLUGIN "extraction_plugin" @@ -66,6 +65,10 @@ VERNAC COMMAND EXTEND Extraction CLASSIFIED AS QUERY (* Monolithic extraction to a file *) | [ "Extraction" string(f) ne_global_list(l) ] -> [ full_extraction (Some f) l ] + +(* Extraction to a temporary file and OCaml compilation *) +| [ "Extraction" "TestCompile" ne_global_list(l) ] + -> [ extract_and_compile l ] END VERNAC COMMAND EXTEND SeparateExtraction CLASSIFIED AS QUERY diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml index 4bd207a982..0f537abece 100644 --- a/plugins/extraction/haskell.ml +++ b/plugins/extraction/haskell.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*s Production of Haskell syntax. *) -open API open Pp open CErrors open Util diff --git a/plugins/extraction/haskell.mli b/plugins/extraction/haskell.mli index 6f49320671..f888e71095 100644 --- a/plugins/extraction/haskell.mli +++ b/plugins/extraction/haskell.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/json.ml b/plugins/extraction/json.ml index 1bf19f186b..e43c47d050 100644 --- a/plugins/extraction/json.ml +++ b/plugins/extraction/json.ml @@ -1,4 +1,3 @@ -open API open Pp open Util open Names diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli index ec28f49966..edebba49df 100644 --- a/plugins/extraction/miniml.mli +++ b/plugins/extraction/miniml.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (*s Target language for extraction: a core ML called MiniML. *) -open API -open Pp open Names open Globnames @@ -206,19 +204,19 @@ type language_descr = { file_naming : ModPath.t -> string; (* the second argument is a comment to add to the preamble *) preamble : - Id.t -> std_ppcmds option -> ModPath.t list -> unsafe_needs -> - std_ppcmds; - pp_struct : ml_structure -> std_ppcmds; + Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs -> + Pp.t; + pp_struct : ml_structure -> Pp.t; (* Concerning a possible interface file *) sig_suffix : string option; (* the second argument is a comment to add to the preamble *) sig_preamble : - Id.t -> std_ppcmds option -> ModPath.t list -> unsafe_needs -> - std_ppcmds; - pp_sig : ml_signature -> std_ppcmds; + Id.t -> Pp.t option -> ModPath.t list -> unsafe_needs -> + Pp.t; + pp_sig : ml_signature -> Pp.t; (* for an isolated declaration print *) - pp_decl : ml_decl -> std_ppcmds; + pp_decl : ml_decl -> Pp.t; } diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml index 3a70a50204..a4c2bcd883 100644 --- a/plugins/extraction/mlutil.ml +++ b/plugins/extraction/mlutil.ml @@ -1,13 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (*i*) -open API open Util open Names open Libnames @@ -121,7 +120,6 @@ let rec mgu = function mgu (a, a'); mgu (b, b') | Tglob (r,l), Tglob (r',l') when Globnames.eq_gr r r' -> List.iter mgu (List.combine l l') - | (Tdummy _, _ | _, Tdummy _) when lang() == Haskell -> () | Tdummy _, Tdummy _ -> () | Tvar i, Tvar j when Int.equal i j -> () | Tvar' i, Tvar' j when Int.equal i j -> () @@ -1053,6 +1051,7 @@ let rec simpl o = function | MLmagic(MLcase(typ,e,br)) -> let br' = Array.map (fun (ids,p,c) -> (ids,p,MLmagic c)) br in simpl o (MLcase(typ,e,br')) + | MLmagic(MLdummy _ as e) when lang () == Haskell -> e | MLmagic(MLexn _ as e) -> e | a -> ast_map (simpl o) a diff --git a/plugins/extraction/mlutil.mli b/plugins/extraction/mlutil.mli index 6924dc9ffe..42d22a7b45 100644 --- a/plugins/extraction/mlutil.mli +++ b/plugins/extraction/mlutil.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Globnames open Miniml diff --git a/plugins/extraction/modutil.ml b/plugins/extraction/modutil.ml index 6c38813e4b..1e0c331901 100644 --- a/plugins/extraction/modutil.ml +++ b/plugins/extraction/modutil.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open ModPath open Globnames @@ -18,10 +17,15 @@ open Mlutil (*S Functions upon ML modules. *) +(** Note: a syntax like [(F M) with ...] is actually legal, see for instance + bug #4720. Hence the code below tries to handle [MTsig], maybe not in + a perfect way, but that should be enough for the use of [se_iter] below. *) + let rec msid_of_mt = function | MTident mp -> mp + | MTsig(mp,_) -> mp | MTwith(mt,_)-> msid_of_mt mt - | _ -> anomaly ~label:"extraction" (Pp.str "the With operator isn't applied to a name.") + | MTfunsig _ -> assert false (* A functor cannot be inside a MTwith *) (*s Apply some functions upon all [ml_decl] and [ml_spec] found in a [ml_structure]. *) @@ -37,7 +41,7 @@ let se_iter do_decl do_spec do_mp = List.fold_left (fun mp l -> MPdot(mp,Label.of_id l)) mp_mt idl' in let r = ConstRef (Constant.make2 mp_w (Label.of_id l')) in - mt_iter mt; do_decl (Dtype(r,l,t)) + mt_iter mt; do_spec (Stype(r,l,Some t)) | MTwith (mt,ML_With_module(idl,mp))-> let mp_mt = msid_of_mt mt in let mp_w = diff --git a/plugins/extraction/modutil.mli b/plugins/extraction/modutil.mli index 9a67baa96d..17a6e8db6f 100644 --- a/plugins/extraction/modutil.mli +++ b/plugins/extraction/modutil.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Globnames open Miniml @@ -18,6 +17,7 @@ val struct_type_search : (ml_type -> bool) -> ml_structure -> bool type do_ref = global_reference -> unit +val type_iter_references : do_ref -> ml_type -> unit val ast_iter_references : do_ref -> do_ref -> do_ref -> ml_ast -> unit val decl_iter_references : do_ref -> do_ref -> do_ref -> ml_decl -> unit val spec_iter_references : do_ref -> do_ref -> do_ref -> ml_spec -> unit diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml index 16feaf4d6d..9cbc3fd713 100644 --- a/plugins/extraction/ocaml.ml +++ b/plugins/extraction/ocaml.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*s Production of Ocaml syntax. *) -open API open Pp open CErrors open Util diff --git a/plugins/extraction/ocaml.mli b/plugins/extraction/ocaml.mli index f579a54b8b..bc9d1889f8 100644 --- a/plugins/extraction/ocaml.mli +++ b/plugins/extraction/ocaml.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml index 55168cc297..1ccc273704 100644 --- a/plugins/extraction/scheme.ml +++ b/plugins/extraction/scheme.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*s Production of Scheme syntax. *) -open API open Pp open CErrors open Util diff --git a/plugins/extraction/scheme.mli b/plugins/extraction/scheme.mli index 5e1ec0d5e0..51647ef4ad 100644 --- a/plugins/extraction/scheme.mli +++ b/plugins/extraction/scheme.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml index b82c5257e1..ca98f07e8d 100644 --- a/plugins/extraction/table.ml +++ b/plugins/extraction/table.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open ModPath open Term @@ -445,9 +444,10 @@ let error_MPfile_as_mod mp b = "Please "^s2^"use (Recursive) Extraction Library instead.\n")) let argnames_of_global r = - let typ = Global.type_of_global_unsafe r in + let env = Global.env () in + let typ, _ = Global.type_of_global_in_context env r in let rels,_ = - decompose_prod (Reduction.whd_all (Global.env ()) typ) in + decompose_prod (Reduction.whd_all env typ) in List.rev_map fst rels let msg_of_implicit = function @@ -878,7 +878,7 @@ let extract_constant_inline inline r ids s = match g with | ConstRef kn -> let env = Global.env () in - let typ = Global.type_of_global_unsafe (ConstRef kn) in + let typ, _ = Global.type_of_global_in_context env (ConstRef kn) in let typ = Reduction.whd_all env typ in if Reduction.is_arity env typ then begin diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli index cfe75bf4e1..7e47d0bc81 100644 --- a/plugins/extraction/table.mli +++ b/plugins/extraction/table.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Libnames open Globnames @@ -192,7 +191,7 @@ val find_custom_match : ml_branch array -> string val extraction_language : lang -> unit val extraction_inline : bool -> reference list -> unit -val print_extraction_inline : unit -> Pp.std_ppcmds +val print_extraction_inline : unit -> Pp.t val reset_extraction_inline : unit -> unit val extract_constant_inline : bool -> reference -> string list -> string -> unit @@ -207,7 +206,7 @@ val extraction_implicit : reference -> int_or_id list -> unit val extraction_blacklist : Id.t list -> unit val reset_extraction_blacklist : unit -> unit -val print_extraction_blacklist : unit -> Pp.std_ppcmds +val print_extraction_blacklist : unit -> Pp.t diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml index 314a2b2f96..db1a46a035 100644 --- a/plugins/firstorder/formula.ml +++ b/plugins/firstorder/formula.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Hipattern open Names open Term diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli index a31de5e61f..106c469c62 100644 --- a/plugins/firstorder/formula.mli +++ b/plugins/firstorder/formula.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Term open EConstr open Globnames diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4 index 139baaeb31..1e7da3250b 100644 --- a/plugins/firstorder/g_ground.ml4 +++ b/plugins/firstorder/g_ground.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Ltac_plugin open Formula open Sequent diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml index a5a81bb166..f660ba7343 100644 --- a/plugins/firstorder/ground.ml +++ b/plugins/firstorder/ground.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Ltac_plugin open Formula open Sequent diff --git a/plugins/firstorder/ground.mli b/plugins/firstorder/ground.mli index aaf79ae885..d763fe6355 100644 --- a/plugins/firstorder/ground.mli +++ b/plugins/firstorder/ground.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API val ground_tac: unit Proofview.tactic -> ((Sequent.t -> unit Proofview.tactic) -> unit Proofview.tactic) -> unit Proofview.tactic diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml index 92372fe291..1690736305 100644 --- a/plugins/firstorder/instances.ml +++ b/plugins/firstorder/instances.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Unify open Rules open CErrors diff --git a/plugins/firstorder/instances.mli b/plugins/firstorder/instances.mli index b0e4b2690b..ec2a056e32 100644 --- a/plugins/firstorder/instances.mli +++ b/plugins/firstorder/instances.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Globnames open Rules diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml index 72ede1f7dd..d6309b057f 100644 --- a/plugins/firstorder/rules.ml +++ b/plugins/firstorder/rules.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open CErrors open Util open Names diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli index 682047075b..d8d4c1a38a 100644 --- a/plugins/firstorder/rules.mli +++ b/plugins/firstorder/rules.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Term open EConstr open Names diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml index 435ca1986e..5ba98fb584 100644 --- a/plugins/firstorder/sequent.ml +++ b/plugins/firstorder/sequent.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open EConstr open CErrors open Util diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli index e24eca7cb5..ca6079c8b0 100644 --- a/plugins/firstorder/sequent.mli +++ b/plugins/firstorder/sequent.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open EConstr open Formula open Globnames @@ -58,4 +57,4 @@ val extend_with_ref_list : Environ.env -> Evd.evar_map -> global_reference list val extend_with_auto_hints : Environ.env -> Evd.evar_map -> Hints.hint_db_name list -> t -> t * Evd.evar_map -val print_cmap: global_reference list CM.t -> Pp.std_ppcmds +val print_cmap: global_reference list CM.t -> Pp.t diff --git a/plugins/firstorder/unify.ml b/plugins/firstorder/unify.ml index e1adebe8dc..a1409edd09 100644 --- a/plugins/firstorder/unify.ml +++ b/plugins/firstorder/unify.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Term open EConstr diff --git a/plugins/firstorder/unify.mli b/plugins/firstorder/unify.mli index 7f1fb9bd01..d3e8aeee88 100644 --- a/plugins/firstorder/unify.mli +++ b/plugins/firstorder/unify.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Term open EConstr diff --git a/plugins/fourier/Fourier.v b/plugins/fourier/Fourier.v index a962547131..6e3defabe9 100644 --- a/plugins/fourier/Fourier.v +++ b/plugins/fourier/Fourier.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/fourier/Fourier_util.v b/plugins/fourier/Fourier_util.v index d4b0e2e107..13e0d4369e 100644 --- a/plugins/fourier/Fourier_util.v +++ b/plugins/fourier/Fourier_util.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/fourier/fourier.ml b/plugins/fourier/fourier.ml index 4919232c98..418859f7f9 100644 --- a/plugins/fourier/fourier.ml +++ b/plugins/fourier/fourier.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml index b44307590e..68af1b3b63 100644 --- a/plugins/fourier/fourierR.ml +++ b/plugins/fourier/fourierR.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,7 +12,6 @@ des inéquations et équations sont entiers. En attendant la tactique Field. *) -open API open Term open Tactics open Names diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4 index 1960fa8355..682673e8df 100644 --- a/plugins/fourier/g_fourier.ml4 +++ b/plugins/fourier/g_fourier.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/funind/FunInd.v b/plugins/funind/FunInd.v index e40aea7764..b8a05e5cc0 100644 --- a/plugins/funind/FunInd.v +++ b/plugins/funind/FunInd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/funind/Recdef.v b/plugins/funind/Recdef.v index 64f43b8335..8b4dbbb45c 100644 --- a/plugins/funind/Recdef.v +++ b/plugins/funind/Recdef.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml index ba46f78aa8..5f6d783598 100644 --- a/plugins/funind/functional_principles_proofs.ml +++ b/plugins/funind/functional_principles_proofs.ml @@ -1,4 +1,3 @@ -open API open Printer open CErrors open Util @@ -822,8 +821,9 @@ let build_proof | Fix _ | CoFix _ -> user_err Pp.(str ( "Anonymous local (co)fixpoints are not handled yet")) + | Proj _ -> user_err Pp.(str "Prod") - | Prod _ -> user_err Pp.(str "Prod") + | Prod _ -> do_finalize dyn_infos g | LetIn _ -> let new_infos = { dyn_infos with @@ -957,7 +957,7 @@ let generate_equation_lemma evd fnames f fun_num nb_params nb_args rec_args_num (* observe (str "rec_args_num := " ++ str (string_of_int (rec_args_num + 1) )); *) let f_def = Global.lookup_constant (fst (destConst evd f)) in let eq_lhs = mkApp(f,Array.init (nb_params + nb_args) (fun i -> mkRel(nb_params + nb_args - i))) in - let f_body = Option.get (Global.body_of_constant_body f_def) in + let (f_body, _) = Option.get (Global.body_of_constant_body f_def) in let f_body = EConstr.of_constr f_body in let params,f_body_with_params = decompose_lam_n evd nb_params f_body in let (_,num),(_,_,bodies) = destFix evd f_body_with_params in @@ -1091,7 +1091,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam in let get_body const = match Global.body_of_constant const with - | Some body -> + | Some (body, _) -> Tacred.cbv_norm_flags (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA]) (Global.env ()) @@ -1382,7 +1382,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam (* Proof of principles of general functions *) -(* let hrec_id = +(* let hrec_id = Recdef.hrec_id *) (* and acc_inv_id = Recdef.acc_inv_id *) (* and ltof_ref = Recdef.ltof_ref *) (* and acc_rel = Recdef.acc_rel *) diff --git a/plugins/funind/functional_principles_proofs.mli b/plugins/funind/functional_principles_proofs.mli index d03fc475e0..64fbfaeedf 100644 --- a/plugins/funind/functional_principles_proofs.mli +++ b/plugins/funind/functional_principles_proofs.mli @@ -1,4 +1,3 @@ -open API open Names val prove_princ_for_struct : diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml index 8ffd15f9fb..513fce2484 100644 --- a/plugins/funind/functional_principles_types.ml +++ b/plugins/funind/functional_principles_types.ml @@ -1,4 +1,3 @@ -open API open Printer open CErrors open Util @@ -407,7 +406,7 @@ let get_funs_constant mp dp = function const -> let find_constant_body const = match Global.body_of_constant const with - | Some body -> + | Some (body, _) -> let body = Tacred.cbv_norm_flags (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA]) (Global.env ()) @@ -651,7 +650,7 @@ let build_case_scheme fa = (* in *) let funs = let (_,f,_) = fa in - try fst (Universes.unsafe_constr_of_global (Smartlocate.global_with_alias f)) + try fst (Global.constr_of_global_in_context (Global.env ()) (Smartlocate.global_with_alias f)) with Not_found -> user_err ~hdr:"FunInd.build_case_scheme" (str "Cannot find " ++ Libnames.pr_reference f) in diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli index e70ef23656..5a7ffe0590 100644 --- a/plugins/funind/functional_principles_types.mli +++ b/plugins/funind/functional_principles_types.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Term open Misctypes diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4 index 1258c92868..16d9f200f3 100644 --- a/plugins/funind/g_indfun.ml4 +++ b/plugins/funind/g_indfun.ml4 @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Ltac_plugin open Util open Pp diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml index db2af2be53..8cf5e8442d 100644 --- a/plugins/funind/glob_term_to_relation.ml +++ b/plugins/funind/glob_term_to_relation.ml @@ -1,4 +1,3 @@ -open API open Printer open Pp open Names @@ -33,6 +32,14 @@ type binder_type = type glob_context = (binder_type*glob_constr) list + +let rec solve_trivial_holes pat_as_term e = + match pat_as_term.CAst.v,e.CAst.v with + | GHole _,_ -> e + | GApp(fp,argsp),GApp(fe,argse) when glob_constr_eq fp fe -> + CAst.make (GApp((solve_trivial_holes fp fe),List.map2 solve_trivial_holes argsp argse)) + | _,_ -> pat_as_term + (* compose_glob_context [(bt_1,n_1,t_1);......] rt returns b_1(n_1,t_1,.....,bn(n_k,t_k,rt)) where the b_i's are the @@ -227,7 +234,12 @@ let combine_lam n t b = compose_glob_context b.context b.value ) } - +let combine_prod2 n t b = + { + context = []; + value = mkGProd(n, compose_glob_context t.context t.value, + compose_glob_context b.context b.value ) + } let combine_prod n t b = { context = t.context@((Prod n,t.value)::b.context); value = b.value} @@ -605,7 +617,9 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return = let t_res = build_entry_lc env funnames avoid t in let new_env = raw_push_named (n,None,t) env in let b_res = build_entry_lc new_env funnames avoid b in - combine_results (combine_prod n) t_res b_res + if List.length t_res.result = 1 && List.length b_res.result = 1 + then combine_results (combine_prod2 n) t_res b_res + else combine_results (combine_prod n) t_res b_res | GLetIn(n,v,typ,b) -> (* we first compute the list of constructor corresponding to the body of the function, @@ -807,6 +821,12 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve let typ_as_constr = EConstr.of_constr typ_as_constr in let typ = Detyping.detype false [] new_env (Evd.from_env env) typ_as_constr in let pat_as_term = pattern_to_term pat in + (* removing trivial holes *) + let pat_as_term = solve_trivial_holes pat_as_term e in + (* observe (str "those_pattern_preconds" ++ spc () ++ *) + (* str "pat" ++ spc () ++ pr_glob_constr pat_as_term ++ spc ()++ *) + (* str "e" ++ spc () ++ pr_glob_constr e ++spc ()++ *) + (* str "typ_as_constr" ++ spc () ++ pr_lconstr typ_as_constr); *) List.fold_right (fun id acc -> if Id.Set.mem id this_pat_ids @@ -1472,7 +1492,7 @@ let do_build_inductive in let msg = str "while trying to define"++ spc () ++ - Ppvernac.pr_vernac (Vernacexpr.VernacInductive(false,false,Decl_kinds.Finite,repacked_rel_inds)) + Ppvernac.pr_vernac (Vernacexpr.VernacInductive(Vernacexpr.GlobalNonCumulativity,false,Decl_kinds.Finite,repacked_rel_inds)) ++ fnl () ++ msg in @@ -1487,7 +1507,7 @@ let do_build_inductive in let msg = str "while trying to define"++ spc () ++ - Ppvernac.pr_vernac (Vernacexpr.VernacInductive(false,false,Decl_kinds.Finite,repacked_rel_inds)) + Ppvernac.pr_vernac (Vernacexpr.VernacInductive(Vernacexpr.GlobalNonCumulativity,false,Decl_kinds.Finite,repacked_rel_inds)) ++ fnl () ++ CErrors.print reraise in diff --git a/plugins/funind/glob_term_to_relation.mli b/plugins/funind/glob_term_to_relation.mli index 7ad7de0792..0cab5a6d35 100644 --- a/plugins/funind/glob_term_to_relation.mli +++ b/plugins/funind/glob_term_to_relation.mli @@ -1,4 +1,3 @@ -open API open Names (* diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml index 726a8203d7..003bb4e30d 100644 --- a/plugins/funind/glob_termops.ml +++ b/plugins/funind/glob_termops.ml @@ -1,4 +1,3 @@ -open API open Pp open Glob_term open CErrors @@ -709,9 +708,6 @@ let expand_as = in expand_as Id.Map.empty - - - (* [resolve_and_replace_implicits ?expected_type env sigma rt] solves implicits of [rt] w.r.t. [env] and [sigma] and then replace them by their solution *) @@ -750,6 +746,30 @@ If someone knows how to prevent solved existantial removal in understand, pleas Detyping.detype false [] env ctx (EConstr.of_constr (f c)) | Evar_empty -> rt (* the hole was not solved : we do nothing *) ) + | (GHole(BinderType na,_,_)) -> (* we only want to deal with implicit arguments *) + ( + let res = + try (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *) + Evd.fold (* to simulate an iter *) + (fun _ evi _ -> + match evi.evar_source with + | (loc_evi,BinderType na') -> + if Name.equal na na' && rt.CAst.loc = loc_evi then raise (Found evi) + | _ -> () + ) + ctx + (); + (* the hole was not solved : we do nothing *) + rt + with Found evi -> (* we found the evar corresponding to this hole *) + match evi.evar_body with + | Evar_defined c -> + (* we just have to lift the solution in glob_term *) + Detyping.detype false [] env ctx (EConstr.of_constr (f c)) + | Evar_empty -> rt (* the hole was not solved : we d when falseo nothing *) + in + res + ) | _ -> Glob_ops.map_glob_constr change rt in change rt diff --git a/plugins/funind/glob_termops.mli b/plugins/funind/glob_termops.mli index b6d2c45437..99a258de98 100644 --- a/plugins/funind/glob_termops.mli +++ b/plugins/funind/glob_termops.mli @@ -1,4 +1,3 @@ -open API open Names open Glob_term open Misctypes diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml index 35f0929587..89537ad3f6 100644 --- a/plugins/funind/indfun.ml +++ b/plugins/funind/indfun.ml @@ -1,4 +1,3 @@ -open API open CErrors open Util open Names @@ -593,7 +592,7 @@ and rebuild_nal aux bk bl' nal typ = | na::nal,{ CAst.v = CProdN((na'::nal',bk',nal't)::rest,typ') } -> if Name.equal (snd na) (snd na') || Name.is_anonymous (snd na') then - let assum = CLocalAssum([na],bk',nal't) in + let assum = CLocalAssum([na],bk,nal't) in let new_rest = if nal' = [] then rest else ((nal',bk',nal't)::rest) in rebuild_nal (assum::aux) @@ -602,7 +601,7 @@ and rebuild_nal aux bk bl' nal typ = nal (CAst.make @@ CProdN(new_rest,typ')) else - let assum = CLocalAssum([na'],bk',nal't) in + let assum = CLocalAssum([na'],bk,nal't) in let new_rest = if nal' = [] then rest else ((nal',bk',nal't)::rest) in rebuild_nal (assum::aux) @@ -851,14 +850,14 @@ let make_graph (f_ref:global_reference) = in (match Global.body_of_constant_body c_body with | None -> error "Cannot build a graph over an axiom!" - | Some body -> + | Some (body, _) -> let env = Global.env () in let sigma = Evd.from_env env in let extern_body,extern_type = with_full_print (fun () -> (Constrextern.extern_constr false env sigma body, Constrextern.extern_type false env sigma - ((*FIXME*) Typeops.type_of_constant_type env c_body.const_type) + ((*FIXME*) c_body.const_type) ) ) () diff --git a/plugins/funind/indfun.mli b/plugins/funind/indfun.mli index fc7da6a338..93e03852ec 100644 --- a/plugins/funind/indfun.mli +++ b/plugins/funind/indfun.mli @@ -1,9 +1,8 @@ -open API open Misctypes -val warn_cannot_define_graph : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit +val warn_cannot_define_graph : ?loc:Loc.t -> Pp.t * Pp.t -> unit -val warn_cannot_define_principle : ?loc:Loc.t -> Pp.std_ppcmds * Pp.std_ppcmds -> unit +val warn_cannot_define_principle : ?loc:Loc.t -> Pp.t * Pp.t -> unit val do_generate_principle : bool -> diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml index 6fe6888f3d..f4f9ba2bbb 100644 --- a/plugins/funind/indfun_common.ml +++ b/plugins/funind/indfun_common.ml @@ -1,4 +1,3 @@ -open API open Names open Pp open Libnames @@ -342,7 +341,7 @@ let pr_info f_info = str "function_constant_type := " ++ (try Printer.pr_lconstr - (Global.type_of_global_unsafe (ConstRef f_info.function_constant)) + (fst (Global.type_of_global_in_context (Global.env ()) (ConstRef f_info.function_constant))) with e when CErrors.noncritical e -> mt ()) ++ fnl () ++ str "equation_lemma := " ++ pr_ocst f_info.equation_lemma ++ fnl () ++ str "completeness_lemma :=" ++ pr_ocst f_info.completeness_lemma ++ fnl () ++ diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli index f7a9cedd73..2e2ced790e 100644 --- a/plugins/funind/indfun_common.mli +++ b/plugins/funind/indfun_common.mli @@ -1,6 +1,4 @@ -open API open Names -open Pp (* The mk_?_id function build different name w.r.t. a function @@ -12,7 +10,7 @@ val mk_complete_id : Id.t -> Id.t val mk_equation_id : Id.t -> Id.t -val msgnl : std_ppcmds -> unit +val msgnl : Pp.t -> unit val fresh_id : Id.t list -> string -> Id.t val fresh_name : Id.t list -> string -> Name.t @@ -25,7 +23,7 @@ val id_of_name : Name.t -> Id.t val locate_ind : Libnames.reference -> inductive val locate_constant : Libnames.reference -> Constant.t val locate_with_msg : - Pp.std_ppcmds -> (Libnames.reference -> 'a) -> + Pp.t -> (Libnames.reference -> 'a) -> Libnames.reference -> 'a val filter_map : ('a -> bool) -> ('a -> 'b) -> 'a list -> 'b list @@ -90,8 +88,8 @@ val update_Function : function_info -> unit (** debugging *) -val pr_info : function_info -> Pp.std_ppcmds -val pr_table : unit -> Pp.std_ppcmds +val pr_info : function_info -> Pp.t +val pr_table : unit -> Pp.t (* val function_debug : bool ref *) diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml index 94ef2590c8..8dea6c90f5 100644 --- a/plugins/funind/invfun.ml +++ b/plugins/funind/invfun.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Ltac_plugin open Declarations open CErrors diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml index ba88563d3b..52a82b0e5e 100644 --- a/plugins/funind/merge.ml +++ b/plugins/funind/merge.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (* Merging of induction principles. *) -open API open Globnames open Tactics open Indfun_common diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml index 8e12b239e8..d3eccb58d7 100644 --- a/plugins/funind/recdef.ml +++ b/plugins/funind/recdef.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API module CVars = Vars @@ -90,7 +89,7 @@ let type_of_const sigma t = |_ -> assert false let constr_of_global x = - fst (Universes.unsafe_constr_of_global x) + fst (Global.constr_of_global_in_context (Global.env ()) x) let constant sl s = constr_of_global (find_reference sl s) diff --git a/plugins/funind/recdef.mli b/plugins/funind/recdef.mli index f3d5e73320..63bbdbe7e3 100644 --- a/plugins/funind/recdef.mli +++ b/plugins/funind/recdef.mli @@ -1,4 +1,3 @@ -open API (* val evaluable_of_global_reference : Libnames.global_reference -> Names.evaluable_global_reference *) val tclUSER_if_not_mes : diff --git a/plugins/ltac/coretactics.ml4 b/plugins/ltac/coretactics.ml4 index 50013f5583..2769802cf4 100644 --- a/plugins/ltac/coretactics.ml4 +++ b/plugins/ltac/coretactics.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Util open Locus open Misctypes diff --git a/plugins/ltac/evar_tactics.ml b/plugins/ltac/evar_tactics.ml index 7ecfa57f6d..4cab6ef336 100644 --- a/plugins/ltac/evar_tactics.ml +++ b/plugins/ltac/evar_tactics.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Names open Term diff --git a/plugins/ltac/evar_tactics.mli b/plugins/ltac/evar_tactics.mli index 7c734cd9af..122aecd75b 100644 --- a/plugins/ltac/evar_tactics.mli +++ b/plugins/ltac/evar_tactics.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Tacexpr open Locus diff --git a/plugins/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4 index 44f33ab806..6097951330 100644 --- a/plugins/ltac/extraargs.ml4 +++ b/plugins/ltac/extraargs.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Pp open Genarg open Stdarg diff --git a/plugins/ltac/extraargs.mli b/plugins/ltac/extraargs.mli index b2b3f8b6bb..b06f35ddc4 100644 --- a/plugins/ltac/extraargs.mli +++ b/plugins/ltac/extraargs.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Tacexpr open Names open Constrexpr @@ -16,13 +14,13 @@ open Misctypes val wit_orient : bool Genarg.uniform_genarg_type val orient : bool Pcoq.Gram.entry -val pr_orient : bool -> Pp.std_ppcmds +val pr_orient : bool -> Pp.t val wit_rename : (Id.t * Id.t) Genarg.uniform_genarg_type val occurrences : (int list or_var) Pcoq.Gram.entry val wit_occurrences : (int list or_var, int list or_var, int list) Genarg.genarg_type -val pr_occurrences : int list or_var -> Pp.std_ppcmds +val pr_occurrences : int list or_var -> Pp.t val occurrences_of : int list -> Locus.occurrences val wit_natural : int Genarg.uniform_genarg_type @@ -57,7 +55,7 @@ type place = Id.t gen_place val wit_hloc : (loc_place, loc_place, place) Genarg.genarg_type val hloc : loc_place Pcoq.Gram.entry -val pr_hloc : loc_place -> Pp.std_ppcmds +val pr_hloc : loc_place -> Pp.t val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.entry val wit_by_arg_tac : @@ -66,8 +64,8 @@ val wit_by_arg_tac : Geninterp.Val.t option) Genarg.genarg_type val pr_by_arg_tac : - (int * Ppextend.parenRelation -> raw_tactic_expr -> Pp.std_ppcmds) -> - raw_tactic_expr option -> Pp.std_ppcmds + (int * Ppextend.parenRelation -> raw_tactic_expr -> Pp.t) -> + raw_tactic_expr option -> Pp.t val test_lpar_id_colon : unit Pcoq.Gram.entry diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4 index 36df25cc77..f3f2f27e9e 100644 --- a/plugins/ltac/extratactics.ml4 +++ b/plugins/ltac/extratactics.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Pp open Genarg open Stdarg diff --git a/plugins/ltac/extratactics.mli b/plugins/ltac/extratactics.mli index c7ec269677..c423585e5e 100644 --- a/plugins/ltac/extratactics.mli +++ b/plugins/ltac/extratactics.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API val discrHyp : Names.Id.t -> unit Proofview.tactic val injHyp : Names.Id.t -> unit Proofview.tactic diff --git a/plugins/ltac/g_auto.ml4 b/plugins/ltac/g_auto.ml4 index 6145e373b1..301943a509 100644 --- a/plugins/ltac/g_auto.ml4 +++ b/plugins/ltac/g_auto.ml4 @@ -8,8 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Pp open Genarg open Stdarg diff --git a/plugins/ltac/g_class.ml4 b/plugins/ltac/g_class.ml4 index 0d68d38189..104977aef3 100644 --- a/plugins/ltac/g_class.ml4 +++ b/plugins/ltac/g_class.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Class_tactics open Stdarg open Tacarg diff --git a/plugins/ltac/g_eqdecide.ml4 b/plugins/ltac/g_eqdecide.ml4 index dceefeaa13..5494369022 100644 --- a/plugins/ltac/g_eqdecide.ml4 +++ b/plugins/ltac/g_eqdecide.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -14,7 +14,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Eqdecide DECLARE PLUGIN "ltac_plugin" diff --git a/plugins/ltac/g_ltac.ml4 b/plugins/ltac/g_ltac.ml4 index 4bab31b85d..2ea0f60ebc 100644 --- a/plugins/ltac/g_ltac.ml4 +++ b/plugins/ltac/g_ltac.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,9 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API - DECLARE PLUGIN "ltac_plugin" open Util @@ -433,7 +430,7 @@ let is_explicit_terminator = function TacSolve _ -> true | _ -> false VERNAC tactic_mode EXTEND VernacSolve | [ - ltac_selector_opt(g) ltac_info_opt(n) tactic(t) ltac_use_default(def) ] => [ classify_as_proofstep ] -> [ - let g = Option.default (Proof_global.get_default_goal_selector ()) g in + let g = Option.default (Proof_bullet.get_default_goal_selector ()) g in vernac_solve g n t def ] | [ - "par" ":" ltac_info_opt(n) tactic(t) ltac_use_default(def) ] => diff --git a/plugins/ltac/g_obligations.ml4 b/plugins/ltac/g_obligations.ml4 index 18e62a2111..1a2d895868 100644 --- a/plugins/ltac/g_obligations.ml4 +++ b/plugins/ltac/g_obligations.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -12,8 +12,6 @@ Syntax for the subtac terms and types. Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *) -open API -open Grammar_API open Libnames open Constrexpr open Constrexpr_ops diff --git a/plugins/ltac/g_rewrite.ml4 b/plugins/ltac/g_rewrite.ml4 index 3e6f420065..c874f8d5a3 100644 --- a/plugins/ltac/g_rewrite.ml4 +++ b/plugins/ltac/g_rewrite.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,8 +10,6 @@ (* Syntax for rewriting with strategies *) -open API -open Grammar_API open Names open Misctypes open Locus diff --git a/plugins/ltac/g_tactic.ml4 b/plugins/ltac/g_tactic.ml4 index 804f734504..d792d4ff7d 100644 --- a/plugins/ltac/g_tactic.ml4 +++ b/plugins/ltac/g_tactic.ml4 @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Pp open CErrors open Util diff --git a/plugins/ltac/pltac.ml b/plugins/ltac/pltac.ml index 84c5d3a44f..2c1b1067ea 100644 --- a/plugins/ltac/pltac.ml +++ b/plugins/ltac/pltac.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Pcoq (* Main entry for extensions *) diff --git a/plugins/ltac/pltac.mli b/plugins/ltac/pltac.mli index 9261a11c71..048dcc8e92 100644 --- a/plugins/ltac/pltac.mli +++ b/plugins/ltac/pltac.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (** Ltac parsing entries *) -open API -open Grammar_API open Loc open Names open Pcoq diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml index 8300a55e3d..140cc33440 100644 --- a/plugins/ltac/pptactic.ml +++ b/plugins/ltac/pptactic.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Pp open Names open Namegen @@ -68,22 +67,22 @@ let declare_notation_tactic_pprule kn pt = prnotation_tab := KNmap.add kn pt !prnotation_tab type 'a raw_extra_genarg_printer = - (constr_expr -> std_ppcmds) -> - (constr_expr -> std_ppcmds) -> - (tolerability -> raw_tactic_expr -> std_ppcmds) -> - 'a -> std_ppcmds + (constr_expr -> Pp.t) -> + (constr_expr -> Pp.t) -> + (tolerability -> raw_tactic_expr -> Pp.t) -> + 'a -> Pp.t type 'a glob_extra_genarg_printer = - (glob_constr_and_expr -> std_ppcmds) -> - (glob_constr_and_expr -> std_ppcmds) -> - (tolerability -> glob_tactic_expr -> std_ppcmds) -> - 'a -> std_ppcmds + (glob_constr_and_expr -> Pp.t) -> + (glob_constr_and_expr -> Pp.t) -> + (tolerability -> glob_tactic_expr -> Pp.t) -> + 'a -> Pp.t type 'a extra_genarg_printer = - (EConstr.constr -> std_ppcmds) -> - (EConstr.constr -> std_ppcmds) -> - (tolerability -> Val.t -> std_ppcmds) -> - 'a -> std_ppcmds + (EConstr.constr -> Pp.t) -> + (EConstr.constr -> Pp.t) -> + (tolerability -> Val.t -> Pp.t) -> + 'a -> Pp.t let keyword x = tag_keyword (str x) let primitive x = tag_primitive (str x) @@ -97,7 +96,7 @@ type 'a extra_genarg_printer = | None -> assert false | Some Refl -> x - let rec pr_value lev v : std_ppcmds = + let rec pr_value lev v : Pp.t = if has_type v Val.typ_list then pr_sequence (fun x -> pr_value lev x) (unbox v Val.typ_list) else if has_type v Val.typ_opt then @@ -273,7 +272,7 @@ type 'a extra_genarg_printer = | Glbwit (OptArg wit) -> Some (Option.map (in_gen (glbwit wit)) arg) | _ -> None - let rec pr_any_arg : type l. (_ -> l generic_argument -> std_ppcmds) -> _ -> l generic_argument -> std_ppcmds = + let rec pr_any_arg : type l. (_ -> l generic_argument -> Pp.t) -> _ -> l generic_argument -> Pp.t = fun prtac symb arg -> match symb with | Extend.Uentry tag when is_genarg tag (genarg_tag arg) -> prtac (1, Any) arg | Extend.Ulist1 s | Extend.Ulist0 s -> @@ -600,18 +599,18 @@ type 'a extra_genarg_printer = "raw", "glob" and "typed" levels *) type 'a printer = { - pr_tactic : tolerability -> 'tacexpr -> std_ppcmds; - pr_constr : 'trm -> std_ppcmds; - pr_lconstr : 'trm -> std_ppcmds; - pr_dconstr : 'dtrm -> std_ppcmds; - pr_pattern : 'pat -> std_ppcmds; - pr_lpattern : 'pat -> std_ppcmds; - pr_constant : 'cst -> std_ppcmds; - pr_reference : 'ref -> std_ppcmds; - pr_name : 'nam -> std_ppcmds; - pr_generic : 'lev generic_argument -> std_ppcmds; - pr_extend : int -> ml_tactic_entry -> 'a gen_tactic_arg list -> std_ppcmds; - pr_alias : int -> KerName.t -> 'a gen_tactic_arg list -> std_ppcmds; + pr_tactic : tolerability -> 'tacexpr -> Pp.t; + pr_constr : 'trm -> Pp.t; + pr_lconstr : 'trm -> Pp.t; + pr_dconstr : 'dtrm -> Pp.t; + pr_pattern : 'pat -> Pp.t; + pr_lpattern : 'pat -> Pp.t; + pr_constant : 'cst -> Pp.t; + pr_reference : 'ref -> Pp.t; + pr_name : 'nam -> Pp.t; + pr_generic : 'lev generic_argument -> Pp.t; + pr_extend : int -> ml_tactic_entry -> 'a gen_tactic_arg list -> Pp.t; + pr_alias : int -> KerName.t -> 'a gen_tactic_arg list -> Pp.t; } constraint 'a = < diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli index 519283759a..0bf9bc7f62 100644 --- a/plugins/ltac/pptactic.mli +++ b/plugins/ltac/pptactic.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,8 +9,6 @@ (** This module implements pretty-printers for tactic_expr syntactic objects and their subcomponents. *) -open API -open Pp open Genarg open Geninterp open Names @@ -25,22 +23,22 @@ type 'a grammar_tactic_prod_item_expr = | TacNonTerm of ('a * Names.Id.t option) Loc.located type 'a raw_extra_genarg_printer = - (constr_expr -> std_ppcmds) -> - (constr_expr -> std_ppcmds) -> - (tolerability -> raw_tactic_expr -> std_ppcmds) -> - 'a -> std_ppcmds + (constr_expr -> Pp.t) -> + (constr_expr -> Pp.t) -> + (tolerability -> raw_tactic_expr -> Pp.t) -> + 'a -> Pp.t type 'a glob_extra_genarg_printer = - (glob_constr_and_expr -> std_ppcmds) -> - (glob_constr_and_expr -> std_ppcmds) -> - (tolerability -> glob_tactic_expr -> std_ppcmds) -> - 'a -> std_ppcmds + (glob_constr_and_expr -> Pp.t) -> + (glob_constr_and_expr -> Pp.t) -> + (tolerability -> glob_tactic_expr -> Pp.t) -> + 'a -> Pp.t type 'a extra_genarg_printer = - (EConstr.t -> std_ppcmds) -> - (EConstr.t -> std_ppcmds) -> - (tolerability -> Val.t -> std_ppcmds) -> - 'a -> std_ppcmds + (EConstr.t -> Pp.t) -> + (EConstr.t -> Pp.t) -> + (tolerability -> Val.t -> Pp.t) -> + 'a -> Pp.t val declare_extra_genarg_pprule : ('a, 'b, 'c) genarg_type -> @@ -58,61 +56,61 @@ type pp_tactic = { val declare_notation_tactic_pprule : KerName.t -> pp_tactic -> unit val pr_with_occurrences : - ('a -> std_ppcmds) -> 'a Locus.with_occurrences -> std_ppcmds + ('a -> Pp.t) -> 'a Locus.with_occurrences -> Pp.t val pr_red_expr : - ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) * ('c -> std_ppcmds) -> - ('a,'b,'c) Genredexpr.red_expr_gen -> std_ppcmds + ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) -> + ('a,'b,'c) Genredexpr.red_expr_gen -> Pp.t val pr_may_eval : - ('a -> std_ppcmds) -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> - ('c -> std_ppcmds) -> ('a,'b,'c) Genredexpr.may_eval -> std_ppcmds + ('a -> Pp.t) -> ('a -> Pp.t) -> ('b -> Pp.t) -> + ('c -> Pp.t) -> ('a,'b,'c) Genredexpr.may_eval -> Pp.t -val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds -val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds +val pr_and_short_name : ('a -> Pp.t) -> 'a and_short_name -> Pp.t +val pr_or_by_notation : ('a -> Pp.t) -> 'a or_by_notation -> Pp.t val pr_in_clause : - ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds + ('a -> Pp.t) -> 'a Locus.clause_expr -> Pp.t val pr_clauses : bool option -> - ('a -> Pp.std_ppcmds) -> 'a Locus.clause_expr -> Pp.std_ppcmds + ('a -> Pp.t) -> 'a Locus.clause_expr -> Pp.t -val pr_raw_generic : env -> rlevel generic_argument -> std_ppcmds +val pr_raw_generic : env -> rlevel generic_argument -> Pp.t -val pr_glb_generic : env -> glevel generic_argument -> std_ppcmds +val pr_glb_generic : env -> glevel generic_argument -> Pp.t val pr_raw_extend: env -> int -> - ml_tactic_entry -> raw_tactic_arg list -> std_ppcmds + ml_tactic_entry -> raw_tactic_arg list -> Pp.t val pr_glob_extend: env -> int -> - ml_tactic_entry -> glob_tactic_arg list -> std_ppcmds + ml_tactic_entry -> glob_tactic_arg list -> Pp.t val pr_extend : - (Val.t -> std_ppcmds) -> int -> ml_tactic_entry -> Val.t list -> std_ppcmds + (Val.t -> Pp.t) -> int -> ml_tactic_entry -> Val.t list -> Pp.t -val pr_alias_key : Names.KerName.t -> std_ppcmds +val pr_alias_key : Names.KerName.t -> Pp.t -val pr_alias : (Val.t -> std_ppcmds) -> - int -> Names.KerName.t -> Val.t list -> std_ppcmds +val pr_alias : (Val.t -> Pp.t) -> + int -> Names.KerName.t -> Val.t list -> Pp.t -val pr_ltac_constant : Nametab.ltac_constant -> std_ppcmds +val pr_ltac_constant : Nametab.ltac_constant -> Pp.t -val pr_raw_tactic : raw_tactic_expr -> std_ppcmds +val pr_raw_tactic : raw_tactic_expr -> Pp.t -val pr_raw_tactic_level : tolerability -> raw_tactic_expr -> std_ppcmds +val pr_raw_tactic_level : tolerability -> raw_tactic_expr -> Pp.t -val pr_glob_tactic : env -> glob_tactic_expr -> std_ppcmds +val pr_glob_tactic : env -> glob_tactic_expr -> Pp.t -val pr_atomic_tactic : env -> Evd.evar_map -> atomic_tactic_expr -> std_ppcmds +val pr_atomic_tactic : env -> Evd.evar_map -> atomic_tactic_expr -> Pp.t -val pr_hintbases : string list option -> std_ppcmds +val pr_hintbases : string list option -> Pp.t -val pr_auto_using : ('constr -> std_ppcmds) -> 'constr list -> std_ppcmds +val pr_auto_using : ('constr -> Pp.t) -> 'constr list -> Pp.t -val pr_match_pattern : ('a -> std_ppcmds) -> 'a match_pattern -> std_ppcmds +val pr_match_pattern : ('a -> Pp.t) -> 'a match_pattern -> Pp.t -val pr_match_rule : bool -> ('a -> std_ppcmds) -> ('b -> std_ppcmds) -> - ('b, 'a) match_rule -> std_ppcmds +val pr_match_rule : bool -> ('a -> Pp.t) -> ('b -> Pp.t) -> + ('b, 'a) match_rule -> Pp.t -val pr_value : tolerability -> Val.t -> std_ppcmds +val pr_value : tolerability -> Val.t -> Pp.t val ltop : tolerability diff --git a/plugins/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml index 020b3048f6..32494a8793 100644 --- a/plugins/ltac/profile_ltac.ml +++ b/plugins/ltac/profile_ltac.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Unicode open Pp open Printer diff --git a/plugins/ltac/profile_ltac.mli b/plugins/ltac/profile_ltac.mli index 09fc549c60..52827cb36b 100644 --- a/plugins/ltac/profile_ltac.mli +++ b/plugins/ltac/profile_ltac.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API (** Ltac profiling primitives *) diff --git a/plugins/ltac/profile_ltac_tactics.ml4 b/plugins/ltac/profile_ltac_tactics.ml4 index 83fb6963b8..2b1106ee21 100644 --- a/plugins/ltac/profile_ltac_tactics.ml4 +++ b/plugins/ltac/profile_ltac_tactics.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,6 @@ (** Ltac profiling entrypoints *) -open API open Profile_ltac open Stdarg diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml index fad181c897..75b665aad9 100644 --- a/plugins/ltac/rewrite.ml +++ b/plugins/ltac/rewrite.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Pp open CErrors @@ -1462,7 +1461,7 @@ let solve_constraints env (evars,cstrs) = let nf_zeta = Reductionops.clos_norm_flags (CClosure.RedFlags.mkflags [CClosure.RedFlags.fZETA]) -exception RewriteFailure of Pp.std_ppcmds +exception RewriteFailure of Pp.t type result = (evar_map * constr option * types) option option diff --git a/plugins/ltac/rewrite.mli b/plugins/ltac/rewrite.mli index d7f92fd6e3..23767c12f5 100644 --- a/plugins/ltac/rewrite.mli +++ b/plugins/ltac/rewrite.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Environ open EConstr @@ -62,8 +61,8 @@ val strategy_of_ast : (glob_constr_and_expr, raw_red_expr) strategy_ast -> strat val map_strategy : ('a -> 'b) -> ('c -> 'd) -> ('a, 'c) strategy_ast -> ('b, 'd) strategy_ast -val pr_strategy : ('a -> Pp.std_ppcmds) -> ('b -> Pp.std_ppcmds) -> - ('a, 'b) strategy_ast -> Pp.std_ppcmds +val pr_strategy : ('a -> Pp.t) -> ('b -> Pp.t) -> + ('a, 'b) strategy_ast -> Pp.t (** Entry point for user-level "rewrite_strat" *) val cl_rewrite_clause_strat : strategy -> Id.t option -> unit Proofview.tactic diff --git a/plugins/ltac/tacarg.ml b/plugins/ltac/tacarg.ml index 2c9bf14be2..1bf9ea4c1d 100644 --- a/plugins/ltac/tacarg.ml +++ b/plugins/ltac/tacarg.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (** Generic arguments based on Ltac. *) -open API open Genarg open Geninterp open Tacexpr diff --git a/plugins/ltac/tacarg.mli b/plugins/ltac/tacarg.mli index e82cb516c0..6c4f3dd873 100644 --- a/plugins/ltac/tacarg.mli +++ b/plugins/ltac/tacarg.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Genarg open Tacexpr open Constrexpr diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml index 117a16b0af..9e3a54cc86 100644 --- a/plugins/ltac/taccoerce.ml +++ b/plugins/ltac/taccoerce.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Names open Term diff --git a/plugins/ltac/taccoerce.mli b/plugins/ltac/taccoerce.mli index 2c02171d0d..1a67f6f888 100644 --- a/plugins/ltac/taccoerce.mli +++ b/plugins/ltac/taccoerce.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Names open EConstr diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml index 270225e237..cf676f598f 100644 --- a/plugins/ltac/tacentries.ml +++ b/plugins/ltac/tacentries.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Pp open CErrors open Util diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli index c5223052cc..aa8f4efe65 100644 --- a/plugins/ltac/tacentries.mli +++ b/plugins/ltac/tacentries.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,8 +8,6 @@ (** Ltac toplevel command entries. *) -open API -open Grammar_API open Vernacexpr open Tacexpr diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml index 14b5e00c72..13b44f0e2c 100644 --- a/plugins/ltac/tacenv.ml +++ b/plugins/ltac/tacenv.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Pp open Names diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli index 2295852ce3..958109e5a7 100644 --- a/plugins/ltac/tacenv.mli +++ b/plugins/ltac/tacenv.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Tacexpr open Geninterp diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli index 67893bd11e..64da097deb 100644 --- a/plugins/ltac/tacexpr.mli +++ b/plugins/ltac/tacexpr.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Loc open Names open Constrexpr diff --git a/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml index bc1dd26d92..0554d43641 100644 --- a/plugins/ltac/tacintern.ml +++ b/plugins/ltac/tacintern.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Pattern open Pp open Genredexpr diff --git a/plugins/ltac/tacintern.mli b/plugins/ltac/tacintern.mli index 1841ab42bf..e3a4d5c798 100644 --- a/plugins/ltac/tacintern.mli +++ b/plugins/ltac/tacintern.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API -open Pp open Names open Tacexpr open Genarg @@ -57,7 +54,7 @@ val intern_hyp : glob_sign -> Id.t Loc.located -> Id.t Loc.located val intern_genarg : glob_sign -> raw_generic_argument -> glob_generic_argument (** printing *) -val print_ltac : Libnames.qualid -> std_ppcmds +val print_ltac : Libnames.qualid -> Pp.t (** Reduction expressions *) diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml index 0cd3ee2f9c..d3e625e73a 100644 --- a/plugins/ltac/tacinterp.ml +++ b/plugins/ltac/tacinterp.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Constrintern open Patternops open Pp @@ -2002,7 +2000,7 @@ let lift f = (); fun ist x -> Ftactic.enter begin fun gl -> Ftactic.return (f ist env sigma x) end -let lifts f = (); fun ist x -> Ftactic.nf_enter begin fun gl -> +let lifts f = (); fun ist x -> Ftactic.enter begin fun gl -> let env = Proofview.Goal.env gl in let sigma = Proofview.Goal.sigma gl in let (sigma, v) = f ist env sigma x in diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli index a1841afe36..73e4f3d6ab 100644 --- a/plugins/ltac/tacinterp.mli +++ b/plugins/ltac/tacinterp.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open Tactic_debug open EConstr diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml index 6d33724f1a..180fb2db40 100644 --- a/plugins/ltac/tacsubst.ml +++ b/plugins/ltac/tacsubst.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API -open Grammar_API open Util open Tacexpr open Mod_subst diff --git a/plugins/ltac/tacsubst.mli b/plugins/ltac/tacsubst.mli index 2cfe8fac94..5ac3775676 100644 --- a/plugins/ltac/tacsubst.mli +++ b/plugins/ltac/tacsubst.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Tacexpr open Mod_subst open Genarg diff --git a/plugins/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml index 53dc800231..5394b1e116 100644 --- a/plugins/ltac/tactic_debug.ml +++ b/plugins/ltac/tactic_debug.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Names open Pp diff --git a/plugins/ltac/tactic_debug.mli b/plugins/ltac/tactic_debug.mli index 6cfaed3053..2475e41f9d 100644 --- a/plugins/ltac/tactic_debug.mli +++ b/plugins/ltac/tactic_debug.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Environ open Pattern open Names @@ -59,16 +58,16 @@ val db_hyp_pattern_failure : val db_matching_failure : debug_info -> unit Proofview.NonLogical.t (** Prints an evaluation failure message for a rule *) -val db_eval_failure : debug_info -> Pp.std_ppcmds -> unit Proofview.NonLogical.t +val db_eval_failure : debug_info -> Pp.t -> unit Proofview.NonLogical.t (** An exception handler *) -val explain_logic_error: exn -> Pp.std_ppcmds +val explain_logic_error: exn -> Pp.t (** For use in the Ltac debugger: some exception that are usually consider anomalies are acceptable because they are caught later in the process that is being debugged. One should not require from users that they report these anomalies. *) -val explain_logic_error_no_anomaly : exn -> Pp.std_ppcmds +val explain_logic_error_no_anomaly : exn -> Pp.t (** Prints a logic failure message for a rule *) val db_logic_failure : debug_info -> exn -> unit Proofview.NonLogical.t @@ -78,4 +77,4 @@ val db_breakpoint : debug_info -> Id.t Loc.located message_token list -> unit Proofview.NonLogical.t val extract_ltac_trace : - ?loc:Loc.t -> Tacexpr.ltac_trace -> Pp.std_ppcmds option Loc.located + ?loc:Loc.t -> Tacexpr.ltac_trace -> Pp.t option Loc.located diff --git a/plugins/ltac/tactic_matching.ml b/plugins/ltac/tactic_matching.ml index 6dcef414c2..63b8cc4824 100644 --- a/plugins/ltac/tactic_matching.ml +++ b/plugins/ltac/tactic_matching.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,6 @@ (** This file extends Matching with the main logic for Ltac's (lazy)match and (lazy)match goal. *) -open API open Names open Tacexpr open Context.Named.Declaration diff --git a/plugins/ltac/tactic_matching.mli b/plugins/ltac/tactic_matching.mli index 304eec463e..01334d36c9 100644 --- a/plugins/ltac/tactic_matching.mli +++ b/plugins/ltac/tactic_matching.mli @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API (** This file extends Matching with the main logic for Ltac's (lazy)match and (lazy)match goal. *) diff --git a/plugins/ltac/tactic_option.ml b/plugins/ltac/tactic_option.ml index 53dfe22a9c..fdeab8dc4b 100644 --- a/plugins/ltac/tactic_option.ml +++ b/plugins/ltac/tactic_option.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Libobject open Pp diff --git a/plugins/ltac/tactic_option.mli b/plugins/ltac/tactic_option.mli index 2817b54a11..95cd243ec8 100644 --- a/plugins/ltac/tactic_option.mli +++ b/plugins/ltac/tactic_option.mli @@ -1,16 +1,15 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Tacexpr open Vernacexpr val declare_tactic_option : ?default:Tacexpr.glob_tactic_expr -> string -> (* put *) (locality_flag -> glob_tactic_expr -> unit) * (* get *) (unit -> locality_flag * unit Proofview.tactic) * - (* print *) (unit -> Pp.std_ppcmds) + (* print *) (unit -> Pp.t) diff --git a/plugins/ltac/tauto.ml b/plugins/ltac/tauto.ml index 71f7082e70..01d3f79c74 100644 --- a/plugins/ltac/tauto.ml +++ b/plugins/ltac/tauto.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Term open EConstr open Hipattern diff --git a/plugins/micromega/Env.v b/plugins/micromega/Env.v index 7e3ef89293..f205f4f765 100644 --- a/plugins/micromega/Env.v +++ b/plugins/micromega/Env.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v index 904ee4dac1..56b3d480eb 100644 --- a/plugins/micromega/EnvRing.v +++ b/plugins/micromega/EnvRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Lia.v b/plugins/micromega/Lia.v index 47b6f7c7f9..3d2712658f 100644 --- a/plugins/micromega/Lia.v +++ b/plugins/micromega/Lia.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Lqa.v b/plugins/micromega/Lqa.v index acd2751a04..8482c21857 100644 --- a/plugins/micromega/Lqa.v +++ b/plugins/micromega/Lqa.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Lra.v b/plugins/micromega/Lra.v index 5b97d8ed36..409eb663bd 100644 --- a/plugins/micromega/Lra.v +++ b/plugins/micromega/Lra.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v index 95f135c8f0..e5b5854f0a 100644 --- a/plugins/micromega/MExtraction.v +++ b/plugins/micromega/MExtraction.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/OrderedRing.v b/plugins/micromega/OrderedRing.v index 72b4dcb6e3..25e4e3c2f8 100644 --- a/plugins/micromega/OrderedRing.v +++ b/plugins/micromega/OrderedRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Psatz.v b/plugins/micromega/Psatz.v index 8acf0ff882..cabec8fc9b 100644 --- a/plugins/micromega/Psatz.v +++ b/plugins/micromega/Psatz.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/QMicromega.v b/plugins/micromega/QMicromega.v index b13285f537..9a1c842b26 100644 --- a/plugins/micromega/QMicromega.v +++ b/plugins/micromega/QMicromega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/RMicromega.v b/plugins/micromega/RMicromega.v index 30e475b710..6b232b4b58 100644 --- a/plugins/micromega/RMicromega.v +++ b/plugins/micromega/RMicromega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Refl.v b/plugins/micromega/Refl.v index 32ddb3cf4c..9d041397dd 100644 --- a/plugins/micromega/Refl.v +++ b/plugins/micromega/Refl.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/RingMicromega.v b/plugins/micromega/RingMicromega.v index ed49c3df43..e1f99d5768 100644 --- a/plugins/micromega/RingMicromega.v +++ b/plugins/micromega/RingMicromega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/Tauto.v b/plugins/micromega/Tauto.v index 391231afd9..1b4e576708 100644 --- a/plugins/micromega/Tauto.v +++ b/plugins/micromega/Tauto.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/ZCoeff.v b/plugins/micromega/ZCoeff.v index bd425e6bbf..697af9873a 100644 --- a/plugins/micromega/ZCoeff.v +++ b/plugins/micromega/ZCoeff.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/ZMicromega.v b/plugins/micromega/ZMicromega.v index 5aa8d03f99..542bfe2a14 100644 --- a/plugins/micromega/ZMicromega.v +++ b/plugins/micromega/ZMicromega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/certificate.ml b/plugins/micromega/certificate.ml index 459c72f9f6..1df895a01b 100644 --- a/plugins/micromega/certificate.ml +++ b/plugins/micromega/certificate.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml index fba1966df3..a4103634e0 100644 --- a/plugins/micromega/coq_micromega.ml +++ b/plugins/micromega/coq_micromega.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,7 +16,6 @@ (* *) (************************************************************************) -open API open Pp open Mutils open Goptions diff --git a/plugins/micromega/csdpcert.ml b/plugins/micromega/csdpcert.ml index 2536005ede..a73c1ddb76 100644 --- a/plugins/micromega/csdpcert.ml +++ b/plugins/micromega/csdpcert.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4 index d803c75549..b15dd7ae66 100644 --- a/plugins/micromega/g_micromega.ml4 +++ b/plugins/micromega/g_micromega.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,7 +16,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Ltac_plugin open Stdarg open Tacarg diff --git a/plugins/micromega/mutils.ml b/plugins/micromega/mutils.ml index b4c6d032bf..d65709a1c3 100644 --- a/plugins/micromega/mutils.ml +++ b/plugins/micromega/mutils.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml index 0e6d346a3b..49ccb468c1 100644 --- a/plugins/micromega/persistent_cache.ml +++ b/plugins/micromega/persistent_cache.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/polynomial.ml b/plugins/micromega/polynomial.ml index 90a108a3b7..be7ed7fbd4 100644 --- a/plugins/micromega/polynomial.ml +++ b/plugins/micromega/polynomial.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/sos.mli b/plugins/micromega/sos.mli index 1ca27ea20a..196a74ae30 100644 --- a/plugins/micromega/sos.mli +++ b/plugins/micromega/sos.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/sos_types.ml b/plugins/micromega/sos_types.ml index 615ac5a2fb..7cce1f8cc3 100644 --- a/plugins/micromega/sos_types.ml +++ b/plugins/micromega/sos_types.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/micromega/sos_types.mli b/plugins/micromega/sos_types.mli index 57c4e50cad..29b839cbd9 100644 --- a/plugins/micromega/sos_types.mli +++ b/plugins/micromega/sos_types.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/nsatz/Nsatz.v b/plugins/nsatz/Nsatz.v index 403f664e2b..d4c6d0dce8 100644 --- a/plugins/nsatz/Nsatz.v +++ b/plugins/nsatz/Nsatz.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/nsatz/g_nsatz.ml4 b/plugins/nsatz/g_nsatz.ml4 index 5a6d72036e..01c3d79407 100644 --- a/plugins/nsatz/g_nsatz.ml4 +++ b/plugins/nsatz/g_nsatz.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Ltac_plugin DECLARE PLUGIN "nsatz_plugin" diff --git a/plugins/nsatz/ideal.ml b/plugins/nsatz/ideal.ml index a120d4efb2..2f1d576394 100644 --- a/plugins/nsatz/ideal.ml +++ b/plugins/nsatz/ideal.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/nsatz/ideal.mli b/plugins/nsatz/ideal.mli index b7ec901afa..a667343f10 100644 --- a/plugins/nsatz/ideal.mli +++ b/plugins/nsatz/ideal.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml index dd1d8764ab..72934a15d9 100644 --- a/plugins/nsatz/nsatz.ml +++ b/plugins/nsatz/nsatz.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open CErrors open Util open Term diff --git a/plugins/nsatz/nsatz.mli b/plugins/nsatz/nsatz.mli index c0dad72ad6..d6e3071aa3 100644 --- a/plugins/nsatz/nsatz.mli +++ b/plugins/nsatz/nsatz.mli @@ -1,10 +1,9 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API val nsatz_compute : Term.constr -> unit Proofview.tactic diff --git a/plugins/nsatz/polynom.ml b/plugins/nsatz/polynom.ml index dbd9005cbe..609ca62a04 100644 --- a/plugins/nsatz/polynom.ml +++ b/plugins/nsatz/polynom.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/nsatz/polynom.mli b/plugins/nsatz/polynom.mli index 433ab5914d..d08337fe91 100644 --- a/plugins/nsatz/polynom.mli +++ b/plugins/nsatz/polynom.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/omega/Omega.v b/plugins/omega/Omega.v index 9988c85886..a53a38d35b 100644 --- a/plugins/omega/Omega.v +++ b/plugins/omega/Omega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/omega/OmegaPlugin.v b/plugins/omega/OmegaPlugin.v index cd1624984e..ce187892d4 100644 --- a/plugins/omega/OmegaPlugin.v +++ b/plugins/omega/OmegaPlugin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/omega/OmegaTactic.v b/plugins/omega/OmegaTactic.v index cd1624984e..ce187892d4 100644 --- a/plugins/omega/OmegaTactic.v +++ b/plugins/omega/OmegaTactic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v index 2780be4aaa..8da45e0ad1 100644 --- a/plugins/omega/PreOmega.v +++ b/plugins/omega/PreOmega.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml index 440a10bfb9..d07b2e0b45 100644 --- a/plugins/omega/coq_omega.ml +++ b/plugins/omega/coq_omega.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -13,7 +13,6 @@ (* *) (**************************************************************************) -open API open CErrors open Util open Names diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4 index 2fcf076f11..735af6babc 100644 --- a/plugins/omega/g_omega.ml4 +++ b/plugins/omega/g_omega.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -15,7 +15,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API DECLARE PLUGIN "omega_plugin" diff --git a/plugins/omega/omega.ml b/plugins/omega/omega.ml index 2a018fa3f4..6a1efe85b9 100644 --- a/plugins/omega/omega.ml +++ b/plugins/omega/omega.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/quote/Quote.v b/plugins/quote/Quote.v index 2d154adc57..3fdae95ff9 100644 --- a/plugins/quote/Quote.v +++ b/plugins/quote/Quote.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4 index c43d7d0b5b..f7ebd3204a 100644 --- a/plugins/quote/g_quote.ml4 +++ b/plugins/quote/g_quote.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API open Ltac_plugin open Names open Misctypes diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml index 15d0f5f37c..e1e73b1c32 100644 --- a/plugins/quote/quote.ml +++ b/plugins/quote/quote.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -101,7 +101,6 @@ (*i*) -open API open CErrors open Util open Names diff --git a/plugins/romega/const_omega.ml b/plugins/romega/const_omega.ml index 06c80a8256..4ffbd5aa8b 100644 --- a/plugins/romega/const_omega.ml +++ b/plugins/romega/const_omega.ml @@ -6,7 +6,6 @@ *************************************************************************) -open API open Names let module_refl_name = "ReflOmegaCore" diff --git a/plugins/romega/const_omega.mli b/plugins/romega/const_omega.mli index 6dc5d9f7e5..a452b1a917 100644 --- a/plugins/romega/const_omega.mli +++ b/plugins/romega/const_omega.mli @@ -6,7 +6,6 @@ *************************************************************************) -open API (** Coq objects used in romega *) diff --git a/plugins/romega/g_romega.ml4 b/plugins/romega/g_romega.ml4 index 53f6f42c8e..5fd9c94194 100644 --- a/plugins/romega/g_romega.ml4 +++ b/plugins/romega/g_romega.ml4 @@ -8,7 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API DECLARE PLUGIN "romega_plugin" diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml index 60e6e7de79..517df41d93 100644 --- a/plugins/romega/refl_omega.ml +++ b/plugins/romega/refl_omega.ml @@ -6,7 +6,6 @@ *************************************************************************) -open API open Pp open Util open Const_omega diff --git a/plugins/rtauto/Bintree.v b/plugins/rtauto/Bintree.v index 3646018719..da540f29fd 100644 --- a/plugins/rtauto/Bintree.v +++ b/plugins/rtauto/Bintree.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/rtauto/Rtauto.v b/plugins/rtauto/Rtauto.v index 0dc6e31b85..f951df26a3 100644 --- a/plugins/rtauto/Rtauto.v +++ b/plugins/rtauto/Rtauto.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.ml4 index 565308f72e..bfa1e5f393 100644 --- a/plugins/rtauto/g_rtauto.ml4 +++ b/plugins/rtauto/g_rtauto.ml4 @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API (*i camlp4deps: "grammar/grammar.cma" i*) diff --git a/plugins/rtauto/proof_search.ml b/plugins/rtauto/proof_search.ml index 8dd7a5e469..43a4107add 100644 --- a/plugins/rtauto/proof_search.ml +++ b/plugins/rtauto/proof_search.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open CErrors open Util open Goptions diff --git a/plugins/rtauto/proof_search.mli b/plugins/rtauto/proof_search.mli index 31f8e7b51d..86231cf199 100644 --- a/plugins/rtauto/proof_search.mli +++ b/plugins/rtauto/proof_search.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -38,9 +38,9 @@ val branching: state -> state list val success: state -> bool -val pp: state -> Pp.std_ppcmds +val pp: state -> Pp.t -val pr_form : form -> Pp.std_ppcmds +val pr_form : form -> Pp.t val reset_info : unit -> unit diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml index f84eebadce..9f02388c39 100644 --- a/plugins/rtauto/refl_tauto.ml +++ b/plugins/rtauto/refl_tauto.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API module Search = Explore.Make(Proof_search) diff --git a/plugins/rtauto/refl_tauto.mli b/plugins/rtauto/refl_tauto.mli index 801fc46067..bec18f6df8 100644 --- a/plugins/rtauto/refl_tauto.mli +++ b/plugins/rtauto/refl_tauto.mli @@ -1,13 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (* raises Not_found if no proof is found *) -open API type atom_env= {mutable next:int; diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v index 5f5b97925f..447acb9057 100644 --- a/plugins/setoid_ring/ArithRing.v +++ b/plugins/setoid_ring/ArithRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/BinList.v b/plugins/setoid_ring/BinList.v index d639f6085f..37eb5899a8 100644 --- a/plugins/setoid_ring/BinList.v +++ b/plugins/setoid_ring/BinList.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Cring.v b/plugins/setoid_ring/Cring.v index 17a57e62a7..9bc2f6a3ec 100644 --- a/plugins/setoid_ring/Cring.v +++ b/plugins/setoid_ring/Cring.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Field.v b/plugins/setoid_ring/Field.v index 73a131398b..607e4799fc 100644 --- a/plugins/setoid_ring/Field.v +++ b/plugins/setoid_ring/Field.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Field_tac.v b/plugins/setoid_ring/Field_tac.v index babbb86a96..eb93e2c0f5 100644 --- a/plugins/setoid_ring/Field_tac.v +++ b/plugins/setoid_ring/Field_tac.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v index 2932d379e0..56b985aa34 100644 --- a/plugins/setoid_ring/Field_theory.v +++ b/plugins/setoid_ring/Field_theory.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v index 9c690e2b4a..98ffff4322 100644 --- a/plugins/setoid_ring/InitialRing.v +++ b/plugins/setoid_ring/InitialRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/NArithRing.v b/plugins/setoid_ring/NArithRing.v index 54e2789ba4..843b12ad18 100644 --- a/plugins/setoid_ring/NArithRing.v +++ b/plugins/setoid_ring/NArithRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ncring.v b/plugins/setoid_ring/Ncring.v index cd3bef4353..8319e84878 100644 --- a/plugins/setoid_ring/Ncring.v +++ b/plugins/setoid_ring/Ncring.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ncring_initial.v b/plugins/setoid_ring/Ncring_initial.v index 20022c00ec..6596d80c8b 100644 --- a/plugins/setoid_ring/Ncring_initial.v +++ b/plugins/setoid_ring/Ncring_initial.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ncring_polynom.v b/plugins/setoid_ring/Ncring_polynom.v index 109808ee0f..99c7a42c50 100644 --- a/plugins/setoid_ring/Ncring_polynom.v +++ b/plugins/setoid_ring/Ncring_polynom.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ncring_tac.v b/plugins/setoid_ring/Ncring_tac.v index 5e30a13000..25afeaa7f5 100644 --- a/plugins/setoid_ring/Ncring_tac.v +++ b/plugins/setoid_ring/Ncring_tac.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ring.v b/plugins/setoid_ring/Ring.v index 77576cb933..86051e4589 100644 --- a/plugins/setoid_ring/Ring.v +++ b/plugins/setoid_ring/Ring.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ring_base.v b/plugins/setoid_ring/Ring_base.v index dc7c10cc5f..8a8b46b601 100644 --- a/plugins/setoid_ring/Ring_base.v +++ b/plugins/setoid_ring/Ring_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v index b69196679f..ac54d862c9 100644 --- a/plugins/setoid_ring/Ring_polynom.v +++ b/plugins/setoid_ring/Ring_polynom.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v index f7757a18da..8dda5ecd34 100644 --- a/plugins/setoid_ring/Ring_theory.v +++ b/plugins/setoid_ring/Ring_theory.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/ZArithRing.v b/plugins/setoid_ring/ZArithRing.v index 23784cf33f..73b170a7a6 100644 --- a/plugins/setoid_ring/ZArithRing.v +++ b/plugins/setoid_ring/ZArithRing.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4 index ada41274fa..05ab8ab326 100644 --- a/plugins/setoid_ring/g_newring.ml4 +++ b/plugins/setoid_ring/g_newring.ml4 @@ -8,8 +8,6 @@ (*i camlp4deps: "grammar/grammar.cma" i*) -open API -open Grammar_API open Ltac_plugin open Pp open Util diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml index da21f64ab1..0f996c65aa 100644 --- a/plugins/setoid_ring/newring.ml +++ b/plugins/setoid_ring/newring.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Ltac_plugin open Pp open Util diff --git a/plugins/setoid_ring/newring.mli b/plugins/setoid_ring/newring.mli index 7f685063c4..d9d32c681d 100644 --- a/plugins/setoid_ring/newring.mli +++ b/plugins/setoid_ring/newring.mli @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Names open EConstr open Libnames diff --git a/plugins/setoid_ring/newring_ast.mli b/plugins/setoid_ring/newring_ast.mli index b7afd2effc..d37582bd79 100644 --- a/plugins/setoid_ring/newring_ast.mli +++ b/plugins/setoid_ring/newring_ast.mli @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Term open Libnames open Constrexpr diff --git a/plugins/ssr/ssrast.mli b/plugins/ssr/ssrast.mli index 94eaa1d6aa..cdd4ee6459 100644 --- a/plugins/ssr/ssrast.mli +++ b/plugins/ssr/ssrast.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Names open Ltac_plugin diff --git a/plugins/ssr/ssrbwd.ml b/plugins/ssr/ssrbwd.ml index 3988f00bad..cc0e86684e 100644 --- a/plugins/ssr/ssrbwd.ml +++ b/plugins/ssr/ssrbwd.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Printer open Pretyping open Globnames diff --git a/plugins/ssr/ssrbwd.mli b/plugins/ssr/ssrbwd.mli index 20a1263d24..af9f7491ad 100644 --- a/plugins/ssr/ssrbwd.mli +++ b/plugins/ssr/ssrbwd.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API val apply_top_tac : Goal.goal Evd.sigma -> Goal.goal list Evd.sigma diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index 411ce6853c..799e969ae2 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -8,8 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API -open Grammar_API open Util open Names open Evd diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli index f611685769..2eadd5f26c 100644 --- a/plugins/ssr/ssrcommon.mli +++ b/plugins/ssr/ssrcommon.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Tacmach open Names open Environ @@ -42,7 +41,7 @@ val nohint : 'a ssrhint (******************************** misc ************************************) -val errorstrm : Pp.std_ppcmds -> 'a +val errorstrm : Pp.t -> 'a val anomaly : string -> 'a val array_app_tl : 'a array -> 'a list -> 'a list diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml index bd9a05891a..832044909c 100644 --- a/plugins/ssr/ssrelim.ml +++ b/plugins/ssr/ssrelim.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Util open Names open Printer diff --git a/plugins/ssr/ssrelim.mli b/plugins/ssr/ssrelim.mli index 825b4758e3..66e202b48f 100644 --- a/plugins/ssr/ssrelim.mli +++ b/plugins/ssr/ssrelim.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ssrmatching_plugin val ssrelim : diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml index b0fe898975..ab6a60f4ee 100644 --- a/plugins/ssr/ssrequality.ml +++ b/plugins/ssr/ssrequality.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ltac_plugin open Util open Names diff --git a/plugins/ssr/ssrequality.mli b/plugins/ssr/ssrequality.mli index f9ab5d74fe..a3366887fb 100644 --- a/plugins/ssr/ssrequality.mli +++ b/plugins/ssr/ssrequality.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ssrmatching_plugin open Ssrast diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml index 660c2e776c..8e6329a15e 100644 --- a/plugins/ssr/ssrfwd.ml +++ b/plugins/ssr/ssrfwd.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Names open Tacmach diff --git a/plugins/ssr/ssrfwd.mli b/plugins/ssr/ssrfwd.mli index 7f254074c7..e5b5b58fff 100644 --- a/plugins/ssr/ssrfwd.mli +++ b/plugins/ssr/ssrfwd.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Names open Ltac_plugin diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml index 06bbd749e6..023778fdbf 100644 --- a/plugins/ssr/ssripats.ml +++ b/plugins/ssr/ssripats.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Names open Pp open Term diff --git a/plugins/ssr/ssripats.mli b/plugins/ssr/ssripats.mli index aefdc8e111..6c36e67e83 100644 --- a/plugins/ssr/ssripats.mli +++ b/plugins/ssr/ssripats.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ssrmatching_plugin open Ssrast open Ssrcommon diff --git a/plugins/ssr/ssrparser.ml4 b/plugins/ssr/ssrparser.ml4 index 09917339a7..ce23bb2b30 100644 --- a/plugins/ssr/ssrparser.ml4 +++ b/plugins/ssr/ssrparser.ml4 @@ -8,8 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API -open Grammar_API open Names open Pp open Pcoq diff --git a/plugins/ssr/ssrparser.mli b/plugins/ssr/ssrparser.mli index 1548206666..88beeaa711 100644 --- a/plugins/ssr/ssrparser.mli +++ b/plugins/ssr/ssrparser.mli @@ -8,9 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API -open Grammar_API - val ssrtacarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry val wit_ssrtacarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type val pr_ssrtacarg : 'a -> 'b -> (int * Ppextend.parenRelation -> 'c) -> 'c @@ -19,5 +16,5 @@ val ssrtclarg : Tacexpr.raw_tactic_expr Pcoq.Gram.entry val wit_ssrtclarg : (Tacexpr.raw_tactic_expr, Tacexpr.glob_tactic_expr, Geninterp.Val.t) Genarg.genarg_type val pr_ssrtclarg : 'a -> 'b -> (int * Ppextend.parenRelation -> 'c -> 'd) -> 'c -> 'd -val add_genarg : string -> ('a -> Pp.std_ppcmds) -> 'a Genarg.uniform_genarg_type +val add_genarg : string -> ('a -> Pp.t) -> 'a Genarg.uniform_genarg_type diff --git a/plugins/ssr/ssrprinters.ml b/plugins/ssr/ssrprinters.ml index 427109c1b2..e865ef706d 100644 --- a/plugins/ssr/ssrprinters.ml +++ b/plugins/ssr/ssrprinters.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Pp open Names open Printer diff --git a/plugins/ssr/ssrprinters.mli b/plugins/ssr/ssrprinters.mli index 8da9bc72bc..f231068265 100644 --- a/plugins/ssr/ssrprinters.mli +++ b/plugins/ssr/ssrprinters.mli @@ -8,20 +8,19 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ssrast val pp_term : - Goal.goal Evd.sigma -> EConstr.constr -> Pp.std_ppcmds + Goal.goal Evd.sigma -> EConstr.constr -> Pp.t -val pr_spc : unit -> Pp.std_ppcmds -val pr_bar : unit -> Pp.std_ppcmds +val pr_spc : unit -> Pp.t +val pr_bar : unit -> Pp.t val pr_list : - (unit -> Pp.std_ppcmds) -> ('a -> Pp.std_ppcmds) -> 'a list -> Pp.std_ppcmds + (unit -> Pp.t) -> ('a -> Pp.t) -> 'a list -> Pp.t val pp_concat : - Pp.std_ppcmds -> - ?sep:Pp.std_ppcmds -> Pp.std_ppcmds list -> Pp.std_ppcmds + Pp.t -> + ?sep:Pp.t -> Pp.t list -> Pp.t val xInParens : ssrtermkind val xWithAt : ssrtermkind @@ -30,17 +29,17 @@ val xCpattern : ssrtermkind val pr_term : ssrtermkind * (Glob_term.glob_constr * Constrexpr.constr_expr option) -> - Pp.std_ppcmds + Pp.t -val pr_hyp : ssrhyp -> Pp.std_ppcmds +val pr_hyp : ssrhyp -> Pp.t -val prl_constr_expr : Constrexpr.constr_expr -> Pp.std_ppcmds -val prl_glob_constr : Glob_term.glob_constr -> Pp.std_ppcmds +val prl_constr_expr : Constrexpr.constr_expr -> Pp.t +val prl_glob_constr : Glob_term.glob_constr -> Pp.t val pr_guarded : - (string -> int -> bool) -> ('a -> Pp.std_ppcmds) -> 'a -> Pp.std_ppcmds + (string -> int -> bool) -> ('a -> Pp.t) -> 'a -> Pp.t -val pr_occ : ssrocc -> Pp.std_ppcmds +val pr_occ : ssrocc -> Pp.t -val ppdebug : Pp.std_ppcmds Lazy.t -> unit +val ppdebug : Pp.t Lazy.t -> unit diff --git a/plugins/ssr/ssrtacticals.ml b/plugins/ssr/ssrtacticals.ml index b586d05e1c..5e43c83749 100644 --- a/plugins/ssr/ssrtacticals.ml +++ b/plugins/ssr/ssrtacticals.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Names open Termops open Tacmach diff --git a/plugins/ssr/ssrtacticals.mli b/plugins/ssr/ssrtacticals.mli index 297cfdfdc0..c1f65a31e9 100644 --- a/plugins/ssr/ssrtacticals.mli +++ b/plugins/ssr/ssrtacticals.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API val tclSEQAT : Ltac_plugin.Tacinterp.interp_sign -> diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4 index 4c8827bf84..9c59d83d4e 100644 --- a/plugins/ssr/ssrvernac.ml4 +++ b/plugins/ssr/ssrvernac.ml4 @@ -8,8 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API -open Grammar_API open Names open Term open Termops @@ -337,7 +335,8 @@ let coerce_search_pattern_to_sort hpat = Pattern.PApp (fp, args') in let hr, na = splay_search_pattern 0 hpat in let dc, ht = - Reductionops.splay_prod env sigma (EConstr.of_constr (Universes.unsafe_type_of_global hr)) in + let hr, _ = Global.type_of_global_in_context (Global.env ()) hr (** FIXME *) in + Reductionops.splay_prod env sigma (EConstr.of_constr hr) in let np = List.length dc in if np < na then CErrors.user_err (Pp.str "too many arguments in head search pattern") else let hpat' = if np = na then hpat else mkPApp hpat (np - na) [||] in diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml index cc142e091c..338ecccc2d 100644 --- a/plugins/ssr/ssrview.ml +++ b/plugins/ssr/ssrview.ml @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Util open Names open Term diff --git a/plugins/ssr/ssrview.mli b/plugins/ssr/ssrview.mli index 8a7bd5d6e7..6fd906ff4f 100644 --- a/plugins/ssr/ssrview.mli +++ b/plugins/ssr/ssrview.mli @@ -8,7 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API open Ssrast open Ssrcommon diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4 index 796b6f43e6..f6300ab7e1 100644 --- a/plugins/ssrmatching/ssrmatching.ml4 +++ b/plugins/ssrmatching/ssrmatching.ml4 @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,9 +8,6 @@ (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *) -open API -open Grammar_API - (* Defining grammar rules with "xx" in it automatically declares keywords too, * we thus save the lexer to restore it at the end of the file *) let frozen_lexer = CLexer.get_keyword_state () ;; diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli index 1853bc35dc..8e2a1a7176 100644 --- a/plugins/ssrmatching/ssrmatching.mli +++ b/plugins/ssrmatching/ssrmatching.mli @@ -1,8 +1,6 @@ (* (c) Copyright 2006-2015 Microsoft Corporation and Inria. *) (* Distributed under the terms of CeCILL-B. *) -open API -open Grammar_API open Goal open Genarg open Tacexpr @@ -17,7 +15,7 @@ open Term (** The type of context patterns, the patterns of the [set] tactic and [:] tactical. These are patterns that identify a precise subterm. *) type cpattern -val pr_cpattern : cpattern -> Pp.std_ppcmds +val pr_cpattern : cpattern -> Pp.t (** CS cpattern: (f _), (X in t), (t in X in t), (t as X in t) *) val cpattern : cpattern Pcoq.Gram.entry @@ -31,7 +29,7 @@ val wit_lcpattern : cpattern uniform_genarg_type These patterns also include patterns that identify all the subterms of a context (i.e. "in" prefix) *) type rpattern -val pr_rpattern : rpattern -> Pp.std_ppcmds +val pr_rpattern : rpattern -> Pp.t (** OS rpattern: f _, in t, X in t, in X in t, t in X in t, t as X in t *) val rpattern : rpattern Pcoq.Gram.entry @@ -52,7 +50,7 @@ type ('ident, 'term) ssrpattern = | E_As_X_In_T of 'term * 'ident * 'term type pattern = evar_map * (constr, constr) ssrpattern -val pp_pattern : pattern -> Pp.std_ppcmds +val pp_pattern : pattern -> Pp.t (** Extracts the redex and applies to it the substitution part of the pattern. @raise Anomaly if called on [In_T] or [In_X_In_T] *) @@ -117,7 +115,7 @@ val fill_occ_pattern : the T pattern above, and calls a continuation on its occurrences. *) type ssrdir = L2R | R2L -val pr_dir_side : ssrdir -> Pp.std_ppcmds +val pr_dir_side : ssrdir -> Pp.t (** a pattern for a term with wildcards *) type tpattern @@ -227,7 +225,7 @@ val loc_of_cpattern : cpattern -> Loc.t option val id_of_pattern : pattern -> Names.Id.t option val is_wildcard : cpattern -> bool val cpattern_of_id : Names.Id.t -> cpattern -val pr_constr_pat : constr -> Pp.std_ppcmds +val pr_constr_pat : constr -> Pp.t val pf_merge_uc : UState.t -> goal Evd.sigma -> goal Evd.sigma val pf_unsafe_merge_uc : UState.t -> goal Evd.sigma -> goal Evd.sigma diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml index 6bf5b8cfca..c41ec39cb4 100644 --- a/plugins/syntax/ascii_syntax.ml +++ b/plugins/syntax/ascii_syntax.ml @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -open API (* Poor's man DECLARE PLUGIN *) let __coq_plugin_name = "ascii_syntax_plugin" diff --git a/plugins/syntax/int31_syntax.ml b/plugins/syntax/int31_syntax.ml index 5d1412ba76..af64b1479a 100644 --- a/plugins/syntax/int31_syntax.ml +++ b/plugins/syntax/int31_syntax.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API (* Poor's man DECLARE PLUGIN *) let __coq_plugin_name = "int31_syntax_plugin" diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml index a3d13c4077..524a5c5221 100644 --- a/plugins/syntax/nat_syntax.ml +++ b/plugins/syntax/nat_syntax.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API (* Poor's man DECLARE PLUGIN *) let __coq_plugin_name = "nat_syntax_plugin" diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml index a734681235..06117de79a 100644 --- a/plugins/syntax/r_syntax.ml +++ b/plugins/syntax/r_syntax.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Util open Names open Globnames diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml index a4335a508b..b7f13b0400 100644 --- a/plugins/syntax/string_syntax.ml +++ b/plugins/syntax/string_syntax.ml @@ -6,7 +6,6 @@ (* * GNU Lesser General Public License Version 2.1 *) (***********************************************************************) -open API open Globnames open Ascii_syntax_plugin.Ascii_syntax open Glob_term diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml index dfff8d9dfb..af3df28890 100644 --- a/plugins/syntax/z_syntax.ml +++ b/plugins/syntax/z_syntax.ml @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open API open Pp open CErrors open Util diff --git a/pretyping/arguments_renaming.ml b/pretyping/arguments_renaming.ml index c7b37aba5c..ea33f1c0d6 100644 --- a/pretyping/arguments_renaming.ml +++ b/pretyping/arguments_renaming.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/arguments_renaming.mli b/pretyping/arguments_renaming.mli index e123e77862..804e38216c 100644 --- a/pretyping/arguments_renaming.mli +++ b/pretyping/arguments_renaming.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/cases.ml b/pretyping/cases.ml index b88532e1b9..49f073d663 100644 --- a/pretyping/cases.ml +++ b/pretyping/cases.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/cases.mli b/pretyping/cases.mli index 4b1fde25a8..428f64b999 100644 --- a/pretyping/cases.mli +++ b/pretyping/cases.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml index 6c2086f3e0..19d61a64db 100644 --- a/pretyping/cbv.ml +++ b/pretyping/cbv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli index eb25994bef..3ee7bebf08 100644 --- a/pretyping/cbv.mli +++ b/pretyping/cbv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/classops.ml b/pretyping/classops.ml index 8d87f6e99c..1cc072a2a2 100644 --- a/pretyping/classops.ml +++ b/pretyping/classops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -89,7 +89,7 @@ sig type t val compare : t -> t -> int val equal : t -> t -> bool - val print : t -> std_ppcmds + val print : t -> Pp.t end type 'a t val empty : 'a t @@ -324,7 +324,7 @@ let coercion_value { coe_value = c; coe_type = t; coe_context = ctx; (* rajouter une coercion dans le graphe *) let path_printer = ref (fun _ -> str "<a class path>" - : (Bijint.Index.t * Bijint.Index.t) * inheritance_path -> std_ppcmds) + : (Bijint.Index.t * Bijint.Index.t) * inheritance_path -> Pp.t) let install_path_printer f = path_printer := f @@ -403,7 +403,7 @@ type coercion = { (* Computation of the class arity *) let reference_arity_length ref = - let t = Universes.unsafe_type_of_global ref in + let t, _ = Global.type_of_global_in_context (Global.env ()) ref in List.length (fst (Reductionops.splay_arity (Global.env()) Evd.empty (EConstr.of_constr t))) (** FIXME *) let projection_arity_length p = diff --git a/pretyping/classops.mli b/pretyping/classops.mli index c4238e8b0d..8707078b58 100644 --- a/pretyping/classops.mli +++ b/pretyping/classops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -95,15 +95,14 @@ val lookup_pattern_path_between : (**/**) (* Crade *) -open Pp val install_path_printer : - ((cl_index * cl_index) * inheritance_path -> std_ppcmds) -> unit + ((cl_index * cl_index) * inheritance_path -> Pp.t) -> unit (**/**) (** {6 This is for printing purpose } *) val string_of_class : cl_typ -> string -val pr_class : cl_typ -> std_ppcmds -val pr_cl_index : cl_index -> std_ppcmds +val pr_class : cl_typ -> Pp.t +val pr_cl_index : cl_index -> Pp.t val get_coercion_value : coe_index -> Constr.t val inheritance_graph : unit -> ((cl_index * cl_index) * inheritance_path) list val classes : unit -> cl_typ list diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml index 1282e3cb86..535a62046a 100644 --- a/pretyping/coercion.ml +++ b/pretyping/coercion.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/coercion.mli b/pretyping/coercion.mli index ab1f6c110f..a8c07d2efa 100644 --- a/pretyping/coercion.mli +++ b/pretyping/coercion.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/constr_matching.ml b/pretyping/constr_matching.ml index 2cb837ba03..886cfd880f 100644 --- a/pretyping/constr_matching.ml +++ b/pretyping/constr_matching.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/constr_matching.mli b/pretyping/constr_matching.mli index 4734c90a87..1d7019d09f 100644 --- a/pretyping/constr_matching.mli +++ b/pretyping/constr_matching.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index c93b1e568c..a27debe735 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -81,7 +81,7 @@ let encode_tuple r = module PrintingInductiveMake = functor (Test : sig val encode : reference -> inductive - val member_message : std_ppcmds -> bool -> std_ppcmds + val member_message : Pp.t -> bool -> Pp.t val field : string val title : string end) -> @@ -475,8 +475,8 @@ let rec detype flags avoid env sigma t = CAst.make @@ GApp (f',args''@args') | _ -> GApp (f',args') in - mkapp (detype flags avoid env sigma f) - (Array.map_to_list (detype flags avoid env sigma) args) + mkapp (detype flags avoid env sigma f) + (detype_array flags avoid env sigma args) | Const (sp,u) -> GRef (ConstRef sp, detype_instance sigma u) | Proj (p,c) -> let noparams () = @@ -694,6 +694,15 @@ and detype_binder (lax,isgoal as flags) bk avoid env sigma na body ty c = let t = if s != InProp && not !Flags.raw_print then None else Some (detype (lax,false) avoid env sigma ty) in GLetIn (na', c, t, r) +(** We use a dedicated function here to prevent overallocation from + Array.map_to_list. *) +and detype_array flags avoid env sigma args = + let ans = ref [] in + for i = Array.length args - 1 downto 0 do + ans := detype flags avoid env sigma args.(i) :: !ans; + done; + !ans + let detype_rel_context ?(lax=false) where avoid env sigma sign = let where = Option.map (fun c -> EConstr.it_mkLambda_or_LetIn c sign) where in let rec aux avoid env = function diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli index da287ae9f0..59f3f967d3 100644 --- a/pretyping/detyping.mli +++ b/pretyping/detyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -66,7 +66,7 @@ val subst_genarg_hook : module PrintingInductiveMake : functor (Test : sig val encode : Libnames.reference -> Names.inductive - val member_message : Pp.std_ppcmds -> bool -> Pp.std_ppcmds + val member_message : Pp.t -> bool -> Pp.t val field : string val title : string end) -> @@ -75,9 +75,9 @@ module PrintingInductiveMake : val compare : t -> t -> int val encode : Libnames.reference -> Names.inductive val subst : substitution -> t -> t - val printer : t -> Pp.std_ppcmds + val printer : t -> Pp.t val key : Goptions.option_name val title : string - val member_message : t -> bool -> Pp.std_ppcmds + val member_message : t -> bool -> Pp.t val synchronous : bool end diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index d84363089d..cb76df4e8a 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -205,7 +205,8 @@ let check_conv_record env sigma (t1,sk1) (t2,sk2) = else match (Stack.strip_n_app (l_us-1) sk2_effective) with | None -> raise Not_found | Some (l',el,s') -> (l'@Stack.append_app [|el|] Stack.empty,s') in - let subst, ctx' = Universes.fresh_universe_context_set_instance ctx in + let u, ctx' = Universes.fresh_instance_from ctx None in + let subst = Univ.make_inverse_instance_subst u in let c = EConstr.of_constr c in let c' = subst_univs_level_constr subst c in let t' = EConstr.of_constr t' in @@ -353,9 +354,8 @@ let exact_ise_stack2 env evd f sk1 sk2 = let check_leq_inductives evd cumi u u' = let u = EConstr.EInstance.kind evd u in let u' = EConstr.EInstance.kind evd u' in - let length_ind_instance = - Univ.Instance.length - (Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context cumi)) + let length_ind_instance = + Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi) in let ind_sbcst = Univ.ACumulativityInfo.subtyp_context cumi in if not ((length_ind_instance = Univ.Instance.length u) && @@ -364,9 +364,7 @@ let check_leq_inductives evd cumi u u' = else begin let comp_subst = (Univ.Instance.append u u') in - let comp_cst = - Univ.UContext.constraints (Univ.subst_instance_context comp_subst ind_sbcst) - in + let comp_cst = Univ.AUContext.instantiate comp_subst ind_sbcst in Evd.add_constraints evd comp_cst end diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli index 45857df2ae..c30d1d26bf 100644 --- a/pretyping/evarconv.mli +++ b/pretyping/evarconv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml index 2d86daadb6..7f5a780f9c 100644 --- a/pretyping/evardefine.ml +++ b/pretyping/evardefine.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/evardefine.mli b/pretyping/evardefine.mli index b8134a28c5..5477c5c99d 100644 --- a/pretyping/evardefine.mli +++ b/pretyping/evardefine.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -43,5 +43,5 @@ val define_evar_as_sort : env -> evar_map -> existential -> evar_map * sorts (** {6 debug pretty-printer:} *) -val pr_tycon : env -> evar_map -> type_constraint -> Pp.std_ppcmds +val pr_tycon : env -> evar_map -> type_constraint -> Pp.t diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml index ff0aeff75d..ef0fb8ea6e 100644 --- a/pretyping/evarsolve.ml +++ b/pretyping/evarsolve.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -34,12 +34,6 @@ let get_polymorphic_positions sigma f = (match oib.mind_arity with | RegularArity _ -> assert false | TemplateArity templ -> templ.template_param_levels) - | Const (cst, u) -> - let cb = Global.lookup_constant cst in - (match cb.const_type with - | RegularArity _ -> assert false - | TemplateArity (_, templ) -> - templ.template_param_levels) | _ -> assert false let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false) @@ -70,7 +64,7 @@ let refresh_universes ?(status=univ_rigid) ?(onlyalg=false) ?(refreshset=false) else t | UnivFlexible alg -> if onlyalg && alg then - (evdref := Evd.make_flexible_variable !evdref false l; t) + (evdref := Evd.make_flexible_variable !evdref ~algebraic:false l; t) else t)) | Prop Pos when refreshset && not direction -> (* Cannot make a universe "lower" than "Set", diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli index 02b5c59d26..811b4dc18f 100644 --- a/pretyping/evarsolve.mli +++ b/pretyping/evarsolve.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/find_subterm.ml b/pretyping/find_subterm.ml index 3fc569fc4a..9e7652da64 100644 --- a/pretyping/find_subterm.ml +++ b/pretyping/find_subterm.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/find_subterm.mli b/pretyping/find_subterm.mli index d22f94e4e5..e77d8ff645 100644 --- a/pretyping/find_subterm.mli +++ b/pretyping/find_subterm.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml index 9c09396ccc..b94228e75e 100644 --- a/pretyping/glob_ops.ml +++ b/pretyping/glob_ops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli index 6bb421e732..bd9e111f5c 100644 --- a/pretyping/glob_ops.mli +++ b/pretyping/glob_ops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml index 97aec1814f..aced42f839 100644 --- a/pretyping/indrec.ml +++ b/pretyping/indrec.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/indrec.mli b/pretyping/indrec.mli index a22470ae8c..2825c4d83a 100644 --- a/pretyping/indrec.mli +++ b/pretyping/indrec.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml index 2ae7c0f809..88ca9b5ca8 100644 --- a/pretyping/inductiveops.ml +++ b/pretyping/inductiveops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli index 811f47f39a..aa38d3b47d 100644 --- a/pretyping/inductiveops.mli +++ b/pretyping/inductiveops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/locusops.ml b/pretyping/locusops.ml index e555742bca..86bc471323 100644 --- a/pretyping/locusops.ml +++ b/pretyping/locusops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/locusops.mli b/pretyping/locusops.mli index c7661239e3..718d074cf4 100644 --- a/pretyping/locusops.mli +++ b/pretyping/locusops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/miscops.ml b/pretyping/miscops.ml index 69bc2d11ff..bc563b46dc 100644 --- a/pretyping/miscops.ml +++ b/pretyping/miscops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/miscops.mli b/pretyping/miscops.mli index f30dc1a4b6..dae29208ed 100644 --- a/pretyping/miscops.mli +++ b/pretyping/miscops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml index 61118cf777..5142af3567 100644 --- a/pretyping/nativenorm.ml +++ b/pretyping/nativenorm.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/nativenorm.mli b/pretyping/nativenorm.mli index c899340c8c..4e7f2110dd 100644 --- a/pretyping/nativenorm.mli +++ b/pretyping/nativenorm.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml index c36542aebc..5826cc1355 100644 --- a/pretyping/patternops.ml +++ b/pretyping/patternops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/patternops.mli b/pretyping/patternops.mli index 791fd74ed3..3a1faf1c77 100644 --- a/pretyping/patternops.mli +++ b/pretyping/patternops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml index d7c04b08b0..54b477bed9 100644 --- a/pretyping/pretype_errors.ml +++ b/pretyping/pretype_errors.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli index c303d5d949..124fa6e06c 100644 --- a/pretyping/pretype_errors.mli +++ b/pretyping/pretype_errors.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index 7488f35bfe..b4d87dfdb0 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -511,8 +511,8 @@ let pretype_global ?loc rigid env evd gr us = match us with | None -> evd, None | Some l -> - let _, ctx = Universes.unsafe_constr_of_global gr in - let len = Univ.UContext.size ctx in + let _, ctx = Global.constr_of_global_in_context env.ExtraEnv.env gr in + let len = Univ.AUContext.size ctx in interp_instance ?loc evd ~len l in let (sigma, c) = Evd.fresh_global ?loc ~rigid ?names:instance env.ExtraEnv.env evd gr in @@ -1136,8 +1136,13 @@ and pretype_type k0 resolve_tc valcon (env : ExtraEnv.t) evdref lvar = function evd_comb1 (define_evar_as_sort env.ExtraEnv.env) evdref ev | _ -> anomaly (Pp.str "Found a type constraint which is not a type.") in - { utj_val = v; - utj_type = s } + (* Correction of bug #5315 : we need to define an evar for *all* holes *) + let evkt = e_new_evar env evdref ~src:(loc, knd) ~naming (mkSort s) in + let ev,_ = destEvar !evdref evkt in + evdref := Evd.define ev (to_constr !evdref v) !evdref; + (* End of correction of bug #5315 *) + { utj_val = v; + utj_type = s } | None -> let env = ltac_interp_name_env k0 lvar env !evdref in let s = evd_comb0 (new_sort_variable univ_flexible_alg) evdref in diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index e17468ef83..6e533f1784 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/program.ml b/pretyping/program.ml index f9be82024a..bdc34bc532 100644 --- a/pretyping/program.ml +++ b/pretyping/program.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/program.mli b/pretyping/program.mli index 8439b9528c..70ab97e83e 100644 --- a/pretyping/program.mli +++ b/pretyping/program.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml index 283a1dcd18..a23579609a 100644 --- a/pretyping/recordops.ml +++ b/pretyping/recordops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -134,7 +134,7 @@ let find_projection = function type obj_typ = { o_DEF : constr; - o_CTX : Univ.ContextSet.t; + o_CTX : Univ.AUContext.t; o_INJ : int option; (* position of trivial argument if any *) o_TABS : constr list; (* ordered *) o_TPARAMS : constr list; (* ordered *) @@ -189,22 +189,26 @@ let cs_pattern_of_constr t = let warn_projection_no_head_constant = CWarnings.create ~name:"projection-no-head-constant" ~category:"typechecker" - (fun (t,con_pp,proji_sp_pp) -> + (fun (sign,env,t,con,proji_sp) -> + let sign = List.map (on_snd EConstr.Unsafe.to_constr) sign in + let env = Termops.push_rels_assum sign env in + let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con) in + let proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in + let term_pp = Termops.print_constr_env env Evd.empty (EConstr.of_constr t) in strbrk "Projection value has no head constant: " - ++ Termops.print_constr (EConstr.of_constr t) ++ strbrk " in canonical instance " + ++ term_pp ++ strbrk " in canonical instance " ++ con_pp ++ str " of " ++ proji_sp_pp ++ strbrk ", ignoring it.") (* Intended to always succeed *) let compute_canonical_projections warn (con,ind) = let env = Global.env () in let ctx = Environ.constant_context env con in - let u = Univ.UContext.instance ctx in + let u = Univ.make_abstract_instance ctx in let v = (mkConstU (con,u)) in - let ctx = Univ.ContextSet.of_context ctx in let c = Environ.constant_value_in env (con,u) in - let lt,t = Reductionops.splay_lam env Evd.empty (EConstr.of_constr c) in + let sign,t = Reductionops.splay_lam env Evd.empty (EConstr.of_constr c) in let t = EConstr.Unsafe.to_constr t in - let lt = List.rev_map (snd %> EConstr.Unsafe.to_constr) lt in + let lt = List.rev_map (snd %> EConstr.Unsafe.to_constr) sign in let args = snd (decompose_app t) in let { s_EXPECTEDPARAM = p; s_PROJ = lpj; s_PROJKIND = kl } = lookup_structure ind in @@ -221,9 +225,7 @@ let compute_canonical_projections warn (con,ind) = let patt, n , args = cs_pattern_of_constr t in ((ConstRef proji_sp, patt, t, n, args) :: l) with Not_found -> - let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con) - and proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in - if warn then warn_projection_no_head_constant (t,con_pp,proji_sp_pp); + if warn then warn_projection_no_head_constant (sign,env,t,con,proji_sp); l end | _ -> l) @@ -298,7 +300,7 @@ let error_not_structure ref = let check_and_decompose_canonical_structure ref = let sp = match ref with ConstRef sp -> sp | _ -> error_not_structure ref in let env = Global.env () in - let u = Environ.constant_instance env sp in + let u = Univ.make_abstract_instance (Environ.constant_context env sp) in let vc = match Environ.constant_opt_value_in env (sp, u) with | Some vc -> vc | None -> error_not_structure ref in diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli index 7c0d0ec6d4..5480b14af0 100644 --- a/pretyping/recordops.mli +++ b/pretyping/recordops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,7 +57,7 @@ type cs_pattern = type obj_typ = { o_DEF : constr; - o_CTX : Univ.ContextSet.t; + o_CTX : Univ.AUContext.t; o_INJ : int option; (** position of trivial argument *) o_TABS : constr list; (** ordered *) o_TPARAMS : constr list; (** ordered *) @@ -67,7 +67,7 @@ type obj_typ = { (** Return the form of the component of a canonical structure *) val cs_pattern_of_constr : constr -> cs_pattern * int option * constr list -val pr_cs_pattern : cs_pattern -> Pp.std_ppcmds +val pr_cs_pattern : cs_pattern -> Pp.t val lookup_canonical_conversion : (global_reference * cs_pattern) -> constr * obj_typ val declare_canonical_structure : global_reference -> unit diff --git a/pretyping/redops.ml b/pretyping/redops.ml index 8e190f40b9..b5e4a7acbf 100644 --- a/pretyping/redops.ml +++ b/pretyping/redops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/redops.mli b/pretyping/redops.mli index f6d4d80862..435b25091e 100644 --- a/pretyping/redops.mli +++ b/pretyping/redops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index 123c610166..3563235434 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -29,7 +29,7 @@ exception Elimconst let refolding_in_reduction = ref false let _ = Goptions.declare_bool_option { - Goptions.optdepr = false; + Goptions.optdepr = true; (* remove in 8.8 *) Goptions.optname = "Perform refolding of fixpoints/constants like cbn during reductions"; Goptions.optkey = ["Refolding";"Reduction"]; @@ -272,7 +272,7 @@ module Stack : sig open EConstr type 'a app_node - val pr_app_node : ('a -> Pp.std_ppcmds) -> 'a app_node -> Pp.std_ppcmds + val pr_app_node : ('a -> Pp.t) -> 'a app_node -> Pp.t type cst_member = | Cst_const of pconstant @@ -290,7 +290,7 @@ sig exception IncompatibleFold2 - val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds + val pr : ('a -> Pp.t) -> 'a t -> Pp.t val empty : 'a t val is_empty : 'a t -> bool val append_app : 'a array -> 'a t -> 'a t @@ -1362,25 +1362,23 @@ let sigma_compare_instances ~flex i0 i1 sigma = raise Reduction.NotConvertible let sigma_check_inductive_instances cv_pb uinfind u u' sigma = - let ind_instance = - Univ.AUContext.instance (Univ.ACumulativityInfo.univ_context uinfind) + let len_instance = + Univ.AUContext.size (Univ.ACumulativityInfo.univ_context uinfind) in let ind_sbctx = Univ.ACumulativityInfo.subtyp_context uinfind in - if not ((Univ.Instance.length ind_instance = Univ.Instance.length u) && - (Univ.Instance.length ind_instance = Univ.Instance.length u')) then + if not ((len_instance = Univ.Instance.length u) && + (len_instance = Univ.Instance.length u')) then anomaly (Pp.str "Invalid inductive subtyping encountered!") else let comp_cst = let comp_subst = (Univ.Instance.append u u') in - Univ.UContext.constraints (Univ.subst_instance_context comp_subst ind_sbctx) + Univ.AUContext.instantiate comp_subst ind_sbctx in let comp_cst = match cv_pb with Reduction.CONV -> let comp_subst = (Univ.Instance.append u' u) in - let comp_cst' = - Univ.UContext.constraints(Univ.subst_instance_context comp_subst ind_sbctx) - in + let comp_cst' = Univ.AUContext.instantiate comp_subst ind_sbctx in Univ.Constraint.union comp_cst comp_cst' | Reduction.CUMUL -> comp_cst in diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli index a4da19de75..1828196fe4 100644 --- a/pretyping/reductionops.mli +++ b/pretyping/reductionops.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -26,7 +26,7 @@ module ReductionBehaviour : sig bool -> Globnames.global_reference -> (int list * int * flag list) -> unit val get : Globnames.global_reference -> (int list * int * flag list) option - val print : Globnames.global_reference -> Pp.std_ppcmds + val print : Globnames.global_reference -> Pp.t end (** Option telling if reduction should use the refolding machinery of cbn @@ -63,13 +63,13 @@ module Cst_stack : sig val best_cst : t -> (constr * constr list) option val best_replace : Evd.evar_map -> constr -> t -> constr -> constr val reference : Evd.evar_map -> t -> Constant.t option - val pr : t -> Pp.std_ppcmds + val pr : t -> Pp.t end module Stack : sig type 'a app_node - val pr_app_node : ('a -> Pp.std_ppcmds) -> 'a app_node -> Pp.std_ppcmds + val pr_app_node : ('a -> Pp.t) -> 'a app_node -> Pp.t type cst_member = | Cst_const of pconstant @@ -86,7 +86,7 @@ module Stack : sig | Update of 'a and 'a t = 'a member list - val pr : ('a -> Pp.std_ppcmds) -> 'a t -> Pp.std_ppcmds + val pr : ('a -> Pp.t) -> 'a t -> Pp.t val empty : 'a t val is_empty : 'a t -> bool @@ -145,7 +145,7 @@ type contextual_state_reduction_function = type state_reduction_function = contextual_state_reduction_function type local_state_reduction_function = evar_map -> state -> state -val pr_state : state -> Pp.std_ppcmds +val pr_state : state -> Pp.t (** {6 Reduction Function Operators } *) diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml index a1d0977f5a..079524f344 100644 --- a/pretyping/retyping.ml +++ b/pretyping/retyping.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -192,11 +192,6 @@ let retype ?(polyprop=true) sigma = EConstr.of_constr (try Inductive.type_of_inductive_knowing_parameters ~polyprop env (mip, u) argtyps with Reduction.NotArity -> retype_error NotAnArity) - | Const (cst, u) -> - let u = EInstance.kind sigma u in - EConstr.of_constr (try Typeops.type_of_constant_knowing_parameters_in env (cst, u) argtyps - with Reduction.NotArity -> retype_error NotAnArity) - | Var id -> type_of_var env id | Construct (cstr, u) -> let u = EInstance.kind sigma u in EConstr.of_constr (type_of_constructor env (cstr, u)) @@ -220,7 +215,7 @@ let type_of_global_reference_knowing_conclusion env sigma c conclty = | Const (cst, u) -> let t = constant_type_in env (cst, EInstance.kind sigma u) in (* TODO *) - sigma, EConstr.of_constr (Typeops.type_of_constant_type_knowing_parameters env t [||]) + sigma, EConstr.of_constr t | Var id -> sigma, type_of_var env id | Construct (cstr, u) -> sigma, EConstr.of_constr (type_of_constructor env (cstr, EInstance.kind sigma u)) | _ -> assert false diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli index 25129db1c9..ed3a9d0f96 100644 --- a/pretyping/retyping.mli +++ b/pretyping/retyping.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -48,4 +48,4 @@ val sorts_of_context : env -> evar_map -> rel_context -> sorts list val expand_projection : env -> evar_map -> Names.projection -> constr -> constr list -> constr -val print_retype_error : retype_error -> Pp.std_ppcmds +val print_retype_error : retype_error -> Pp.t diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 62737b65e0..76f35f76f5 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli index c31212e26a..91726e8c6d 100644 --- a/pretyping/tacred.mli +++ b/pretyping/tacred.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml index 0ad940acac..375a8a983f 100644 --- a/pretyping/typeclasses.ml +++ b/pretyping/typeclasses.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,6 +57,9 @@ type direction = Forward | Backward (* This module defines type-classes *) type typeclass = { + (* Universe quantification *) + cl_univs : Univ.AUContext.t; + (* The class implementation *) cl_impl : global_reference; @@ -113,23 +116,11 @@ let new_instance cl info glob poly impl = let classes : typeclasses ref = Summary.ref Refmap.empty ~name:"classes" let instances : instances ref = Summary.ref Refmap.empty ~name:"instances" -let typeclass_univ_instance (cl,u') = - let subst = - let u = - match cl.cl_impl with - | ConstRef c -> - let cb = Global.lookup_constant c in - Declareops.constant_polymorphic_instance cb - | IndRef c -> - let mib,oib = Global.lookup_inductive c in - Declareops.inductive_polymorphic_instance mib - | _ -> Univ.Instance.empty - in Array.fold_left2 (fun subst u u' -> Univ.LMap.add u u' subst) - Univ.LMap.empty (Univ.Instance.to_array u) (Univ.Instance.to_array u') - in - let subst_ctx = Context.Rel.map (subst_univs_level_constr subst) in - { cl with cl_context = fst cl.cl_context, subst_ctx (snd cl.cl_context); - cl_props = subst_ctx cl.cl_props}, u' +let typeclass_univ_instance (cl, u) = + assert (Univ.AUContext.size cl.cl_univs == Univ.Instance.length u); + let subst_ctx c = Context.Rel.map (subst_instance_constr u) c in + { cl with cl_context = on_snd subst_ctx cl.cl_context; + cl_props = subst_ctx cl.cl_props} let class_info c = try Refmap.find c !classes @@ -187,7 +178,8 @@ let subst_class (subst,cl) = do_subst_ctx ctx in let do_subst_projs projs = List.smartmap (fun (x, y, z) -> (x, y, Option.smartmap do_subst_con z)) projs in - { cl_impl = do_subst_gr cl.cl_impl; + { cl_univs = cl.cl_univs; + cl_impl = do_subst_gr cl.cl_impl; cl_context = do_subst_context cl.cl_context; cl_props = do_subst_ctx cl.cl_props; cl_projs = do_subst_projs cl.cl_projs; @@ -201,15 +193,14 @@ let discharge_class (_,cl) = let decl' = decl |> NamedDecl.map_constr (substn_vars 1 subst) |> NamedDecl.to_rel_decl in (decl' :: ctx', NamedDecl.get_id decl :: subst) ) ctx ([], []) in - let discharge_rel_context subst n rel = + let discharge_rel_context (subst, usubst) n rel = let rel = Context.Rel.map (Cooking.expmod_constr repl) rel in - let ctx, _ = - List.fold_right - (fun decl (ctx, k) -> - RelDecl.map_constr (substn_vars k subst) decl :: ctx, succ k - ) - rel ([], n) - in ctx + let fold decl (ctx, k) = + let map c = subst_univs_level_constr usubst (substn_vars k subst c) in + RelDecl.map_constr map decl :: ctx, succ k + in + let ctx, _ = List.fold_right fold rel ([], n) in + ctx in let abs_context cl = match cl.cl_impl with @@ -229,12 +220,14 @@ let discharge_class (_,cl) = in grs', discharge_rel_context subst 1 ctx @ ctx' in let cl_impl' = Lib.discharge_global cl.cl_impl in if cl_impl' == cl.cl_impl then cl else - let ctx, usubst, uctx = abs_context cl in + let ctx, _, _ as info = abs_context cl in let ctx, subst = rel_of_variable_context ctx in - let context = discharge_context ctx subst cl.cl_context in - let props = discharge_rel_context subst (succ (List.length (fst cl.cl_context))) cl.cl_props in + let usubst, cl_univs' = Lib.discharge_abstract_universe_context info cl.cl_univs in + let context = discharge_context ctx (subst, usubst) cl.cl_context in + let props = discharge_rel_context (subst, usubst) (succ (List.length (fst cl.cl_context))) cl.cl_props in let discharge_proj (x, y, z) = x, y, Option.smartmap Lib.discharge_con z in - { cl_impl = cl_impl'; + { cl_univs = cl_univs'; + cl_impl = cl_impl'; cl_context = context; cl_props = props; cl_projs = List.smartmap discharge_proj cl.cl_projs; @@ -281,8 +274,10 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } = Nameops.add_suffix _id ("_subinstance_" ^ string_of_int !i)) in let ty, ctx = Global.type_of_global_in_context env glob in + let inst, ctx = Universes.fresh_instance_from ctx None in + let ty = Vars.subst_instance_constr inst ty in let ty = EConstr.of_constr ty in - let sigma = Evd.merge_context_set Evd.univ_rigid sigma (Univ.ContextSet.of_context ctx) in + let sigma = Evd.merge_context_set Evd.univ_rigid sigma ctx in let rec aux pri c ty path = match class_of_constr sigma ty with | None -> [] @@ -319,7 +314,7 @@ let build_subclasses ~check env sigma glob { hint_priority = pri } = 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 + let term = Universes.constr_of_global_univ (glob, inst) in (*FIXME subclasses should now get substituted for each particular instance of the polymorphic superclass *) aux pri term ty [glob] @@ -419,7 +414,7 @@ let remove_instance i = remove_instance_hint i.is_impl let declare_instance info local glob = - let ty = Global.type_of_global_unsafe glob in + let ty, _ = Global.type_of_global_in_context (Global.env ()) glob in let info = Option.default {hint_priority = None; hint_pattern = None} info in match class_of_constr Evd.empty (EConstr.of_constr ty) with | Some (rels, ((tc,_), args) as _cl) -> diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli index 8d1c0b94ca..99cdbd3a36 100644 --- a/pretyping/typeclasses.mli +++ b/pretyping/typeclasses.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -16,6 +16,10 @@ type direction = Forward | Backward (** This module defines type-classes *) type typeclass = { + (** The toplevel universe quantification in which the typeclass lives. In + particular, [cl_props] and [cl_context] are quantified over it. *) + cl_univs : Univ.AUContext.t; + (** The class implementation: a record parameterized by the context with defs in it or a definition if the class is a singleton. This acts as the class' global identifier. *) cl_impl : global_reference; @@ -64,7 +68,7 @@ val class_info : global_reference -> typeclass (** raises a UserError if not a c val dest_class_app : env -> evar_map -> EConstr.constr -> (typeclass * EConstr.EInstance.t) * constr list (** Get the instantiated typeclass structure for a given universe instance. *) -val typeclass_univ_instance : typeclass puniverses -> typeclass puniverses +val typeclass_univ_instance : typeclass puniverses -> typeclass (** Just return None if not a class *) val class_of_constr : evar_map -> EConstr.constr -> (EConstr.rel_context * ((typeclass * EConstr.EInstance.t) * constr list)) option diff --git a/pretyping/typeclasses_errors.ml b/pretyping/typeclasses_errors.ml index 754dacd193..dc8ff2e208 100644 --- a/pretyping/typeclasses_errors.ml +++ b/pretyping/typeclasses_errors.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/typeclasses_errors.mli b/pretyping/typeclasses_errors.mli index 558575ccce..557aa3c9f9 100644 --- a/pretyping/typeclasses_errors.mli +++ b/pretyping/typeclasses_errors.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/typing.ml b/pretyping/typing.ml index 7ad988ad0b..1f35fa19aa 100644 --- a/pretyping/typing.ml +++ b/pretyping/typing.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -35,11 +35,6 @@ let meta_type evd mv = let ty = Evd.map_fl EConstr.of_constr ty in meta_instance evd ty -let constant_type_knowing_parameters env sigma (cst, u) jl = - let u = Unsafe.to_instance u in - let paramstyp = Array.map (fun j -> lazy (EConstr.to_constr sigma j.uj_type)) jl in - EConstr.of_constr (type_of_constant_knowing_parameters_in env (cst, u) paramstyp) - let inductive_type_knowing_parameters env sigma (ind,u) jl = let u = Unsafe.to_instance u in let mspec = lookup_mind_specif env ind in @@ -315,9 +310,6 @@ let rec execute env evdref cstr = | Ind (ind, u) when EInstance.is_empty u && Environ.template_polymorphic_ind ind env -> make_judge f (inductive_type_knowing_parameters env !evdref (ind, u) jl) - | Const (cst, u) when EInstance.is_empty u && Environ.template_polymorphic_constant cst env -> - make_judge f - (constant_type_knowing_parameters env !evdref (cst, u) jl) | _ -> (* No template polymorphism *) execute env evdref f diff --git a/pretyping/typing.mli b/pretyping/typing.mli index 1f3ba34e51..1e20788268 100644 --- a/pretyping/typing.mli +++ b/pretyping/typing.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 67c8b07e78..f090921e5c 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/unification.mli b/pretyping/unification.mli index 0d90ab1584..fce17d5641 100644 --- a/pretyping/unification.mli +++ b/pretyping/unification.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml index 9e151fea25..66cc42cb61 100644 --- a/pretyping/vnorm.ml +++ b/pretyping/vnorm.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -174,7 +174,7 @@ and nf_whd env sigma whd typ = | Vatom_stk(Aind ((mi,i) as ind), stk) -> let mib = Environ.lookup_mind mi env in let nb_univs = - Univ.Instance.length (Declareops.inductive_polymorphic_instance mib) + Univ.AUContext.size (Declareops.inductive_polymorphic_context mib) in let mk u = let pind = (ind, u) in (mkIndU pind, type_of_ind env pind) @@ -203,7 +203,7 @@ and constr_type_of_idkey env sigma (idkey : Vars.id_key) stk = | ConstKey cst -> let cbody = Environ.lookup_constant cst env in let nb_univs = - Univ.Instance.length (Declareops.constant_polymorphic_instance cbody) + Univ.AUContext.size (Declareops.constant_polymorphic_context cbody) in let mk u = let pcst = (cst, u) in (mkConstU pcst, Typeops.type_of_constant_in env pcst) diff --git a/pretyping/vnorm.mli b/pretyping/vnorm.mli index 8a4202c887..d1a996a34b 100644 --- a/pretyping/vnorm.mli +++ b/pretyping/vnorm.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/printing/genprint.ml b/printing/genprint.ml index 6505a8f826..543b05024d 100644 --- a/printing/genprint.ml +++ b/printing/genprint.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,7 +9,7 @@ open Pp open Genarg -type 'a printer = 'a -> std_ppcmds +type 'a printer = 'a -> Pp.t type ('raw, 'glb, 'top) genprinter = { raw : 'raw printer; diff --git a/printing/genprint.mli b/printing/genprint.mli index 5381fc5bdb..130a89c929 100644 --- a/printing/genprint.mli +++ b/printing/genprint.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -8,18 +8,17 @@ (** Entry point for generic printers *) -open Pp open Genarg -type 'a printer = 'a -> std_ppcmds +type 'a printer = 'a -> Pp.t -val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw -> std_ppcmds +val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw -> Pp.t (** Printer for raw level generic arguments. *) -val glb_print : ('raw, 'glb, 'top) genarg_type -> 'glb -> std_ppcmds +val glb_print : ('raw, 'glb, 'top) genarg_type -> 'glb -> Pp.t (** Printer for glob level generic arguments. *) -val top_print : ('raw, 'glb, 'top) genarg_type -> 'top -> std_ppcmds +val top_print : ('raw, 'glb, 'top) genarg_type -> 'top -> Pp.t (** Printer for top level generic arguments. *) val generic_raw_print : rlevel generic_argument printer diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index 49eedb767b..ee03bc9007 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -731,10 +731,10 @@ let tag_var = tag Tag.variable (sep() ++ if prec_less prec inherited then strm else surround strm) type term_pr = { - pr_constr_expr : constr_expr -> std_ppcmds; - pr_lconstr_expr : constr_expr -> std_ppcmds; - pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds; - pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds + pr_constr_expr : constr_expr -> Pp.t; + pr_lconstr_expr : constr_expr -> Pp.t; + pr_constr_pattern_expr : constr_pattern_expr -> Pp.t; + pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t } type precedence = Ppextend.precedence * Ppextend.parenRelation diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli index 482c994c25..8335034851 100644 --- a/printing/ppconstr.mli +++ b/printing/ppconstr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -9,10 +9,8 @@ (** This module implements pretty-printers for constr_expr syntactic objects and their subcomponents. *) -(** The default pretty-printers produce {!Pp.std_ppcmds} that are - interpreted as raw strings. *) +(** The default pretty-printers produce pretty-printing commands ({!Pp.t}). *) open Loc -open Pp open Libnames open Constrexpr open Names @@ -28,45 +26,45 @@ val split_fix : val prec_less : int -> int * Ppextend.parenRelation -> bool -val pr_tight_coma : unit -> std_ppcmds +val pr_tight_coma : unit -> Pp.t -val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds +val pr_or_var : ('a -> Pp.t) -> 'a or_var -> Pp.t -val pr_lident : Id.t located -> std_ppcmds -val pr_lname : Name.t located -> std_ppcmds +val pr_lident : Id.t located -> Pp.t +val pr_lname : Name.t located -> Pp.t -val pr_with_comments : ?loc:Loc.t -> std_ppcmds -> std_ppcmds -val pr_com_at : int -> std_ppcmds +val pr_with_comments : ?loc:Loc.t -> Pp.t -> Pp.t +val pr_com_at : int -> Pp.t val pr_sep_com : - (unit -> std_ppcmds) -> - (constr_expr -> std_ppcmds) -> - constr_expr -> std_ppcmds + (unit -> Pp.t) -> + (constr_expr -> Pp.t) -> + constr_expr -> Pp.t -val pr_id : Id.t -> std_ppcmds -val pr_name : Name.t -> std_ppcmds -val pr_qualid : qualid -> std_ppcmds -val pr_patvar : patvar -> std_ppcmds +val pr_id : Id.t -> Pp.t +val pr_name : Name.t -> Pp.t +val pr_qualid : qualid -> Pp.t +val pr_patvar : patvar -> Pp.t -val pr_glob_level : glob_level -> std_ppcmds -val pr_glob_sort : glob_sort -> std_ppcmds -val pr_guard_annot : (constr_expr -> std_ppcmds) -> +val pr_glob_level : glob_level -> Pp.t +val pr_glob_sort : glob_sort -> Pp.t +val pr_guard_annot : (constr_expr -> Pp.t) -> local_binder_expr list -> ('a * Names.Id.t) option * recursion_order_expr -> - std_ppcmds + Pp.t -val pr_record_body : (reference * constr_expr) list -> std_ppcmds -val pr_binders : local_binder_expr list -> std_ppcmds -val pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds -val pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds -val pr_constr_expr : constr_expr -> std_ppcmds -val pr_lconstr_expr : constr_expr -> std_ppcmds -val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds +val pr_record_body : (reference * constr_expr) list -> Pp.t +val pr_binders : local_binder_expr list -> Pp.t +val pr_constr_pattern_expr : constr_pattern_expr -> Pp.t +val pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t +val pr_constr_expr : constr_expr -> Pp.t +val pr_lconstr_expr : constr_expr -> Pp.t +val pr_cases_pattern_expr : cases_pattern_expr -> Pp.t type term_pr = { - pr_constr_expr : constr_expr -> std_ppcmds; - pr_lconstr_expr : constr_expr -> std_ppcmds; - pr_constr_pattern_expr : constr_pattern_expr -> std_ppcmds; - pr_lconstr_pattern_expr : constr_pattern_expr -> std_ppcmds + pr_constr_expr : constr_expr -> Pp.t; + pr_lconstr_expr : constr_expr -> Pp.t; + pr_constr_pattern_expr : constr_pattern_expr -> Pp.t; + pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t } val set_term_pr : term_pr -> unit @@ -91,5 +89,5 @@ type precedence val lsimpleconstr : precedence val ltop : precedence val modular_constr_pr : - ((unit->std_ppcmds) -> precedence -> constr_expr -> std_ppcmds) -> - (unit->std_ppcmds) -> precedence -> constr_expr -> std_ppcmds + ((unit->Pp.t) -> precedence -> constr_expr -> Pp.t) -> + (unit->Pp.t) -> precedence -> constr_expr -> Pp.t diff --git a/printing/pputils.ml b/printing/pputils.ml index 99d07601c4..9ef9162aee 100644 --- a/printing/pputils.ml +++ b/printing/pputils.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/printing/pputils.mli b/printing/pputils.mli index b236fed702..1f4fa1390d 100644 --- a/printing/pputils.mli +++ b/printing/pputils.mli @@ -1,31 +1,30 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Genarg open Misctypes open Locus open Genredexpr -val pr_located : ('a -> std_ppcmds) -> 'a Loc.located -> std_ppcmds +val pr_located : ('a -> Pp.t) -> 'a Loc.located -> Pp.t (** Prints an object surrounded by its commented location *) -val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds -val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds +val pr_or_var : ('a -> Pp.t) -> 'a or_var -> Pp.t +val pr_or_by_notation : ('a -> Pp.t) -> 'a or_by_notation -> Pp.t val pr_with_occurrences : - ('a -> std_ppcmds) -> (string -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds + ('a -> Pp.t) -> (string -> Pp.t) -> 'a with_occurrences -> Pp.t -val pr_short_red_flag : ('a -> std_ppcmds) -> 'a glob_red_flag -> std_ppcmds -val pr_red_flag : ('a -> std_ppcmds) -> 'a glob_red_flag -> std_ppcmds +val pr_short_red_flag : ('a -> Pp.t) -> 'a glob_red_flag -> Pp.t +val pr_red_flag : ('a -> Pp.t) -> 'a glob_red_flag -> Pp.t val pr_red_expr : - ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) * ('c -> std_ppcmds) -> - (string -> std_ppcmds) -> - ('a,'b,'c) red_expr_gen -> std_ppcmds + ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) -> + (string -> Pp.t) -> + ('a,'b,'c) red_expr_gen -> Pp.t -val pr_raw_generic : Environ.env -> rlevel generic_argument -> std_ppcmds -val pr_glb_generic : Environ.env -> glevel generic_argument -> std_ppcmds +val pr_raw_generic : Environ.env -> rlevel generic_argument -> Pp.t +val pr_glb_generic : Environ.env -> glevel generic_argument -> Pp.t diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml index d0536a1744..4c50c2f368 100644 --- a/printing/ppvernac.ml +++ b/printing/ppvernac.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -105,7 +105,7 @@ open Decl_kinds | SearchString (s,sc) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc let pr_search a gopt b pr_p = - pr_opt (fun g -> Proof_global.pr_goal_selector g ++ str ":"++ spc()) gopt + pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt ++ match a with | SearchHead c -> keyword "SearchHead" ++ spc() ++ pr_p c ++ pr_in_out_modules b @@ -490,7 +490,7 @@ open Decl_kinds | PrintVisibility s -> keyword "Print Visibility" ++ pr_opt str s | PrintAbout (qid,gopt) -> - pr_opt (fun g -> Proof_global.pr_goal_selector g ++ str ":"++ spc()) gopt + pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt ++ keyword "About" ++ spc() ++ pr_smart_global qid | PrintImplicit qid -> keyword "Print Implicit" ++ spc() ++ pr_smart_global qid @@ -760,7 +760,11 @@ open Decl_kinds | Class _ -> "Class" | Variant -> "Variant" in if p then - let cm = if cum then "Cumulative" else "NonCumulative" in + let cm = + match cum with + | GlobalCumulativity | LocalCumulativity -> "Cumulative" + | GlobalNonCumulativity | LocalNonCumulativity -> "NonCumulative" + in cm ^ " " ^ kind else kind in @@ -1132,7 +1136,7 @@ open Decl_kinds | None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c) in let pr_i = match io with None -> mt () - | Some i -> Proof_global.pr_goal_selector i ++ str ": " in + | Some i -> Proof_bullet.pr_goal_selector i ++ str ": " in return (pr_i ++ pr_mayeval r c) | VernacGlobalCheck c -> return (hov 2 (keyword "Type" ++ pr_constrarg c)) diff --git a/printing/ppvernac.mli b/printing/ppvernac.mli index 836b05e0e4..b88eed4843 100644 --- a/printing/ppvernac.mli +++ b/printing/ppvernac.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,10 +10,10 @@ objects and their subcomponents. *) (** Prints a fixpoint body *) -val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.std_ppcmds +val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.t (** Prints a vernac expression *) -val pr_vernac_body : Vernacexpr.vernac_expr -> Pp.std_ppcmds +val pr_vernac_body : Vernacexpr.vernac_expr -> Pp.t (** Prints a vernac expression and closes it with a dot. *) -val pr_vernac : Vernacexpr.vernac_expr -> Pp.std_ppcmds +val pr_vernac : Vernacexpr.vernac_expr -> Pp.t diff --git a/printing/prettyp.ml b/printing/prettyp.ml index 6d2bf6b73a..09859157c3 100644 --- a/printing/prettyp.ml +++ b/printing/prettyp.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -33,17 +33,17 @@ open Context.Rel.Declaration module NamedDecl = Context.Named.Declaration type object_pr = { - print_inductive : mutual_inductive -> std_ppcmds; - print_constant_with_infos : constant -> std_ppcmds; - print_section_variable : variable -> std_ppcmds; - print_syntactic_def : kernel_name -> std_ppcmds; - print_module : bool -> Names.module_path -> std_ppcmds; - print_modtype : module_path -> std_ppcmds; - print_named_decl : Context.Named.Declaration.t -> std_ppcmds; - print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option; - print_context : bool -> int option -> Lib.library_segment -> std_ppcmds; - print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.std_ppcmds; - print_eval : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> std_ppcmds; + print_inductive : mutual_inductive -> Pp.t; + print_constant_with_infos : constant -> Pp.t; + print_section_variable : variable -> Pp.t; + print_syntactic_def : kernel_name -> Pp.t; + print_module : bool -> Names.module_path -> Pp.t; + print_modtype : module_path -> Pp.t; + print_named_decl : Context.Named.Declaration.t -> Pp.t; + print_library_entry : bool -> (object_name * Lib.node) -> Pp.t option; + print_context : bool -> int option -> Lib.library_segment -> Pp.t; + print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.t; + print_eval : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t; } let gallina_print_module = print_module @@ -70,7 +70,8 @@ let int_or_no n = if Int.equal n 0 then str "no" else int n let print_basename sp = pr_global (ConstRef sp) let print_ref reduce ref = - let typ = Global.type_of_global_unsafe ref in + let typ, ctx = Global.type_of_global_in_context (Global.env ()) ref in + let typ = Vars.subst_instance_constr (Univ.AUContext.instance ctx) typ in let typ = EConstr.of_constr typ in let typ = if reduce then @@ -78,6 +79,8 @@ let print_ref reduce ref = in EConstr.it_mkProd_or_LetIn ccl ctx else typ in let univs = Global.universes_of_global ref in + let inst = Univ.AUContext.instance univs in + let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in let env = Global.env () in let bl = Universes.universe_binders_of_global ref in let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in @@ -135,7 +138,7 @@ let print_renames_list prefix l = hv 2 (prlist_with_sep pr_comma (fun x -> x) (List.map Name.print l))] let need_expansion impl ref = - let typ = Global.type_of_global_unsafe ref in + let typ, _ = Global.type_of_global_in_context (Global.env ()) ref in let ctx = prod_assum typ in let nprods = List.count is_local_assum ctx in not (List.is_empty impl) && List.length impl >= nprods && @@ -498,20 +501,46 @@ let print_body env evd = function let print_typed_body env evd (val_0,typ) = (print_body env evd val_0 ++ fnl () ++ str " : " ++ pr_ltype_env env evd typ) -let ungeneralized_type_of_constant_type t = - Typeops.type_of_constant_type (Global.env ()) t - let print_instance sigma cb = if Declareops.constant_is_polymorphic cb then - pr_universe_instance sigma (Declareops.constant_polymorphic_context cb) + let univs = Declareops.constant_polymorphic_context cb in + let inst = Univ.AUContext.instance univs in + let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in + pr_universe_instance sigma univs else mt() let print_constant with_values sep sp = let cb = Global.lookup_constant sp in let val_0 = Global.body_of_constant_body cb in - let typ = Declareops.type_of_constant cb in - let typ = ungeneralized_type_of_constant_type typ in - let univs = Global.universes_of_constant_body cb in + let typ = + match cb.const_universes with + | Monomorphic_const _ -> cb.const_type + | Polymorphic_const univs -> + let inst = Univ.AUContext.instance univs in + Vars.subst_instance_constr inst cb.const_type + in + let univs = + let otab = Global.opaque_tables () in + match cb.const_body with + | Undef _ | Def _ -> + begin + match cb.const_universes with + | Monomorphic_const ctx -> ctx + | Polymorphic_const ctx -> + let inst = Univ.AUContext.instance ctx in + Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx) + end + | OpaqueDef o -> + let body_uctxs = Opaqueproof.force_constraints otab o in + match cb.const_universes with + | Monomorphic_const ctx -> + let uctxs = Univ.ContextSet.of_context ctx in + Univ.ContextSet.to_context (Univ.ContextSet.union body_uctxs uctxs) + | Polymorphic_const ctx -> + assert(Univ.ContextSet.is_empty body_uctxs); + let inst = Univ.AUContext.instance ctx in + Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx) + in let ctx = Evd.evar_universe_context_of_binders (Universes.universe_binders_of_global (ConstRef sp)) @@ -525,9 +554,10 @@ let print_constant with_values sep sp = print_basename sp ++ print_instance sigma cb ++ str " : " ++ cut () ++ pr_ltype typ ++ str" ]" ++ Printer.pr_universe_ctx sigma univs - | _ -> + | Some (c, ctx) -> + let c = Vars.subst_instance_constr (Univ.AUContext.instance ctx) c in print_basename sp ++ print_instance sigma cb ++ str sep ++ cut () ++ - (if with_values then print_typed_body env sigma (val_0,typ) else pr_ltype typ)++ + (if with_values then print_typed_body env sigma (Some c,typ) else pr_ltype typ)++ Printer.pr_universe_ctx sigma univs) let gallina_print_constant_with_infos sp = @@ -661,7 +691,7 @@ let print_full_pure_context () = | "CONSTANT" -> let con = Global.constant_of_delta_kn kn in let cb = Global.lookup_constant con in - let typ = ungeneralized_type_of_constant_type cb.const_type in + let typ = cb.const_type in hov 0 ( match cb.const_body with | Undef _ -> @@ -765,9 +795,11 @@ let print_opaque_name qid = | IndRef (sp,_) -> print_inductive sp | ConstructRef cstr as gr -> - let open EConstr in - let ty = Universes.unsafe_type_of_global gr in + let ty, ctx = Global.type_of_global_in_context env gr in + let inst = Univ.AUContext.instance ctx in + let ty = Vars.subst_instance_constr inst ty in let ty = EConstr.of_constr ty in + let open EConstr in print_typed_value (mkConstruct cstr, ty) | VarRef id -> env |> lookup_named id |> NamedDecl.set_id id |> print_named_decl diff --git a/printing/prettyp.mli b/printing/prettyp.mli index 6841781ccd..f4277b6c50 100644 --- a/printing/prettyp.mli +++ b/printing/prettyp.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Names open Environ open Reductionops @@ -19,57 +18,57 @@ open Misctypes val assumptions_for_print : Name.t list -> Termops.names_context val print_closed_sections : bool ref -val print_context : bool -> int option -> Lib.library_segment -> std_ppcmds -val print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option -val print_full_context : unit -> std_ppcmds -val print_full_context_typ : unit -> std_ppcmds -val print_full_pure_context : unit -> std_ppcmds -val print_sec_context : reference -> std_ppcmds -val print_sec_context_typ : reference -> std_ppcmds -val print_judgment : env -> Evd.evar_map -> EConstr.unsafe_judgment -> std_ppcmds -val print_safe_judgment : env -> Evd.evar_map -> Safe_typing.judgment -> std_ppcmds +val print_context : bool -> int option -> Lib.library_segment -> Pp.t +val print_library_entry : bool -> (object_name * Lib.node) -> Pp.t option +val print_full_context : unit -> Pp.t +val print_full_context_typ : unit -> Pp.t +val print_full_pure_context : unit -> Pp.t +val print_sec_context : reference -> Pp.t +val print_sec_context_typ : reference -> Pp.t +val print_judgment : env -> Evd.evar_map -> EConstr.unsafe_judgment -> Pp.t +val print_safe_judgment : env -> Evd.evar_map -> Safe_typing.judgment -> Pp.t val print_eval : reduction_function -> env -> Evd.evar_map -> - Constrexpr.constr_expr -> EConstr.unsafe_judgment -> std_ppcmds + Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t -val print_name : reference or_by_notation -> std_ppcmds -val print_opaque_name : reference -> std_ppcmds -val print_about : reference or_by_notation -> std_ppcmds -val print_impargs : reference or_by_notation -> std_ppcmds +val print_name : reference or_by_notation -> Pp.t +val print_opaque_name : reference -> Pp.t +val print_about : reference or_by_notation -> Pp.t +val print_impargs : reference or_by_notation -> Pp.t (** Pretty-printing functions for classes and coercions *) -val print_graph : unit -> std_ppcmds -val print_classes : unit -> std_ppcmds -val print_coercions : unit -> std_ppcmds -val print_path_between : Classops.cl_typ -> Classops.cl_typ -> std_ppcmds -val print_canonical_projections : unit -> std_ppcmds +val print_graph : unit -> Pp.t +val print_classes : unit -> Pp.t +val print_coercions : unit -> Pp.t +val print_path_between : Classops.cl_typ -> Classops.cl_typ -> Pp.t +val print_canonical_projections : unit -> Pp.t (** Pretty-printing functions for type classes and instances *) -val print_typeclasses : unit -> std_ppcmds -val print_instances : global_reference -> std_ppcmds -val print_all_instances : unit -> std_ppcmds +val print_typeclasses : unit -> Pp.t +val print_instances : global_reference -> Pp.t +val print_all_instances : unit -> Pp.t -val inspect : int -> std_ppcmds +val inspect : int -> Pp.t (** Locate *) -val print_located_qualid : reference -> std_ppcmds -val print_located_term : reference -> std_ppcmds -val print_located_tactic : reference -> std_ppcmds -val print_located_module : reference -> std_ppcmds +val print_located_qualid : reference -> Pp.t +val print_located_term : reference -> Pp.t +val print_located_tactic : reference -> Pp.t +val print_located_module : reference -> Pp.t type object_pr = { - print_inductive : mutual_inductive -> std_ppcmds; - print_constant_with_infos : constant -> std_ppcmds; - print_section_variable : variable -> std_ppcmds; - print_syntactic_def : kernel_name -> std_ppcmds; - print_module : bool -> Names.module_path -> std_ppcmds; - print_modtype : module_path -> std_ppcmds; - print_named_decl : Context.Named.Declaration.t -> std_ppcmds; - print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option; - print_context : bool -> int option -> Lib.library_segment -> std_ppcmds; - print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.std_ppcmds; - print_eval : reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> std_ppcmds + print_inductive : mutual_inductive -> Pp.t; + print_constant_with_infos : constant -> Pp.t; + print_section_variable : variable -> Pp.t; + print_syntactic_def : kernel_name -> Pp.t; + print_module : bool -> Names.module_path -> Pp.t; + print_modtype : module_path -> Pp.t; + print_named_decl : Context.Named.Declaration.t -> Pp.t; + print_library_entry : bool -> (object_name * Lib.node) -> Pp.t option; + print_context : bool -> int option -> Lib.library_segment -> Pp.t; + print_typed_value_in_env : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.t; + print_eval : reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t } val set_object_pr : object_pr -> unit diff --git a/printing/printer.ml b/printing/printer.ml index 3b0b6d5d23..c6cf2254f2 100644 --- a/printing/printer.ml +++ b/printing/printer.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -727,7 +727,7 @@ let default_pr_subgoals ?(pr_first=true) match goals with | [] -> begin - let exl = Evarutil.non_instantiated sigma in + let exl = Evd.undefined_map sigma in if Evar.Map.is_empty exl then (str"No more subgoals." ++ print_dependent_evars None sigma seeds) else @@ -758,9 +758,9 @@ let default_pr_subgoals ?(pr_first=true) type printer_pr = { - pr_subgoals : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> std_ppcmds; - pr_subgoal : int -> evar_map -> goal list -> std_ppcmds; - pr_goal : goal sigma -> std_ppcmds; + pr_subgoals : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t; + pr_subgoal : int -> evar_map -> goal list -> Pp.t; + pr_goal : goal sigma -> Pp.t; } let default_printer_pr = { @@ -805,7 +805,7 @@ let pr_open_subgoals ?(proof=Proof_global.give_me_the_proof ()) () = | _ , _, _ -> let end_cmd = str "This subproof is complete, but there are some unfocused goals." ++ - (let s = Proof_global.Bullet.suggest p in + (let s = Proof_bullet.suggest p in if Pp.ismt s then s else fnl () ++ s) ++ fnl () in diff --git a/printing/printer.mli b/printing/printer.mli index f0a32bbbdf..2c9a4d70e6 100644 --- a/printing/printer.mli +++ b/printing/printer.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Names open Globnames open Term @@ -25,96 +24,96 @@ val enable_goal_names_printing : bool ref (** Terms *) -val pr_lconstr_env : env -> evar_map -> constr -> std_ppcmds -val pr_lconstr : constr -> std_ppcmds -val pr_lconstr_goal_style_env : env -> evar_map -> constr -> std_ppcmds +val pr_lconstr_env : env -> evar_map -> constr -> Pp.t +val pr_lconstr : constr -> Pp.t +val pr_lconstr_goal_style_env : env -> evar_map -> constr -> Pp.t -val pr_constr_env : env -> evar_map -> constr -> std_ppcmds -val pr_constr : constr -> std_ppcmds -val pr_constr_goal_style_env : env -> evar_map -> constr -> std_ppcmds +val pr_constr_env : env -> evar_map -> constr -> Pp.t +val pr_constr : constr -> Pp.t +val pr_constr_goal_style_env : env -> evar_map -> constr -> Pp.t (** Same, but resilient to [Nametab] errors. Prints fully-qualified names when [shortest_qualid_of_global] has failed. Prints "??" in case of remaining issues (such as reference not in env). *) -val safe_pr_lconstr_env : env -> evar_map -> constr -> std_ppcmds -val safe_pr_lconstr : constr -> std_ppcmds +val safe_pr_lconstr_env : env -> evar_map -> constr -> Pp.t +val safe_pr_lconstr : constr -> Pp.t -val safe_pr_constr_env : env -> evar_map -> constr -> std_ppcmds -val safe_pr_constr : constr -> std_ppcmds +val safe_pr_constr_env : env -> evar_map -> constr -> Pp.t +val safe_pr_constr : constr -> Pp.t -val pr_econstr_env : env -> evar_map -> EConstr.t -> std_ppcmds -val pr_econstr : EConstr.t -> std_ppcmds -val pr_leconstr_env : env -> evar_map -> EConstr.t -> std_ppcmds -val pr_leconstr : EConstr.t -> std_ppcmds +val pr_econstr_env : env -> evar_map -> EConstr.t -> Pp.t +val pr_econstr : EConstr.t -> Pp.t +val pr_leconstr_env : env -> evar_map -> EConstr.t -> Pp.t +val pr_leconstr : EConstr.t -> Pp.t -val pr_etype_env : env -> evar_map -> EConstr.types -> std_ppcmds -val pr_letype_env : env -> evar_map -> EConstr.types -> std_ppcmds +val pr_etype_env : env -> evar_map -> EConstr.types -> Pp.t +val pr_letype_env : env -> evar_map -> EConstr.types -> Pp.t -val pr_open_constr_env : env -> evar_map -> open_constr -> std_ppcmds -val pr_open_constr : open_constr -> std_ppcmds +val pr_open_constr_env : env -> evar_map -> open_constr -> Pp.t +val pr_open_constr : open_constr -> Pp.t -val pr_open_lconstr_env : env -> evar_map -> open_constr -> std_ppcmds -val pr_open_lconstr : open_constr -> std_ppcmds +val pr_open_lconstr_env : env -> evar_map -> open_constr -> Pp.t +val pr_open_lconstr : open_constr -> Pp.t -val pr_constr_under_binders_env : env -> evar_map -> constr_under_binders -> std_ppcmds -val pr_constr_under_binders : constr_under_binders -> std_ppcmds +val pr_constr_under_binders_env : env -> evar_map -> constr_under_binders -> Pp.t +val pr_constr_under_binders : constr_under_binders -> Pp.t -val pr_lconstr_under_binders_env : env -> evar_map -> constr_under_binders -> std_ppcmds -val pr_lconstr_under_binders : constr_under_binders -> std_ppcmds +val pr_lconstr_under_binders_env : env -> evar_map -> constr_under_binders -> Pp.t +val pr_lconstr_under_binders : constr_under_binders -> Pp.t -val pr_goal_concl_style_env : env -> evar_map -> EConstr.types -> std_ppcmds -val pr_ltype_env : env -> evar_map -> types -> std_ppcmds -val pr_ltype : types -> std_ppcmds +val pr_goal_concl_style_env : env -> evar_map -> EConstr.types -> Pp.t +val pr_ltype_env : env -> evar_map -> types -> Pp.t +val pr_ltype : types -> Pp.t -val pr_type_env : env -> evar_map -> types -> std_ppcmds -val pr_type : types -> std_ppcmds +val pr_type_env : env -> evar_map -> types -> Pp.t +val pr_type : types -> Pp.t -val pr_closed_glob_env : env -> evar_map -> closed_glob_constr -> std_ppcmds -val pr_closed_glob : closed_glob_constr -> std_ppcmds +val pr_closed_glob_env : env -> evar_map -> closed_glob_constr -> Pp.t +val pr_closed_glob : closed_glob_constr -> Pp.t -val pr_ljudge_env : env -> evar_map -> EConstr.unsafe_judgment -> std_ppcmds * std_ppcmds -val pr_ljudge : EConstr.unsafe_judgment -> std_ppcmds * std_ppcmds +val pr_ljudge_env : env -> evar_map -> EConstr.unsafe_judgment -> Pp.t * Pp.t +val pr_ljudge : EConstr.unsafe_judgment -> Pp.t * Pp.t -val pr_lglob_constr_env : env -> glob_constr -> std_ppcmds -val pr_lglob_constr : glob_constr -> std_ppcmds +val pr_lglob_constr_env : env -> glob_constr -> Pp.t +val pr_lglob_constr : glob_constr -> Pp.t -val pr_glob_constr_env : env -> glob_constr -> std_ppcmds -val pr_glob_constr : glob_constr -> std_ppcmds +val pr_glob_constr_env : env -> glob_constr -> Pp.t +val pr_glob_constr : glob_constr -> Pp.t -val pr_lconstr_pattern_env : env -> evar_map -> constr_pattern -> std_ppcmds -val pr_lconstr_pattern : constr_pattern -> std_ppcmds +val pr_lconstr_pattern_env : env -> evar_map -> constr_pattern -> Pp.t +val pr_lconstr_pattern : constr_pattern -> Pp.t -val pr_constr_pattern_env : env -> evar_map -> constr_pattern -> std_ppcmds -val pr_constr_pattern : constr_pattern -> std_ppcmds +val pr_constr_pattern_env : env -> evar_map -> constr_pattern -> Pp.t +val pr_constr_pattern : constr_pattern -> Pp.t -val pr_cases_pattern : cases_pattern -> std_ppcmds +val pr_cases_pattern : cases_pattern -> Pp.t -val pr_sort : evar_map -> sorts -> std_ppcmds +val pr_sort : evar_map -> sorts -> Pp.t (** Universe constraints *) -val pr_polymorphic : bool -> std_ppcmds -val pr_cumulative : bool -> bool -> std_ppcmds -val pr_universe_instance : evar_map -> Univ.universe_context -> std_ppcmds -val pr_universe_ctx : evar_map -> Univ.universe_context -> std_ppcmds -val pr_cumulativity_info : evar_map -> Univ.cumulativity_info -> std_ppcmds +val pr_polymorphic : bool -> Pp.t +val pr_cumulative : bool -> bool -> Pp.t +val pr_universe_instance : evar_map -> Univ.universe_context -> Pp.t +val pr_universe_ctx : evar_map -> Univ.universe_context -> Pp.t +val pr_cumulativity_info : evar_map -> Univ.cumulativity_info -> Pp.t (** Printing global references using names as short as possible *) -val pr_global_env : Id.Set.t -> global_reference -> std_ppcmds -val pr_global : global_reference -> std_ppcmds +val pr_global_env : Id.Set.t -> global_reference -> Pp.t +val pr_global : global_reference -> Pp.t -val pr_constant : env -> constant -> std_ppcmds -val pr_existential_key : evar_map -> existential_key -> std_ppcmds -val pr_existential : env -> evar_map -> existential -> std_ppcmds -val pr_constructor : env -> constructor -> std_ppcmds -val pr_inductive : env -> inductive -> std_ppcmds -val pr_evaluable_reference : evaluable_global_reference -> std_ppcmds +val pr_constant : env -> constant -> Pp.t +val pr_existential_key : evar_map -> existential_key -> Pp.t +val pr_existential : env -> evar_map -> existential -> Pp.t +val pr_constructor : env -> constructor -> Pp.t +val pr_inductive : env -> inductive -> Pp.t +val pr_evaluable_reference : evaluable_global_reference -> Pp.t -val pr_pconstant : env -> pconstant -> std_ppcmds -val pr_pinductive : env -> pinductive -> std_ppcmds -val pr_pconstructor : env -> pconstructor -> std_ppcmds +val pr_pconstant : env -> pconstant -> Pp.t +val pr_pinductive : env -> pinductive -> Pp.t +val pr_pconstructor : env -> pconstructor -> Pp.t (** Contexts *) @@ -122,29 +121,29 @@ val pr_pconstructor : env -> pconstructor -> std_ppcmds val set_compact_context : bool -> unit val get_compact_context : unit -> bool -val pr_context_unlimited : env -> evar_map -> std_ppcmds -val pr_ne_context_of : std_ppcmds -> env -> evar_map -> std_ppcmds +val pr_context_unlimited : env -> evar_map -> Pp.t +val pr_ne_context_of : Pp.t -> env -> evar_map -> Pp.t -val pr_named_decl : env -> evar_map -> Context.Named.Declaration.t -> std_ppcmds -val pr_compacted_decl : env -> evar_map -> Context.Compacted.Declaration.t -> std_ppcmds -val pr_rel_decl : env -> evar_map -> Context.Rel.Declaration.t -> std_ppcmds +val pr_named_decl : env -> evar_map -> Context.Named.Declaration.t -> Pp.t +val pr_compacted_decl : env -> evar_map -> Context.Compacted.Declaration.t -> Pp.t +val pr_rel_decl : env -> evar_map -> Context.Rel.Declaration.t -> Pp.t -val pr_named_context : env -> evar_map -> Context.Named.t -> std_ppcmds -val pr_named_context_of : env -> evar_map -> std_ppcmds -val pr_rel_context : env -> evar_map -> Context.Rel.t -> std_ppcmds -val pr_rel_context_of : env -> evar_map -> std_ppcmds -val pr_context_of : env -> evar_map -> std_ppcmds +val pr_named_context : env -> evar_map -> Context.Named.t -> Pp.t +val pr_named_context_of : env -> evar_map -> Pp.t +val pr_rel_context : env -> evar_map -> Context.Rel.t -> Pp.t +val pr_rel_context_of : env -> evar_map -> Pp.t +val pr_context_of : env -> evar_map -> Pp.t (** Predicates *) -val pr_predicate : ('a -> std_ppcmds) -> (bool * 'a list) -> std_ppcmds -val pr_cpred : Cpred.t -> std_ppcmds -val pr_idpred : Id.Pred.t -> std_ppcmds -val pr_transparent_state : transparent_state -> std_ppcmds +val pr_predicate : ('a -> Pp.t) -> (bool * 'a list) -> Pp.t +val pr_cpred : Cpred.t -> Pp.t +val pr_idpred : Id.Pred.t -> Pp.t +val pr_transparent_state : transparent_state -> Pp.t (** Proofs, these functions obey [Hyps Limit] and [Compact contexts]. *) -val pr_goal : goal sigma -> std_ppcmds +val pr_goal : goal sigma -> Pp.t (** [pr_subgoals ~pr_first pp sigma seeds shelf focus_stack unfocused goals] prints the goals of the list [goals] followed by the goals in @@ -155,25 +154,25 @@ val pr_goal : goal sigma -> std_ppcmds focused goals unless the conrresponding option [enable_unfocused_goal_printing] is set. [seeds] is for printing dependent evars (mainly for emacs proof tree mode). *) -val pr_subgoals : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list - -> goal list -> goal list -> std_ppcmds +val pr_subgoals : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list + -> goal list -> goal list -> Pp.t -val pr_subgoal : int -> evar_map -> goal list -> std_ppcmds -val pr_concl : int -> evar_map -> goal -> std_ppcmds +val pr_subgoal : int -> evar_map -> goal list -> Pp.t +val pr_concl : int -> evar_map -> goal -> Pp.t -val pr_open_subgoals : ?proof:Proof.proof -> unit -> std_ppcmds -val pr_nth_open_subgoal : int -> std_ppcmds -val pr_evar : evar_map -> (evar * evar_info) -> std_ppcmds -val pr_evars_int : evar_map -> int -> evar_info Evar.Map.t -> std_ppcmds -val pr_evars : evar_map -> evar_info Evar.Map.t -> std_ppcmds -val pr_ne_evar_set : std_ppcmds -> std_ppcmds -> evar_map -> - Evar.Set.t -> std_ppcmds +val pr_open_subgoals : ?proof:Proof.proof -> unit -> Pp.t +val pr_nth_open_subgoal : int -> Pp.t +val pr_evar : evar_map -> (evar * evar_info) -> Pp.t +val pr_evars_int : evar_map -> int -> evar_info Evar.Map.t -> Pp.t +val pr_evars : evar_map -> evar_info Evar.Map.t -> Pp.t +val pr_ne_evar_set : Pp.t -> Pp.t -> evar_map -> + Evar.Set.t -> Pp.t -val pr_prim_rule : prim_rule -> std_ppcmds +val pr_prim_rule : prim_rule -> Pp.t (** Backwards compatibility *) -val prterm : constr -> std_ppcmds (** = pr_lconstr *) +val prterm : constr -> Pp.t (** = pr_lconstr *) (** Declarations for the "Print Assumption" command *) @@ -193,15 +192,15 @@ module ContextObjectMap : CMap.ExtS with type key = context_object and module Set := ContextObjectSet val pr_assumptionset : - env -> Term.types ContextObjectMap.t -> std_ppcmds + env -> Term.types ContextObjectMap.t -> Pp.t -val pr_goal_by_id : Id.t -> std_ppcmds -val pr_goal_by_uid : string -> std_ppcmds +val pr_goal_by_id : Id.t -> Pp.t +val pr_goal_by_uid : string -> Pp.t type printer_pr = { - pr_subgoals : ?pr_first:bool -> std_ppcmds option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> std_ppcmds; - pr_subgoal : int -> evar_map -> goal list -> std_ppcmds; - pr_goal : goal sigma -> std_ppcmds; + pr_subgoals : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t; + pr_subgoal : int -> evar_map -> goal list -> Pp.t; + pr_goal : goal sigma -> Pp.t; };; val set_printer_pr : printer_pr -> unit diff --git a/printing/printmod.ml b/printing/printmod.ml index 08d177f53e..219eafda4c 100644 --- a/printing/printmod.ml +++ b/printing/printmod.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -89,7 +89,7 @@ let build_ind_type env mip = let print_one_inductive env sigma mib ((_,i) as ind) = let u = if Declareops.inductive_is_polymorphic mib then - Declareops.inductive_polymorphic_instance mib + Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib) else Univ.Instance.empty in let mip = mib.mind_packets.(i) in let params = Inductive.inductive_paramdecls (mib,u) in @@ -100,7 +100,9 @@ let print_one_inductive env sigma mib ((_,i) as ind) = let envpar = push_rel_context params env in let inst = if Declareops.inductive_is_polymorphic mib then - Printer.pr_universe_instance sigma (Declareops.inductive_polymorphic_context mib) + let ctx = Declareops.inductive_polymorphic_context mib in + let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in + Printer.pr_universe_instance sigma ctx else mt () in hov 0 ( @@ -108,6 +110,17 @@ let print_one_inductive env sigma mib ((_,i) as ind) = str ": " ++ Printer.pr_lconstr_env envpar sigma arity ++ str " :=") ++ brk(0,2) ++ print_constructors envpar sigma mip.mind_consnames cstrtypes +let instantiate_cumulativity_info cumi = + let open Univ in + let univs = ACumulativityInfo.univ_context cumi in + let subtyp = ACumulativityInfo.subtyp_context cumi in + let expose ctx = + let inst = AUContext.instance ctx in + let cst = AUContext.instantiate inst ctx in + UContext.make (inst, cst) + in + CumulativityInfo.make (expose univs, expose subtyp) + let print_mutual_inductive env mind mib = let inds = List.init (Array.length mib.mind_packets) (fun x -> (mind, x)) in @@ -131,7 +144,7 @@ let print_mutual_inductive env mind mib = | Monomorphic_ind _ | Polymorphic_ind _ -> str "" | Cumulative_ind cumi -> Printer.pr_cumulativity_info - sigma (Univ.instantiate_cumulativity_info cumi)) + sigma (instantiate_cumulativity_info cumi)) let get_fields = let rec prodec_rec l subst c = @@ -149,7 +162,7 @@ let get_fields = let print_record env mind mib = let u = if Declareops.inductive_is_polymorphic mib then - Declareops.inductive_polymorphic_instance mib + Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib) else Univ.Instance.empty in let mip = mib.mind_packets.(0) in @@ -189,7 +202,7 @@ let print_record env mind mib = | Monomorphic_ind _ | Polymorphic_ind _ -> str "" | Cumulative_ind cumi -> Printer.pr_cumulativity_info - sigma (Univ.instantiate_cumulativity_info cumi) + sigma (instantiate_cumulativity_info cumi) ) let pr_mutual_inductive_body env mind mib = @@ -292,11 +305,13 @@ let print_body is_impl env mp (l,body) = | SFBmodule _ -> keyword "Module" ++ spc () ++ name | SFBmodtype _ -> keyword "Module Type" ++ spc () ++ name | SFBconst cb -> + let ctx = Declareops.constant_polymorphic_context cb in let u = if Declareops.constant_is_polymorphic cb then - Declareops.constant_polymorphic_instance cb + Univ.AUContext.instance ctx else Univ.Instance.empty in + let ctx = Univ.UContext.make (u, Univ.AUContext.instantiate u ctx) in let sigma = Evd.empty in (match cb.const_body with | Def _ -> def "Definition" ++ spc () @@ -308,7 +323,7 @@ let print_body is_impl env mp (l,body) = str " :" ++ spc () ++ hov 0 (Printer.pr_ltype_env env sigma (Vars.subst_instance_constr u - (Typeops.type_of_constant_type env cb.const_type))) ++ + cb.const_type)) ++ (match cb.const_body with | Def l when is_impl -> spc () ++ @@ -316,8 +331,7 @@ let print_body is_impl env mp (l,body) = Printer.pr_lconstr_env env sigma (Vars.subst_instance_constr u (Mod_subst.force_constr l))) | _ -> mt ()) ++ str "." ++ - Printer.pr_universe_ctx sigma - (Declareops.constant_polymorphic_context cb)) + Printer.pr_universe_ctx sigma ctx) | SFBmind mib -> try let env = Option.get env in diff --git a/printing/printmod.mli b/printing/printmod.mli index f3079d5b6b..8c3f0149e6 100644 --- a/printing/printmod.mli +++ b/printing/printmod.mli @@ -1,17 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Names (** false iff the module is an element of an open module type *) val printable_body : DirPath.t -> bool -val pr_mutual_inductive_body : Environ.env -> mutual_inductive -> Declarations.mutual_inductive_body -> std_ppcmds -val print_module : bool -> module_path -> std_ppcmds -val print_modtype : module_path -> std_ppcmds +val pr_mutual_inductive_body : Environ.env -> mutual_inductive -> Declarations.mutual_inductive_body -> Pp.t +val print_module : bool -> module_path -> Pp.t +val print_modtype : module_path -> Pp.t diff --git a/proofs/clenv.ml b/proofs/clenv.ml index 34875cbcdd..ea60be31f0 100644 --- a/proofs/clenv.ml +++ b/proofs/clenv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/clenv.mli b/proofs/clenv.mli index f43c0531d4..9c69995f4b 100644 --- a/proofs/clenv.mli +++ b/proofs/clenv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -112,7 +112,7 @@ exception NotExtensibleClause val clenv_push_prod : clausenv -> clausenv (** {6 Pretty-print (debug only) } *) -val pr_clenv : clausenv -> Pp.std_ppcmds +val pr_clenv : clausenv -> Pp.t (** {6 Evar-based clauses} *) diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml index 2ce144a6d7..4a92c3856f 100644 --- a/proofs/clenvtac.ml +++ b/proofs/clenvtac.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/clenvtac.mli b/proofs/clenvtac.mli index 26069207eb..7c3577e345 100644 --- a/proofs/clenvtac.mli +++ b/proofs/clenvtac.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml index b1fe128a24..cc81adb853 100644 --- a/proofs/evar_refiner.ml +++ b/proofs/evar_refiner.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/evar_refiner.mli b/proofs/evar_refiner.mli index e3778e94c9..b65ffb1bee 100644 --- a/proofs/evar_refiner.mli +++ b/proofs/evar_refiner.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/goal.ml b/proofs/goal.ml index e69ef18fd0..7d830146f9 100644 --- a/proofs/goal.ml +++ b/proofs/goal.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/goal.mli b/proofs/goal.mli index ee2e736120..6d3ec8bd4e 100644 --- a/proofs/goal.mli +++ b/proofs/goal.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -20,7 +20,7 @@ val uid : goal -> string val get_by_uid : string -> goal (* Debugging help *) -val pr_goal : goal -> Pp.std_ppcmds +val pr_goal : goal -> Pp.t (* Layer to implement v8.2 tactic engine ontop of the new architecture. Types are different from what they used to be due to a change of the diff --git a/proofs/logic.ml b/proofs/logic.ml index 6af1b2d837..17128b92e1 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/logic.mli b/proofs/logic.mli index f98248e4d1..84a21044b2 100644 --- a/proofs/logic.mli +++ b/proofs/logic.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/printing/miscprint.ml b/proofs/miscprint.ml index a4ecbdf5e5..5d37c8a024 100644 --- a/printing/miscprint.ml +++ b/proofs/miscprint.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/printing/miscprint.mli b/proofs/miscprint.mli index dbbe3dcfd8..b75718cd01 100644 --- a/printing/miscprint.mli +++ b/proofs/miscprint.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,27 +11,27 @@ open Misctypes (** Printing of [intro_pattern] *) val pr_intro_pattern : - ('a -> Pp.std_ppcmds) -> 'a intro_pattern_expr Loc.located -> Pp.std_ppcmds + ('a -> Pp.t) -> 'a intro_pattern_expr Loc.located -> Pp.t val pr_or_and_intro_pattern : - ('a -> Pp.std_ppcmds) -> 'a or_and_intro_pattern_expr -> Pp.std_ppcmds + ('a -> Pp.t) -> 'a or_and_intro_pattern_expr -> Pp.t -val pr_intro_pattern_naming : intro_pattern_naming_expr -> Pp.std_ppcmds +val pr_intro_pattern_naming : intro_pattern_naming_expr -> Pp.t (** Printing of [move_location] *) val pr_move_location : - ('a -> Pp.std_ppcmds) -> 'a move_location -> Pp.std_ppcmds + ('a -> Pp.t) -> 'a move_location -> Pp.t val pr_bindings : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a bindings -> Pp.std_ppcmds + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a bindings -> Pp.t val pr_bindings_no_with : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a bindings -> Pp.std_ppcmds + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a bindings -> Pp.t val pr_with_bindings : - ('a -> Pp.std_ppcmds) -> - ('a -> Pp.std_ppcmds) -> 'a * 'a bindings -> Pp.std_ppcmds + ('a -> Pp.t) -> + ('a -> Pp.t) -> 'a * 'a bindings -> Pp.t diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml index b28234a504..1937885587 100644 --- a/proofs/pfedit.ml +++ b/proofs/pfedit.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -157,10 +157,9 @@ let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac = if side_eff then Safe_typing.inline_private_constants_in_definition_entry env ce else { ce with const_entry_body = Future.chain ~pure:true ce.const_entry_body - (fun (pt, _) -> pt, Safe_typing.empty_private_constants) } in - let (cb, ctx), se = Future.force ce.const_entry_body in + (fun (pt, _) -> pt, ()) } in + let (cb, ctx), () = Future.force ce.const_entry_body in let univs' = Evd.merge_context_set Evd.univ_rigid (Evd.from_ctx univs) ctx in - assert(Safe_typing.empty_private_constants = se); cb, status, Evd.evar_universe_context univs' let refine_by_tactic env sigma ty tac = diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli index f009593e98..745ee8f367 100644 --- a/proofs/pfedit.mli +++ b/proofs/pfedit.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/proof.ml b/proofs/proof.ml index ef454299ea..ba4980b66b 100644 --- a/proofs/proof.ml +++ b/proofs/proof.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/proof.mli b/proofs/proof.mli index 9d38e16ad7..698aa48b02 100644 --- a/proofs/proof.mli +++ b/proofs/proof.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -182,7 +182,7 @@ val in_proof : proof -> (Evd.evar_map -> 'a) -> 'a focused goals. *) val unshelve : proof -> proof -val pr_proof : proof -> Pp.std_ppcmds +val pr_proof : proof -> Pp.t (*** Compatibility layer with <=v8.2 ***) module V82 : sig diff --git a/proofs/proof_bullet.ml b/proofs/proof_bullet.ml new file mode 100644 index 0000000000..f80cb7cc66 --- /dev/null +++ b/proofs/proof_bullet.ml @@ -0,0 +1,248 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +open Proof + +type t = Vernacexpr.bullet + +let bullet_eq b1 b2 = match b1, b2 with +| Vernacexpr.Dash n1, Vernacexpr.Dash n2 -> n1 = n2 +| Vernacexpr.Star n1, Vernacexpr.Star n2 -> n1 = n2 +| Vernacexpr.Plus n1, Vernacexpr.Plus n2 -> n1 = n2 +| _ -> false + +let pr_bullet b = + match b with + | Vernacexpr.Dash n -> Pp.(str (String.make n '-')) + | Vernacexpr.Star n -> Pp.(str (String.make n '*')) + | Vernacexpr.Plus n -> Pp.(str (String.make n '+')) + + +type behavior = { + name : string; + put : proof -> t -> proof; + suggest: proof -> Pp.t +} + +let behaviors = Hashtbl.create 4 +let register_behavior b = Hashtbl.add behaviors b.name b + +(*** initial modes ***) +let none = { + name = "None"; + put = (fun x _ -> x); + suggest = (fun _ -> Pp.mt ()) +} +let _ = register_behavior none + +module Strict = struct + type suggestion = + | Suggest of t (* this bullet is mandatory here *) + | Unfinished of t (* no mandatory bullet here, but this bullet is unfinished *) + | NoBulletInUse (* No mandatory bullet (or brace) here, no bullet pending, + some focused goals exists. *) + | NeedClosingBrace (* Some unfocussed goal exists "{" needed to focus them *) + | ProofFinished (* No more goal anywhere *) + + (* give a message only if more informative than the standard coq message *) + let suggest_on_solved_goal sugg = + match sugg with + | NeedClosingBrace -> Pp.(str"Try unfocusing with \"}\".") + | NoBulletInUse -> Pp.mt () + | ProofFinished -> Pp.mt () + | Suggest b -> Pp.(str"Focus next goal with bullet " ++ pr_bullet b ++ str".") + | Unfinished b -> Pp.(str"The current bullet " ++ pr_bullet b ++ str" is unfinished.") + + (* give always a message. *) + let suggest_on_error sugg = + match sugg with + | NeedClosingBrace -> Pp.(str"Try unfocusing with \"}\".") + | NoBulletInUse -> assert false (* This should never raise an error. *) + | ProofFinished -> Pp.(str"No more subgoals.") + | Suggest b -> Pp.(str"Expecting " ++ pr_bullet b ++ str".") + | Unfinished b -> Pp.(str"Current bullet " ++ pr_bullet b ++ str" is not finished.") + + exception FailedBullet of t * suggestion + + let _ = + CErrors.register_handler + (function + | FailedBullet (b,sugg) -> + let prefix = Pp.(str"Wrong bullet " ++ pr_bullet b ++ str": ") in + CErrors.user_err ~hdr:"Focus" Pp.(prefix ++ suggest_on_error sugg) + | _ -> raise CErrors.Unhandled) + + + (* spiwack: we need only one focus kind as we keep a stack of (distinct!) bullets *) + let bullet_kind = (new_focus_kind () : t list focus_kind) + let bullet_cond = done_cond ~loose_end:true bullet_kind + + (* spiwack: as it is bullets are reset (locally) by *any* non-bullet focusing command + experience will tell if this is the right discipline of if we want to be finer and + reset them only for a choice of bullets. *) + let get_bullets pr = + if is_last_focus bullet_kind pr then + get_at_focus bullet_kind pr + else + [] + + let has_bullet bul pr = + let rec has_bullet = function + | b'::_ when bullet_eq bul b' -> true + | _::l -> has_bullet l + | [] -> false + in + has_bullet (get_bullets pr) + + (* pop a bullet from proof [pr]. There should be at least one + bullet in use. If pop impossible (pending proofs on this level + of bullet or higher) then raise [Proof.CannotUnfocusThisWay]. *) + let pop pr = + match get_bullets pr with + | b::_ -> unfocus bullet_kind pr () , b + | _ -> assert false + + let push (b:t) pr = + focus bullet_cond (b::get_bullets pr) 1 pr + + (* Used only in the next function. + TODO: use a recursive function instead? *) + exception SuggestFound of t + + let suggest_bullet (prf : proof): suggestion = + if is_done prf then ProofFinished + else if not (no_focused_goal prf) + then (* No suggestion if a bullet is not mandatory, look for an unfinished bullet *) + match get_bullets prf with + | b::_ -> Unfinished b + | _ -> NoBulletInUse + else (* There is no goal under focus but some are unfocussed, + let us look at the bullet needed. If no *) + let pcobaye = ref prf in + try + while true do + let pcobaye', b = pop !pcobaye in + (* pop went well, this means that there are no more goals + *under this* bullet b, see if a new b can be pushed. *) + (try let _ = push b pcobaye' in (* push didn't fail so a new b can be pushed. *) + raise (SuggestFound b) + with SuggestFound _ as e -> raise e + | _ -> ()); (* b could not be pushed, so we must look for a outer bullet *) + pcobaye := pcobaye' + done; + assert false + with SuggestFound b -> Suggest b + | _ -> NeedClosingBrace (* No push was possible, but there are still + subgoals somewhere: there must be a "}" to use. *) + + + let rec pop_until (prf : proof) bul : proof = + let prf', b = pop prf in + if bullet_eq bul b then prf' + else pop_until prf' bul + + let put p bul = + try + if not (has_bullet bul p) then + (* bullet is not in use, so pushing it is always ok unless + no goal under focus. *) + push bul p + else + match suggest_bullet p with + | Suggest suggested_bullet when bullet_eq bul suggested_bullet + -> (* suggested_bullet is mandatory and you gave the right one *) + let p' = pop_until p bul in + push bul p' + (* the bullet you gave is in use but not the right one *) + | sugg -> raise (FailedBullet (bul,sugg)) + with NoSuchGoals _ -> (* push went bad *) + raise (FailedBullet (bul,suggest_bullet p)) + + let strict = { + name = "Strict Subproofs"; + put = put; + suggest = (fun prf -> suggest_on_solved_goal (suggest_bullet prf)) + + } + let _ = register_behavior strict +end + +(* Current bullet behavior, controlled by the option *) +let current_behavior = ref Strict.strict + +let _ = + Goptions.(declare_string_option { + optdepr = false; + optname = "bullet behavior"; + optkey = ["Bullet";"Behavior"]; + optread = begin fun () -> + (!current_behavior).name + end; + optwrite = begin fun n -> + current_behavior := + try Hashtbl.find behaviors n + with Not_found -> + CErrors.user_err Pp.(str ("Unknown bullet behavior: \"" ^ n ^ "\".")) + end + }) + +let put p b = + (!current_behavior).put p b + +let suggest p = + (!current_behavior).suggest p + +(**********************************************************) +(* *) +(* Default goal selector *) +(* *) +(**********************************************************) + + +(* Default goal selector: selector chosen when a tactic is applied + without an explicit selector. *) +let default_goal_selector = ref (Vernacexpr.SelectNth 1) +let get_default_goal_selector () = !default_goal_selector + +let pr_range_selector (i, j) = + if i = j then Pp.int i + else Pp.(int i ++ str "-" ++ int j) + +let pr_goal_selector = function + | Vernacexpr.SelectAll -> Pp.str "all" + | Vernacexpr.SelectNth i -> Pp.int i + | Vernacexpr.SelectList l -> + Pp.(str "[" + ++ prlist_with_sep pr_comma pr_range_selector l + ++ str "]") + | Vernacexpr.SelectId id -> Names.Id.print id + +let parse_goal_selector = function + | "all" -> Vernacexpr.SelectAll + | i -> + let err_msg = "The default selector must be \"all\" or a natural number." in + begin try + let i = int_of_string i in + if i < 0 then CErrors.user_err Pp.(str err_msg); + Vernacexpr.SelectNth i + with Failure _ -> CErrors.user_err Pp.(str err_msg) + end + +let _ = + Goptions.(declare_string_option{optdepr = false; + optname = "default goal selector" ; + optkey = ["Default";"Goal";"Selector"] ; + optread = begin fun () -> + Pp.string_of_ppcmds + (pr_goal_selector !default_goal_selector) + end; + optwrite = begin fun n -> + default_goal_selector := parse_goal_selector n + end + }) + diff --git a/proofs/proof_bullet.mli b/proofs/proof_bullet.mli new file mode 100644 index 0000000000..9e924fec97 --- /dev/null +++ b/proofs/proof_bullet.mli @@ -0,0 +1,53 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) +(* \VV/ **************************************************************) +(* // * This file is distributed under the terms of the *) +(* * GNU Lesser General Public License Version 2.1 *) +(************************************************************************) + +(**********************************************************) +(* *) +(* Bullets *) +(* *) +(**********************************************************) + +open Proof + +type t = Vernacexpr.bullet + +(** A [behavior] is the data of a put function which + is called when a bullet prefixes a tactic, a suggest function + suggesting the right bullet to use on a given proof, together + with a name to identify the behavior. *) +type behavior = { + name : string; + put : proof -> t -> proof; + suggest: proof -> Pp.t +} + +(** A registered behavior can then be accessed in Coq + through the command [Set Bullet Behavior "name"]. + + Two modes are registered originally: + * "Strict Subproofs": + - If this bullet follows another one of its kind, defocuses then focuses + (which fails if the focused subproof is not complete). + - If it is the first bullet of its kind, then focuses a new subproof. + * "None": bullets don't do anything *) +val register_behavior : behavior -> unit + +(** Handles focusing/defocusing with bullets: + *) +val put : proof -> t -> proof +val suggest : proof -> Pp.t + +(**********************************************************) +(* *) +(* Default goal selector *) +(* *) +(**********************************************************) + +val pr_goal_selector : Vernacexpr.goal_selector -> Pp.t +val get_default_goal_selector : unit -> Vernacexpr.goal_selector + diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml index d5fbdbb830..2ade797f63 100644 --- a/proofs/proof_global.ml +++ b/proofs/proof_global.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -378,6 +378,10 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now let t = EConstr.Unsafe.to_constr t in let univstyp, body = make_body t p in let univs, typ = Future.force univstyp in + let univs = + if poly then Entries.Polymorphic_const_entry univs + else Entries.Monomorphic_const_entry univs + in { Entries. const_entry_body = body; const_entry_secctx = section_vars; @@ -386,7 +390,7 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now const_entry_inline_code = false; const_entry_opaque = true; const_entry_universes = univs; - const_entry_polymorphic = poly}) + }) fpl initial_goals in let binders = Option.map (fun names -> fst (Evd.universe_context ~names (Evd.from_ctx universes))) @@ -446,265 +450,6 @@ let set_terminator hook = | [] -> raise NoCurrentProof | p :: ps -> pstates := { p with terminator = CEphemeron.create hook } :: ps - - - -(**********************************************************) -(* *) -(* Bullets *) -(* *) -(**********************************************************) - -module Bullet = struct - - type t = Vernacexpr.bullet - - let bullet_eq b1 b2 = match b1, b2 with - | Vernacexpr.Dash n1, Vernacexpr.Dash n2 -> n1 = n2 - | Vernacexpr.Star n1, Vernacexpr.Star n2 -> n1 = n2 - | Vernacexpr.Plus n1, Vernacexpr.Plus n2 -> n1 = n2 - | _ -> false - - let pr_bullet b = - match b with - | Vernacexpr.Dash n -> str (String.make n '-') - | Vernacexpr.Star n -> str (String.make n '*') - | Vernacexpr.Plus n -> str (String.make n '+') - - - type behavior = { - name : string; - put : Proof.proof -> t -> Proof.proof; - suggest: Proof.proof -> std_ppcmds - } - - let behaviors = Hashtbl.create 4 - let register_behavior b = Hashtbl.add behaviors b.name b - - (*** initial modes ***) - let none = { - name = "None"; - put = (fun x _ -> x); - suggest = (fun _ -> mt ()) - } - let _ = register_behavior none - - module Strict = struct - type suggestion = - | Suggest of t (* this bullet is mandatory here *) - | Unfinished of t (* no mandatory bullet here, but this bullet is unfinished *) - | NoBulletInUse (* No mandatory bullet (or brace) here, no bullet pending, - some focused goals exists. *) - | NeedClosingBrace (* Some unfocussed goal exists "{" needed to focus them *) - | ProofFinished (* No more goal anywhere *) - - (* give a message only if more informative than the standard coq message *) - let suggest_on_solved_goal sugg = - match sugg with - | NeedClosingBrace -> str"Try unfocusing with \"}\"." - | NoBulletInUse -> mt () - | ProofFinished -> mt () - | Suggest b -> str"Focus next goal with bullet " ++ pr_bullet b ++ str"." - | Unfinished b -> str"The current bullet " ++ pr_bullet b ++ str" is unfinished." - - (* give always a message. *) - let suggest_on_error sugg = - match sugg with - | NeedClosingBrace -> str"Try unfocusing with \"}\"." - | NoBulletInUse -> assert false (* This should never raise an error. *) - | ProofFinished -> str"No more subgoals." - | Suggest b -> str"Expecting " ++ pr_bullet b ++ str"." - | Unfinished b -> str"Current bullet " ++ pr_bullet b ++ str" is not finished." - - exception FailedBullet of t * suggestion - - let _ = - CErrors.register_handler - (function - | FailedBullet (b,sugg) -> - let prefix = str"Wrong bullet " ++ pr_bullet b ++ str": " in - CErrors.user_err ~hdr:"Focus" (prefix ++ suggest_on_error sugg) - | _ -> raise CErrors.Unhandled) - - - (* spiwack: we need only one focus kind as we keep a stack of (distinct!) bullets *) - let bullet_kind = (Proof.new_focus_kind () : t list Proof.focus_kind) - let bullet_cond = Proof.done_cond ~loose_end:true bullet_kind - - (* spiwack: as it is bullets are reset (locally) by *any* non-bullet focusing command - experience will tell if this is the right discipline of if we want to be finer and - reset them only for a choice of bullets. *) - let get_bullets pr = - if Proof.is_last_focus bullet_kind pr then - Proof.get_at_focus bullet_kind pr - else - [] - - let has_bullet bul pr = - let rec has_bullet = function - | b'::_ when bullet_eq bul b' -> true - | _::l -> has_bullet l - | [] -> false - in - has_bullet (get_bullets pr) - - (* pop a bullet from proof [pr]. There should be at least one - bullet in use. If pop impossible (pending proofs on this level - of bullet or higher) then raise [Proof.CannotUnfocusThisWay]. *) - let pop pr = - match get_bullets pr with - | b::_ -> Proof.unfocus bullet_kind pr () , b - | _ -> assert false - - let push (b:t) pr = - Proof.focus bullet_cond (b::get_bullets pr) 1 pr - - (* Used only in the next function. - TODO: use a recursive function instead? *) - exception SuggestFound of t - - let suggest_bullet (prf:Proof.proof): suggestion = - if Proof.is_done prf then ProofFinished - else if not (Proof.no_focused_goal prf) - then (* No suggestion if a bullet is not mandatory, look for an unfinished bullet *) - match get_bullets prf with - | b::_ -> Unfinished b - | _ -> NoBulletInUse - else (* There is no goal under focus but some are unfocussed, - let us look at the bullet needed. If no *) - let pcobaye = ref prf in - try - while true do - let pcobaye', b = pop !pcobaye in - (* pop went well, this means that there are no more goals - *under this* bullet b, see if a new b can be pushed. *) - (try let _ = push b pcobaye' in (* push didn't fail so a new b can be pushed. *) - raise (SuggestFound b) - with SuggestFound _ as e -> raise e - | _ -> ()); (* b could not be pushed, so we must look for a outer bullet *) - pcobaye := pcobaye' - done; - assert false - with SuggestFound b -> Suggest b - | _ -> NeedClosingBrace (* No push was possible, but there are still - subgoals somewhere: there must be a "}" to use. *) - - - let rec pop_until (prf:Proof.proof) bul: Proof.proof = - let prf', b = pop prf in - if bullet_eq bul b then prf' - else pop_until prf' bul - - let put p bul = - try - if not (has_bullet bul p) then - (* bullet is not in use, so pushing it is always ok unless - no goal under focus. *) - push bul p - else - match suggest_bullet p with - | Suggest suggested_bullet when bullet_eq bul suggested_bullet - -> (* suggested_bullet is mandatory and you gave the right one *) - let p' = pop_until p bul in - push bul p' - (* the bullet you gave is in use but not the right one *) - | sugg -> raise (FailedBullet (bul,sugg)) - with Proof.NoSuchGoals _ -> (* push went bad *) - raise (FailedBullet (bul,suggest_bullet p)) - - let strict = { - name = "Strict Subproofs"; - put = put; - suggest = (fun prf -> suggest_on_solved_goal (suggest_bullet prf)) - - } - let _ = register_behavior strict - end - - (* Current bullet behavior, controlled by the option *) - let current_behavior = ref Strict.strict - - let _ = - Goptions.(declare_string_option { - optdepr = false; - optname = "bullet behavior"; - optkey = ["Bullet";"Behavior"]; - optread = begin fun () -> - (!current_behavior).name - end; - optwrite = begin fun n -> - current_behavior := - try Hashtbl.find behaviors n - with Not_found -> - CErrors.user_err Pp.(str ("Unknown bullet behavior: \"" ^ n ^ "\".")) - end - }) - - let put p b = - (!current_behavior).put p b - - let suggest p = - (!current_behavior).suggest p -end - - -let _ = - let hook n = - let prf = give_me_the_proof () in - (Bullet.suggest prf) in - Proofview.set_nosuchgoals_hook hook - - -(**********************************************************) -(* *) -(* Default goal selector *) -(* *) -(**********************************************************) - - -(* Default goal selector: selector chosen when a tactic is applied - without an explicit selector. *) -let default_goal_selector = ref (Vernacexpr.SelectNth 1) -let get_default_goal_selector () = !default_goal_selector - -let pr_range_selector (i, j) = - if i = j then int i - else int i ++ str "-" ++ int j - -let pr_goal_selector = function - | Vernacexpr.SelectAll -> str "all" - | Vernacexpr.SelectNth i -> int i - | Vernacexpr.SelectList l -> - str "[" - ++ prlist_with_sep pr_comma pr_range_selector l - ++ str "]" - | Vernacexpr.SelectId id -> Id.print id - -let parse_goal_selector = function - | "all" -> Vernacexpr.SelectAll - | i -> - let err_msg = "The default selector must be \"all\" or a natural number." in - begin try - let i = int_of_string i in - if i < 0 then CErrors.user_err Pp.(str err_msg); - Vernacexpr.SelectNth i - with Failure _ -> CErrors.user_err Pp.(str err_msg) - end - -let _ = - Goptions.(declare_string_option{optdepr = false; - optname = "default goal selector" ; - optkey = ["Default";"Goal";"Selector"] ; - optread = begin fun () -> - string_of_ppcmds - (pr_goal_selector !default_goal_selector) - end; - optwrite = begin fun n -> - default_goal_selector := parse_goal_selector n - end - }) - - module V82 = struct let get_current_initial_conclusions () = let { pid; strength; proof } = cur_pstate () in @@ -733,3 +478,11 @@ let update_global_env () = let tac = Proofview.Unsafe.tclEVARS (Evd.update_sigma_env sigma (Global.env ())) in let (p,(status,info)) = Proof.run_tactic (Global.env ()) tac p in (p, ()))) + +(* XXX: Bullet hook, should be really moved elsewhere *) +let _ = + let hook n = + let prf = give_me_the_proof () in + (Proof_bullet.suggest prf) in + Proofview.set_nosuchgoals_hook hook + diff --git a/proofs/proof_global.mli b/proofs/proof_global.mli index 22cc8cf599..52f5f74046 100644 --- a/proofs/proof_global.mli +++ b/proofs/proof_global.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -121,52 +121,6 @@ val get_used_variables : unit -> Context.Named.t option val get_universe_binders : unit -> universe_binders option -(**********************************************************) -(* *) -(* Bullets *) -(* *) -(**********************************************************) - -module Bullet : sig - type t = Vernacexpr.bullet - - (** A [behavior] is the data of a put function which - is called when a bullet prefixes a tactic, a suggest function - suggesting the right bullet to use on a given proof, together - with a name to identify the behavior. *) - type behavior = { - name : string; - put : Proof.proof -> t -> Proof.proof; - suggest: Proof.proof -> Pp.std_ppcmds - } - - (** A registered behavior can then be accessed in Coq - through the command [Set Bullet Behavior "name"]. - - Two modes are registered originally: - * "Strict Subproofs": - - If this bullet follows another one of its kind, defocuses then focuses - (which fails if the focused subproof is not complete). - - If it is the first bullet of its kind, then focuses a new subproof. - * "None": bullets don't do anything *) - val register_behavior : behavior -> unit - - (** Handles focusing/defocusing with bullets: - *) - val put : Proof.proof -> t -> Proof.proof - val suggest : Proof.proof -> Pp.std_ppcmds -end - - -(**********************************************************) -(* *) -(* Default goal selector *) -(* *) -(**********************************************************) - -val pr_goal_selector : Vernacexpr.goal_selector -> Pp.std_ppcmds -val get_default_goal_selector : unit -> Vernacexpr.goal_selector - module V82 : sig val get_current_initial_conclusions : unit -> Names.Id.t *(EConstr.types list * Decl_kinds.goal_kind) diff --git a/proofs/proof_type.mli b/proofs/proof_type.ml index e59db9e427..11f1a13e6e 100644 --- a/proofs/proof_type.mli +++ b/proofs/proof_type.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/proof_using.ml b/proofs/proof_using.ml index f701f7cfed..1a321120c6 100644 --- a/proofs/proof_using.ml +++ b/proofs/proof_using.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/proof_using.mli b/proofs/proof_using.mli index b2c65412f8..c882b1827a 100644 --- a/proofs/proof_using.mli +++ b/proofs/proof_using.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/proofs.mllib b/proofs/proofs.mllib index 804a543605..eaf0c693e1 100644 --- a/proofs/proofs.mllib +++ b/proofs/proofs.mllib @@ -2,9 +2,11 @@ Miscprint Goal Evar_refiner Proof_using +Proof_type Logic Refine Proof +Proof_bullet Proof_global Redexpr Refiner diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml index 458dd21613..6052ba3672 100644 --- a/proofs/redexpr.ml +++ b/proofs/redexpr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli index 45e4610661..ccc2440a2f 100644 --- a/proofs/redexpr.mli +++ b/proofs/redexpr.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/refine.ml b/proofs/refine.ml index 796b4b8377..4161d71047 100644 --- a/proofs/refine.ml +++ b/proofs/refine.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/refine.mli b/proofs/refine.mli index c1c57ecb8e..3b0a9e5b6f 100644 --- a/proofs/refine.mli +++ b/proofs/refine.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -17,7 +17,7 @@ open Proofview (** Printer used to print the constr which refine refines. *) val pr_constr : - (Environ.env -> Evd.evar_map -> Term.constr -> Pp.std_ppcmds) Hook.t + (Environ.env -> Evd.evar_map -> Term.constr -> Pp.t) Hook.t (** {7 Refinement primitives} *) diff --git a/proofs/refiner.ml b/proofs/refiner.ml index 91e6dc4ab2..3e3313eb57 100644 --- a/proofs/refiner.ml +++ b/proofs/refiner.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -63,7 +63,7 @@ let tclIDTAC_MESSAGE s gls = let tclFAIL_s s gls = user_err ~hdr:"Refiner.tclFAIL_s" (str s) (* A special exception for levels for the Fail tactic *) -exception FailError of int * std_ppcmds Lazy.t +exception FailError of int * Pp.t Lazy.t (* The Fail tactic *) let tclFAIL lvl s g = raise (FailError (lvl,lazy s)) diff --git a/proofs/refiner.mli b/proofs/refiner.mli index e179589df2..3ff010fe3e 100644 --- a/proofs/refiner.mli +++ b/proofs/refiner.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -31,7 +31,7 @@ val refiner : rule -> tactic (** [tclIDTAC] is the identity tactic without message printing*) val tclIDTAC : tactic -val tclIDTAC_MESSAGE : Pp.std_ppcmds -> tactic +val tclIDTAC_MESSAGE : Pp.t -> tactic (** [tclEVARS sigma] changes the current evar map *) val tclEVARS : evar_map -> tactic @@ -100,7 +100,7 @@ val tclTHENLASTn : tactic -> tactic array -> tactic val tclTHENFIRSTn : tactic -> tactic array -> tactic (** A special exception for levels for the Fail tactic *) -exception FailError of int * Pp.std_ppcmds Lazy.t +exception FailError of int * Pp.t Lazy.t (** Takes an exception and either raise it at the next level or do nothing. *) @@ -116,8 +116,8 @@ val tclTRY : tactic -> tactic val tclTHENTRY : tactic -> tactic -> tactic val tclCOMPLETE : tactic -> tactic val tclAT_LEAST_ONCE : tactic -> tactic -val tclFAIL : int -> Pp.std_ppcmds -> tactic -val tclFAIL_lazy : int -> Pp.std_ppcmds Lazy.t -> tactic +val tclFAIL : int -> Pp.t -> tactic +val tclFAIL_lazy : int -> Pp.t Lazy.t -> tactic val tclDO : int -> tactic -> tactic val tclPROGRESS : tactic -> tactic val tclSHOWHYPS : tactic -> tactic diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml index f9d9f25ccf..2ed9416d10 100644 --- a/proofs/tacmach.ml +++ b/proofs/tacmach.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli index 3d2fa72c17..40b6573a15 100644 --- a/proofs/tacmach.mli +++ b/proofs/tacmach.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -94,8 +94,8 @@ val internal_cut_rev : bool -> Id.t -> types -> tactic val refine : constr -> tactic (** {6 Pretty-printing functions (debug only). } *) -val pr_gls : goal sigma -> Pp.std_ppcmds -val pr_glls : goal list sigma -> Pp.std_ppcmds +val pr_gls : goal sigma -> Pp.t +val pr_glls : goal list sigma -> Pp.t (* Variants of [Tacmach] functions built with the new proof engine *) module New : sig diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml index 3fa1732a4d..9c58df5b21 100644 --- a/stm/asyncTaskQueue.ml +++ b/stm/asyncTaskQueue.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -123,7 +123,7 @@ module Make(T : Task) = struct "-worker-id"; name; "-async-proofs-worker-priority"; Flags.string_of_priority !Flags.async_proofs_worker_priority] - | ("-ideslave"|"-emacs"|"-emacs-U"|"-batch")::tl -> set_slave_opt tl + | ("-ideslave"|"-emacs"|"-batch")::tl -> set_slave_opt tl | ("-async-proofs" |"-toploop" |"-vio2vo" |"-load-vernac-source" |"-l" |"-load-vernac-source-verbose" |"-lv" |"-compile" |"-compile-verbose" diff --git a/stm/asyncTaskQueue.mli b/stm/asyncTaskQueue.mli index f140f8ed57..a80918e933 100644 --- a/stm/asyncTaskQueue.mli +++ b/stm/asyncTaskQueue.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/coqworkmgrApi.ml b/stm/coqworkmgrApi.ml index 20d5152aac..6d6a198c5f 100644 --- a/stm/coqworkmgrApi.ml +++ b/stm/coqworkmgrApi.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/coqworkmgrApi.mli b/stm/coqworkmgrApi.mli index 548958140e..70d4173ae8 100644 --- a/stm/coqworkmgrApi.mli +++ b/stm/coqworkmgrApi.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/dag.ml b/stm/dag.ml index 99e7c92648..bdd71c50bd 100644 --- a/stm/dag.ml +++ b/stm/dag.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/dag.mli b/stm/dag.mli index e783cd8ee1..049286df31 100644 --- a/stm/dag.mli +++ b/stm/dag.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/proofBlockDelimiter.ml b/stm/proofBlockDelimiter.ml index 8162fc3bb5..a4b35ad60f 100644 --- a/stm/proofBlockDelimiter.ml +++ b/stm/proofBlockDelimiter.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/proofBlockDelimiter.mli b/stm/proofBlockDelimiter.mli index a55032a470..e23a1d1c18 100644 --- a/stm/proofBlockDelimiter.mli +++ b/stm/proofBlockDelimiter.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/proofworkertop.ml b/stm/proofworkertop.ml index 0d2f9cb747..95012d984e 100644 --- a/stm/proofworkertop.ml +++ b/stm/proofworkertop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/queryworkertop.ml b/stm/queryworkertop.ml index 9d30473739..85f0e6bfc1 100644 --- a/stm/queryworkertop.ml +++ b/stm/queryworkertop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/spawned.ml b/stm/spawned.ml index de19dd5352..6ab096abf9 100644 --- a/stm/spawned.ml +++ b/stm/spawned.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/spawned.mli b/stm/spawned.mli index acad49f379..c3cf4d67b0 100644 --- a/stm/spawned.mli +++ b/stm/spawned.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/stm.ml b/stm/stm.ml index 01edc9d2d8..3386044f26 100644 --- a/stm/stm.ml +++ b/stm/stm.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -1133,7 +1133,7 @@ let record_pb_time ?loc proof_name time = hints := Aux_file.set !hints proof_name proof_build_time end -exception RemoteException of Pp.std_ppcmds +exception RemoteException of Pp.t let _ = CErrors.register_handler (function | RemoteException ppcmd -> ppcmd | _ -> raise Unhandled) @@ -1274,7 +1274,7 @@ end = struct (* {{{ *) type error = { e_error_at : Stateid.t; e_safe_id : Stateid.t; - e_msg : Pp.std_ppcmds; + e_msg : Pp.t; e_safe_states : Stateid.t list } type response = @@ -1576,8 +1576,10 @@ end = struct (* {{{ *) let uc = Option.get (Opaqueproof.get_constraints (Global.opaque_tables ()) o) in + (** We only manipulate monomorphic terms here. *) + let map (c, ctx) = assert (Univ.AUContext.is_empty ctx); c in let pr = - Future.from_val (Option.get (Global.body_of_constant_body c)) in + Future.from_val (map (Option.get (Global.body_of_constant_body c))) in let uc = Future.chain ~pure:true uc Univ.hcons_universe_context_set in @@ -1709,7 +1711,7 @@ end = struct (* {{{ *) type response = | RespBuiltSubProof of (Constr.constr * Evd.evar_universe_context) - | RespError of Pp.std_ppcmds + | RespError of Pp.t | RespNoProgress let name = ref "tacworker" diff --git a/stm/tQueue.ml b/stm/tQueue.ml index fee4f35b49..56e8c41acd 100644 --- a/stm/tQueue.ml +++ b/stm/tQueue.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/tQueue.mli b/stm/tQueue.mli index 27eca12aff..f005b58ad1 100644 --- a/stm/tQueue.mli +++ b/stm/tQueue.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/tacworkertop.ml b/stm/tacworkertop.ml index 256532c6b6..186c8f8b7c 100644 --- a/stm/tacworkertop.ml +++ b/stm/tacworkertop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vcs.ml b/stm/vcs.ml index df3b8aa621..5d4a812fac 100644 --- a/stm/vcs.ml +++ b/stm/vcs.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vcs.mli b/stm/vcs.mli index 46b40f8a4c..6148335676 100644 --- a/stm/vcs.mli +++ b/stm/vcs.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml index 50e68852f8..c2ebea961f 100644 --- a/stm/vernac_classifier.ml +++ b/stm/vernac_classifier.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vernac_classifier.mli b/stm/vernac_classifier.mli index 45ca5cf6b5..2fa1e0b8dc 100644 --- a/stm/vernac_classifier.mli +++ b/stm/vernac_classifier.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vio_checking.ml b/stm/vio_checking.ml index 9f50ab589d..9507e90ba7 100644 --- a/stm/vio_checking.ml +++ b/stm/vio_checking.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/vio_checking.mli b/stm/vio_checking.mli index c0b6d9e6fa..e05f11cb4e 100644 --- a/stm/vio_checking.mli +++ b/stm/vio_checking.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/workerLoop.ml b/stm/workerLoop.ml index 86ef59dc30..64121eb3d5 100644 --- a/stm/workerLoop.ml +++ b/stm/workerLoop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/workerLoop.mli b/stm/workerLoop.mli index dcbf9c88d6..53f7459357 100644 --- a/stm/workerLoop.mli +++ b/stm/workerLoop.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/workerPool.ml b/stm/workerPool.ml index 9623765de0..ff4dc5c35e 100644 --- a/stm/workerPool.ml +++ b/stm/workerPool.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/stm/workerPool.mli b/stm/workerPool.mli index 75c325360e..de396d85b0 100644 --- a/stm/workerPool.mli +++ b/stm/workerPool.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/auto.ml b/tactics/auto.ml index 272cb1edaa..7aa5114a4f 100644 --- a/tactics/auto.ml +++ b/tactics/auto.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/auto.mli b/tactics/auto.mli index a6fb82bab2..b9cd4932ca 100644 --- a/tactics/auto.mli +++ b/tactics/auto.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml index 2d4f202769..ed612c0fc9 100644 --- a/tactics/autorewrite.ml +++ b/tactics/autorewrite.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli index f765318d04..edbb7c6b71 100644 --- a/tactics/autorewrite.mli +++ b/tactics/autorewrite.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -40,7 +40,7 @@ val auto_multi_rewrite : ?conds:conditions -> string list -> Locus.clause -> uni val auto_multi_rewrite_with : ?conds:conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic -val print_rewrite_hintdb : string -> Pp.std_ppcmds +val print_rewrite_hintdb : string -> Pp.t open Clenv diff --git a/tactics/btermdn.ml b/tactics/btermdn.ml index b4a235ba8c..b101b3a9f5 100644 --- a/tactics/btermdn.ml +++ b/tactics/btermdn.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/btermdn.mli b/tactics/btermdn.mli index 27f624f716..a48c866daf 100644 --- a/tactics/btermdn.mli +++ b/tactics/btermdn.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml index 30063ce37e..371debede4 100644 --- a/tactics/class_tactics.ml +++ b/tactics/class_tactics.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -92,7 +92,7 @@ open Goptions let _ = declare_bool_option - { optdepr = true; + { optdepr = true; (* remove in 8.8 *) optname = "do typeclass search modulo eta conversion"; optkey = ["Typeclasses";"Modulo";"Eta"]; optread = get_typeclasses_modulo_eta; @@ -125,7 +125,7 @@ let _ = let _ = declare_bool_option - { optdepr = false; + { optdepr = true; (* remove in 8.8 *) optname = "compat"; optkey = ["Typeclasses";"Legacy";"Resolution"]; optread = get_typeclasses_legacy_resolution; @@ -494,16 +494,15 @@ let catchable = function | Refiner.FailError _ -> true | e -> Logic.catchable_exception e -(* alternate separators in debug search path output *) -let debug_seps = [| "." ; "-" |] -let next_sep seps = - let num_seps = Array.length seps in - let sep_index = ref 0 in - fun () -> - let sep = seps.(!sep_index) in - sep_index := (!sep_index + 1) mod num_seps; - str sep -let pr_depth l = prlist_with_sep (next_sep debug_seps) int (List.rev l) +let pr_depth l = + let rec fmt elts = + match elts with + | [] -> [] + | [n] -> [string_of_int n] + | n1::n2::rest -> + (string_of_int n1 ^ "." ^ string_of_int n2) :: fmt rest + in + prlist_with_sep (fun () -> str "-") str (fmt (List.rev l)) let is_Prop env sigma concl = let ty = Retyping.get_type_of env sigma concl in @@ -622,7 +621,7 @@ module V85 = struct type autoinfo = { hints : hint_db; is_evar: existential_key option; only_classes: bool; unique : bool; - auto_depth: int list; auto_last_tac: std_ppcmds Lazy.t; + auto_depth: int list; auto_last_tac: Pp.t Lazy.t; auto_path : global_reference option list; auto_cut : hints_path } type autogoal = goal * autoinfo @@ -973,7 +972,7 @@ end module Search = struct type autoinfo = { search_depth : int list; - last_tac : Pp.std_ppcmds Lazy.t; + last_tac : Pp.t Lazy.t; search_dep : bool; search_only_classes : bool; search_cut : hints_path; @@ -1144,7 +1143,7 @@ module Search = struct let res = if j = 0 then tclUNIT () else tclDISPATCH - (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j)))) + (List.init j (fun j' -> (tac_of gls i (Option.default 0 k + j')))) in let finish nestedshelf sigma = let filter ev = @@ -1425,18 +1424,20 @@ let deps_of_constraints cstrs evm p = Intpart.union_set (Evar.Set.union evx evy) p) cstrs -let evar_dependencies evm p = +let evar_dependencies pred evm p = Evd.fold_undefined (fun ev evi _ -> - let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi) - in Intpart.union_set evars p) + if Typeclasses.is_resolvable evi && pred evm ev evi then + let evars = Evar.Set.add ev (Evarutil.undefined_evars_of_evar_info evm evi) + in Intpart.union_set evars p + else ()) evm () (** [split_evars] returns groups of undefined evars according to dependencies *) -let split_evars evm = +let split_evars pred evm = let p = Intpart.create () in - evar_dependencies evm p; + evar_dependencies pred evm p; deps_of_constraints (snd (extract_all_conv_pbs evm)) evm p; Intpart.partition p @@ -1459,7 +1460,6 @@ let is_mandatory p comp evd = (** In case of unsatisfiable constraints, build a nice error message *) let error_unresolvable env comp evd = - let evd = Evarutil.nf_evar_map_undefined evd in let is_part ev = match comp with | None -> true | Some s -> Evar.Set.mem ev s @@ -1473,8 +1473,7 @@ let error_unresolvable env comp evd = else (found, accu) in let (_, ev) = Evd.fold_undefined fold evd (true, None) in - Pretype_errors.unsatisfiable_constraints - (Evarutil.nf_env_evar evd env) evd ev comp + Pretype_errors.unsatisfiable_constraints env evd ev comp (** Check if an evar is concerned by the current resolution attempt, (and in particular is in the current component), and also update @@ -1521,7 +1520,7 @@ exception Unresolved (** If [do_split] is [true], we try to separate the problem in several components and then solve them separately *) let resolve_all_evars debug depth unique env p oevd do_split fail = - let split = if do_split then split_evars oevd else [Evar.Set.empty] in + let split = if do_split then split_evars p oevd else [Evar.Set.empty] in let in_comp comp ev = if do_split then Evar.Set.mem ev comp else true in let rec docomp evd = function diff --git a/tactics/class_tactics.mli b/tactics/class_tactics.mli index c5731e3779..d8a1d2ab85 100644 --- a/tactics/class_tactics.mli +++ b/tactics/class_tactics.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml index 83c2be4106..5e2006ccc8 100644 --- a/tactics/contradiction.ml +++ b/tactics/contradiction.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/contradiction.mli b/tactics/contradiction.mli index 2cf5a68298..59f8a328ea 100644 --- a/tactics/contradiction.mli +++ b/tactics/contradiction.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/dnet.ml b/tactics/dnet.ml index c501e30628..73afc2eac2 100644 --- a/tactics/dnet.ml +++ b/tactics/dnet.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/dnet.mli b/tactics/dnet.mli index 565a916f8e..92c84fc9ad 100644 --- a/tactics/dnet.mli +++ b/tactics/dnet.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/eauto.ml b/tactics/eauto.ml index bae3344612..65864bd472 100644 --- a/tactics/eauto.ml +++ b/tactics/eauto.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -203,7 +203,7 @@ type search_state = { priority : int; depth : int; (*r depth of search before failing *) tacres : goal list sigma; - last_tactic : std_ppcmds Lazy.t; + last_tactic : Pp.t Lazy.t; dblist : hint_db list; localdb : hint_db list; prev : prev_search_state; diff --git a/tactics/eauto.mli b/tactics/eauto.mli index c952f4e721..8f847737fe 100644 --- a/tactics/eauto.mli +++ b/tactics/eauto.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/elim.ml b/tactics/elim.ml index 13d64b8e3f..b5668dfff0 100644 --- a/tactics/elim.ml +++ b/tactics/elim.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/elim.mli b/tactics/elim.mli index fb7cc7b838..0930f9a92a 100644 --- a/tactics/elim.mli +++ b/tactics/elim.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml index 99761437eb..2d2a0c1b2a 100644 --- a/tactics/elimschemes.ml +++ b/tactics/elimschemes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -46,26 +46,15 @@ let optimize_non_type_induction_scheme kind dep sort _ ind = let sigma, nf = Evarutil.nf_evars_and_universes sigma in (nf c', Evd.evar_universe_context sigma), eff else - let mib,mip = Inductive.lookup_mind_specif env ind in - let ctx = Declareops.inductive_polymorphic_context mib in - let u = Univ.UContext.instance ctx in - let ctxset = Univ.ContextSet.of_context ctx in - let ectx = Evd.evar_universe_context_of ctxset in - let sigma = Evd.merge_universe_context sigma ectx in - let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in + let sigma, pind = Evd.fresh_inductive_instance env sigma ind in + let sigma, c = build_induction_scheme env sigma pind dep sort in (c, Evd.evar_universe_context sigma), Safe_typing.empty_private_constants let build_induction_scheme_in_type dep sort ind = let env = Global.env () in let sigma = Evd.from_env env in - let ctx = - let mib,mip = Inductive.lookup_mind_specif env ind in - Declareops.inductive_polymorphic_context mib - in - let u = Univ.UContext.instance ctx in - let ctxset = Univ.ContextSet.of_context ctx in - let sigma = Evd.merge_universe_context sigma (Evd.evar_universe_context_of ctxset) in - let sigma, c = build_induction_scheme env sigma (ind,u) dep sort in + let sigma, pind = Evd.fresh_inductive_instance env sigma ind in + let sigma, c = build_induction_scheme env sigma pind dep sort in c, Evd.evar_universe_context sigma let rect_scheme_kind_from_type = diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli index da432beadc..e3fe7ddae9 100644 --- a/tactics/elimschemes.mli +++ b/tactics/elimschemes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml index 10bc6e3e24..d4cad3fa89 100644 --- a/tactics/eqdecide.ml +++ b/tactics/eqdecide.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/eqdecide.mli b/tactics/eqdecide.mli index dca1780b76..2d22710b2c 100644 --- a/tactics/eqdecide.mli +++ b/tactics/eqdecide.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/eqschemes.ml b/tactics/eqschemes.ml index efcefcf16a..ce57682c66 100644 --- a/tactics/eqschemes.ml +++ b/tactics/eqschemes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/eqschemes.mli b/tactics/eqschemes.mli index aa8a6d4bd9..4acfa7a281 100644 --- a/tactics/eqschemes.mli +++ b/tactics/eqschemes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/equality.ml b/tactics/equality.ml index 6e56dc48e5..66345ce43c 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/equality.mli b/tactics/equality.mli index 27be5affb1..421f7c7f5d 100644 --- a/tactics/equality.mli +++ b/tactics/equality.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/hints.ml b/tactics/hints.ml index 2fc8baa895..a572508d47 100644 --- a/tactics/hints.ml +++ b/tactics/hints.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -937,7 +937,7 @@ let make_extern pri pat tacast = let make_mode ref m = let open Term in - let ty = Global.type_of_global_unsafe ref in + let ty, _ = Global.type_of_global_in_context (Global.env ()) ref in let ctx, t = decompose_prod ty in let n = List.length ctx in let m' = Array.of_list m in diff --git a/tactics/hints.mli b/tactics/hints.mli index 3a0339ff57..44e5370e93 100644 --- a/tactics/hints.mli +++ b/tactics/hints.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Util open Names open EConstr @@ -85,10 +84,10 @@ type hints_path = global_reference hints_path_gen val normalize_path : hints_path -> hints_path val path_matches : hints_path -> hints_path_atom list -> bool val path_derivate : hints_path -> hints_path_atom -> hints_path -val pp_hints_path_gen : ('a -> Pp.std_ppcmds) -> 'a hints_path_gen -> Pp.std_ppcmds -val pp_hints_path_atom : ('a -> Pp.std_ppcmds) -> 'a hints_path_atom_gen -> Pp.std_ppcmds -val pp_hints_path : hints_path -> Pp.std_ppcmds -val pp_hint_mode : hint_mode -> Pp.std_ppcmds +val pp_hints_path_gen : ('a -> Pp.t) -> 'a hints_path_gen -> Pp.t +val pp_hints_path_atom : ('a -> Pp.t) -> 'a hints_path_atom_gen -> Pp.t +val pp_hints_path : hints_path -> Pp.t +val pp_hint_mode : hint_mode -> Pp.t val glob_hints_path_atom : Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen val glob_hints_path : @@ -261,12 +260,12 @@ val rewrite_db : hint_db_name (** Printing hints *) -val pr_searchtable : unit -> std_ppcmds -val pr_applicable_hint : unit -> std_ppcmds -val pr_hint_ref : global_reference -> std_ppcmds -val pr_hint_db_by_name : hint_db_name -> std_ppcmds -val pr_hint_db : Hint_db.t -> std_ppcmds -val pr_hint : hint -> Pp.std_ppcmds +val pr_searchtable : unit -> Pp.t +val pr_applicable_hint : unit -> Pp.t +val pr_hint_ref : global_reference -> Pp.t +val pr_hint_db_by_name : hint_db_name -> Pp.t +val pr_hint_db : Hint_db.t -> Pp.t +val pr_hint : hint -> Pp.t (** Hook for changing the initialization of auto *) diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml index 4db744224a..4101004d48 100644 --- a/tactics/hipattern.ml +++ b/tactics/hipattern.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli index a1d986544a..59406e1584 100644 --- a/tactics/hipattern.mli +++ b/tactics/hipattern.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/ind_tables.ml b/tactics/ind_tables.ml index 65d42b6267..7f087ea01a 100644 --- a/vernac/ind_tables.ml +++ b/tactics/ind_tables.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -123,14 +123,18 @@ let define internal id c p univs = let ctx = Evd.normalize_evar_universe_context univs in let c = Vars.subst_univs_fn_constr (Universes.make_opt_subst (Evd.evar_universe_context_subst ctx)) c in + let univs = Evd.evar_context_universe_context ctx in + let univs = + if p then Polymorphic_const_entry univs + else Monomorphic_const_entry univs + in let entry = { const_entry_body = Future.from_val ((c,Univ.ContextSet.empty), Safe_typing.empty_private_constants); const_entry_secctx = None; const_entry_type = None; - const_entry_polymorphic = p; - const_entry_universes = Evd.evar_context_universe_context ctx; + const_entry_universes = univs; const_entry_opaque = false; const_entry_inline_code = false; const_entry_feedback = None; diff --git a/vernac/ind_tables.mli b/tactics/ind_tables.mli index 20f30d6d16..f825c4f4a3 100644 --- a/vernac/ind_tables.mli +++ b/tactics/ind_tables.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -48,4 +48,4 @@ val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> constant val check_scheme : 'a scheme_kind -> inductive -> bool -val pr_scheme_kind : 'a scheme_kind -> Pp.std_ppcmds +val pr_scheme_kind : 'a scheme_kind -> Pp.t diff --git a/tactics/inv.ml b/tactics/inv.ml index 2bc9d9f788..9495ca9c55 100644 --- a/tactics/inv.ml +++ b/tactics/inv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/inv.mli b/tactics/inv.mli index 5835e763dd..828cf7a044 100644 --- a/tactics/inv.mli +++ b/tactics/inv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/leminv.ml b/tactics/leminv.ml index 87d815fc81..aeb80ae57c 100644 --- a/tactics/leminv.ml +++ b/tactics/leminv.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/leminv.mli b/tactics/leminv.mli index a343fc81a7..41b0e09b42 100644 --- a/tactics/leminv.mli +++ b/tactics/leminv.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml index 4101dc23e4..bce0dda10c 100644 --- a/tactics/tacticals.ml +++ b/tactics/tacticals.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli index 9603212de6..2a04c413be 100644 --- a/tactics/tacticals.mli +++ b/tactics/tacticals.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Names open Term open EConstr @@ -19,7 +18,7 @@ open Tactypes (** Tacticals i.e. functions from tactics to tactics. *) val tclIDTAC : tactic -val tclIDTAC_MESSAGE : std_ppcmds -> tactic +val tclIDTAC_MESSAGE : Pp.t -> tactic val tclORELSE0 : tactic -> tactic -> tactic val tclORELSE : tactic -> tactic -> tactic val tclTHEN : tactic -> tactic -> tactic @@ -41,8 +40,8 @@ val tclSOLVE : tactic list -> tactic val tclTRY : tactic -> tactic val tclCOMPLETE : tactic -> tactic val tclAT_LEAST_ONCE : tactic -> tactic -val tclFAIL : int -> std_ppcmds -> tactic -val tclFAIL_lazy : int -> std_ppcmds Lazy.t -> tactic +val tclFAIL : int -> Pp.t -> tactic +val tclFAIL_lazy : int -> Pp.t Lazy.t -> tactic val tclDO : int -> tactic -> tactic val tclPROGRESS : tactic -> tactic val tclSHOWHYPS : tactic -> tactic @@ -160,9 +159,9 @@ module New : sig (* [tclFAIL n msg] fails with [msg] as an error message at level [n] (meaning that it will jump over [n] error catching tacticals FROM THIS MODULE. *) - val tclFAIL : int -> Pp.std_ppcmds -> 'a tactic + val tclFAIL : int -> Pp.t -> 'a tactic - val tclZEROMSG : ?loc:Loc.t -> Pp.std_ppcmds -> 'a tactic + val tclZEROMSG : ?loc:Loc.t -> Pp.t -> 'a tactic (** Fail with a [User_Error] containing the given message. *) val tclOR : unit tactic -> unit tactic -> unit tactic diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 689cc48aa2..82d58074bc 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -80,15 +80,15 @@ let _ = optread = (fun () -> !Flags.tactic_context_compat) ; optwrite = (fun b -> Flags.tactic_context_compat := b) } -let apply_solve_class_goals = ref (false) -let _ = Goptions.declare_bool_option { - Goptions.optdepr = true; - Goptions.optname = - "Perform typeclass resolution on apply-generated subgoals."; - Goptions.optkey = ["Typeclass";"Resolution";"After";"Apply"]; - Goptions.optread = (fun () -> !apply_solve_class_goals); - Goptions.optwrite = (fun a -> apply_solve_class_goals:=a); -} +let apply_solve_class_goals = ref false + +let _ = + declare_bool_option + { optdepr = true; (* remove in 8.8 *) + optname = "Perform typeclass resolution on apply-generated subgoals."; + optkey = ["Typeclass";"Resolution";"After";"Apply"]; + optread = (fun () -> !apply_solve_class_goals); + optwrite = (fun a -> apply_solve_class_goals := a); } let clear_hyp_by_default = ref false @@ -124,7 +124,7 @@ let shrink_abstract = ref true let _ = declare_bool_option - { optdepr = true; + { optdepr = true; (* remove in 8.8 *) optname = "shrinking of abstracted proofs"; optkey = ["Shrink"; "Abstract"]; optread = (fun () -> !shrink_abstract) ; @@ -143,7 +143,7 @@ let use_bracketing_last_or_and_intro_pattern () = let _ = declare_bool_option - { optdepr = true; (* remove in 8.8 *) + { optdepr = false; optname = "bracketing last or-and introduction pattern"; optkey = ["Bracketing";"Last";"Introduction";"Pattern"]; optread = (fun () -> !bracketing_last_or_and_intro_pattern); @@ -2979,7 +2979,7 @@ let specialize (c,lbind) ipat = sigma,hd' | _ ,_ -> assert false in let sigma,hd = rebuild_lambdas sigma (List.rev lprod) [] c_hd tstack in - sigma, hd + Evd.clear_metas sigma, hd in let typ = Retyping.get_type_of env sigma term in let tac = @@ -5003,9 +5003,21 @@ let cache_term_by_tactic_then ~opaque ?(goal_type=None) id gk tac tacK = Declare.declare_constant ~internal:Declare.InternalTacticRequest ~local:true id decl in let cst = Impargs.with_implicit_protection cst () in - (* let evd, lem = Evd.fresh_global (Global.env ()) evd (ConstRef cst) in *) - let lem, ctx = Universes.unsafe_constr_of_global (ConstRef cst) in - let lem = EConstr.of_constr lem in + let lem = + match const.Entries.const_entry_universes with + | Entries.Polymorphic_const_entry uctx -> + let uctx = Univ.ContextSet.of_context uctx in + (** Hack: the kernel may generate definitions whose universe variables are + not the same as requested in the entry because of constraints delayed + in the body, even in polymorphic mode. We mimick what it does for now + in hope it is fixed at some point. *) + let (_, body_uctx), _ = Future.force const.Entries.const_entry_body in + let uctx = Univ.ContextSet.to_context (Univ.ContextSet.union uctx body_uctx) in + let u = Univ.UContext.instance uctx in + mkConstU (cst, EInstance.make u) + | Entries.Monomorphic_const_entry _ -> + mkConst cst + in let evd = Evd.set_universe_context evd ectx in let open Safe_typing in let eff = private_con_of_con (Global.safe_env ()) cst in diff --git a/tactics/tactics.mli b/tactics/tactics.mli index 2e17b8dd5c..bca0c4c50d 100644 --- a/tactics/tactics.mli +++ b/tactics/tactics.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tactics/term_dnet.ml b/tactics/term_dnet.ml index 726fd23b64..64ba38a51b 100644 --- a/tactics/term_dnet.ml +++ b/tactics/term_dnet.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -49,7 +49,7 @@ struct | DNil (* debug *) - let _pr_dconstr f : 'a t -> std_ppcmds = function + let _pr_dconstr f : 'a t -> Pp.t = function | DRel -> str "*" | DSort -> str "Sort" | DRef _ -> str "Ref" diff --git a/tactics/term_dnet.mli b/tactics/term_dnet.mli index fcc03befeb..16122fa5e0 100644 --- a/tactics/term_dnet.mli +++ b/tactics/term_dnet.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/Makefile b/test-suite/Makefile index 5ab4cacdaf..1268ed14bc 100644 --- a/test-suite/Makefile +++ b/test-suite/Makefile @@ -27,12 +27,13 @@ # Default value when called from a freshly compiled Coq, but can be # easily overridden -LIB := $(shell cd ..; pwd) -BIN := $(LIB)/bin/ +LIB := .. +BIN := $(shell cd ..; pwd)/bin/ coqtop := $(BIN)coqtop -coqlib $(LIB) -boot -q -batch -test-mode -R prerequisite TestSuite coqc := $(BIN)coqc -coqlib $(LIB) -R prerequisite TestSuite coqchk := $(BIN)coqchk -coqlib $(LIB) -R prerequisite TestSuite +coqdoc := $(BIN)coqdoc coqtopbyte := $(BIN)coqtop.byte coqtopload := $(coqtop) -top Top -async-proofs-cache force -load-vernac-source @@ -85,7 +86,8 @@ COMPLEXITY := $(if $(bogomips),complexity) BUGS := bugs/opened bugs/closed VSUBSYSTEMS := prerequisite success failure $(BUGS) output \ - output-modulo-time interactive micromega $(COMPLEXITY) modules stm + output-modulo-time interactive micromega $(COMPLEXITY) modules stm \ + coqdoc # All subsystems SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk coq-makefile @@ -153,6 +155,7 @@ summary: $(call summary_dir, "VI tests", vio); \ $(call summary_dir, "Coqchk tests", coqchk); \ $(call summary_dir, "Coq makefile", coq-makefile); \ + $(call summary_dir, "Coqdoc tests", coqdoc); \ nb_success=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_success) | wc -l`; \ nb_failure=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_failure) | wc -l`; \ nb_tests=`expr $$nb_success + $$nb_failure`; \ @@ -170,6 +173,7 @@ summary.log: report: summary.log $(HIDE)./save-logs.sh $(HIDE)if [ -n "${TRAVIS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo "travis_fold:start:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo "travis_fold:end:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';'; fi + $(HIDE)if [ -n "${APPVEYOR}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo {}' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo' ';'; fi $(HIDE)if grep -q -F 'Error!' summary.log ; then echo FAILURES; grep -F 'Error!' summary.log; false; else echo NO FAILURES; fi ####################################################################### @@ -293,7 +297,7 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG) | grep -v "^<W>" \ | sed 's/File "[^"]*"/File "stdin"/' \ > $$tmpoutput; \ - diff -u $*.out $$tmpoutput 2>&1; R=$$?; times; \ + diff -u --strip-trailing-cr $*.out $$tmpoutput 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ @@ -328,7 +332,7 @@ $(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out -e 's/\s*[-+]inf\s*//g' \ -e 's/^[^a-zA-Z]*//' \ $*.out | sort > $$tmpexpected; \ - diff -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \ + diff --strip-trailing-cr -b -u $$tmpexpected $$tmpoutput 2>&1; R=$$?; times; \ if [ $$R = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ @@ -445,7 +449,7 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake)) @echo "TEST $<" $(HIDE){ \ echo $(call log_intro,$<); \ - $(BIN)fake_ide $< "$(BIN)coqtop -coqlib $(LIB) -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \ + $(BIN)fake_ide $< "-coqlib $(LIB) -boot -async-proofs on -async-proofs-tactic-error-resilience off -async-proofs-command-error-resilience off" 2>&1; \ if [ $$? = 0 ]; then \ echo $(log_success); \ echo " $<...Ok"; \ @@ -455,6 +459,8 @@ ide : $(patsubst %.fake,%.fake.log,$(wildcard ide/*.fake)) fi; \ } > "$@" +# vio compilation + vio: $(patsubst %.v,%.vio.log,$(wildcard vio/*.v)) %.vio.log:%.v @@ -472,6 +478,8 @@ vio: $(patsubst %.v,%.vio.log,$(wildcard vio/*.v)) fi; \ } > "$@" +# coqchk + coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v)) %.chk.log:%.v @@ -488,6 +496,8 @@ coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v)) fi; \ } > "$@" +# coq_makefile + coq-makefile: $(patsubst %/run.sh,%.log,$(wildcard coq-makefile/*/run.sh)) coq-makefile/%.log : coq-makefile/%/run.sh @@ -504,3 +514,27 @@ coq-makefile/%.log : coq-makefile/%/run.sh echo " $<...Error!"; \ fi; \ ) > "$@" + +# coqdoc + +coqdoc: $(patsubst %.sh,%.log,$(wildcard coqdoc/*.sh)) + +$(addsuffix .log,$(wildcard coqdoc/*.v)): %.v.log: %.v %.html.out %.tex.out $(PREREQUISITELOG) + @echo "TEST $< $(call get_coq_prog_args_in_parens,"$<")" + $(HIDE){ \ + echo $(call log_intro,$<); \ + $(coqc) -R coqdoc Coqdoc $* 2>&1; \ + cd coqdoc; \ + f=`basename $*`; \ + $(coqdoc) -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --html $$f.v; \ + $(coqdoc) -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --latex $$f.v; \ + diff -u $$f.html.out Coqdoc.$$f.html 2>&1; R=$$?; times; \ + grep -v "^%%" Coqdoc.$$f.tex | diff -u $$f.tex.out - 2>&1; S=$$?; times; \ + if [ $$R = 0 -a $$S = 0 ]; then \ + echo $(log_success); \ + echo " $<...Ok"; \ + else \ + echo $(log_failure); \ + echo " $<...Error! (unexpected output)"; \ + fi; \ + } > "$@" diff --git a/test-suite/bugs/closed/2141.v b/test-suite/bugs/closed/2141.v index 098a7e9e72..c556ff0b2b 100644 --- a/test-suite/bugs/closed/2141.v +++ b/test-suite/bugs/closed/2141.v @@ -11,5 +11,6 @@ End FSetHide. Module NatSet' := FSetHide NatSet. Recursive Extraction NatSet'.fold. +Extraction TestCompile NatSet'.fold. (* Extraction "test2141.ml" NatSet'.fold. *)
\ No newline at end of file diff --git a/test-suite/bugs/closed/3287.v b/test-suite/bugs/closed/3287.v index 1b758acd73..4b3e7ff054 100644 --- a/test-suite/bugs/closed/3287.v +++ b/test-suite/bugs/closed/3287.v @@ -6,6 +6,7 @@ Definition bar := true. End Foo. Recursive Extraction Foo.bar. +Extraction TestCompile Foo.bar. Module Foo'. Definition foo := (I,I). @@ -13,10 +14,6 @@ Definition bar := true. End Foo'. Recursive Extraction Foo'.bar. +Extraction TestCompile Foo'.bar. -Module Foo''. -Definition foo := (I,I). -Definition bar := true. -End Foo''. - -Extraction Foo.bar. +Extraction Foo'.bar. diff --git a/test-suite/bugs/closed/3923.v b/test-suite/bugs/closed/3923.v index 2fb0a5439a..1d9488c6e1 100644 --- a/test-suite/bugs/closed/3923.v +++ b/test-suite/bugs/closed/3923.v @@ -33,3 +33,4 @@ Axiom empty_fieldstore : cert_fieldstore. End MkCertRuntimeTypes. Extraction MkCertRuntimeTypes. (* Was leading to an uncaught Not_found *) +Extraction TestCompile MkCertRuntimeTypes. diff --git a/test-suite/bugs/closed/4616.v b/test-suite/bugs/closed/4616.v index a59975dbcf..d6660e3553 100644 --- a/test-suite/bugs/closed/4616.v +++ b/test-suite/bugs/closed/4616.v @@ -2,5 +2,6 @@ Require Coq.extraction.Extraction. Set Primitive Projections. Record Foo' := Foo { foo : Type }. -Axiom f : forall t : Foo', foo t. +Definition f := forall t : Foo', foo t. Extraction f. +Extraction TestCompile f. diff --git a/test-suite/bugs/closed/4709.v b/test-suite/bugs/closed/4709.v new file mode 100644 index 0000000000..a9edcc8043 --- /dev/null +++ b/test-suite/bugs/closed/4709.v @@ -0,0 +1,18 @@ + +(** Bug 4709 https://coq.inria.fr/bug/4709 + Extraction wasn't reducing primitive projections in types. *) + +Require Extraction. + +Set Primitive Projections. + +Record t := Foo { foo : Type }. +Definition ty := foo (Foo nat). + +(* Without proper reduction of primitive projections in + [extract_type], the type [ty] was extracted as [Tunknown]. + Let's check it isn't the case anymore. *) + +Parameter check : nat. +Extract Constant check => "(O:ty)". +Extraction TestCompile ty check. diff --git a/test-suite/bugs/closed/4710.v b/test-suite/bugs/closed/4710.v index 5d8ca330ac..e792a36234 100644 --- a/test-suite/bugs/closed/4710.v +++ b/test-suite/bugs/closed/4710.v @@ -4,7 +4,6 @@ Set Primitive Projections. Record Foo' := Foo { foo : nat }. Extraction foo. Record Foo2 (a : nat) := Foo2c { foo2p : nat; foo2b : bool }. -Extraction Language Ocaml. Extraction foo2p. Definition bla (x : Foo2 0) := foo2p _ x. @@ -12,3 +11,5 @@ Extraction bla. Definition bla' (a : nat) (x : Foo2 a) := foo2b _ x. Extraction bla'. + +Extraction TestCompile foo foo2p bla bla'. diff --git a/test-suite/bugs/closed/4720.v b/test-suite/bugs/closed/4720.v new file mode 100644 index 0000000000..704331e784 --- /dev/null +++ b/test-suite/bugs/closed/4720.v @@ -0,0 +1,50 @@ +(** Bug 4720 : extraction and "with" in module type *) + +Module Type A. + Parameter t : Set. +End A. + +Module A_instance <: A. + Definition t := nat. +End A_instance. + +Module A_private : A. + Definition t := nat. +End A_private. + +Module Type B. +End B. + +Module Type C (b : B). + Declare Module a : A. +End C. + +Module WithMod (a' : A) (b' : B) (c' : C b' with Module a := A_instance). +End WithMod. + +Module WithDef (a' : A) (b' : B) (c' : C b' with Definition a.t := nat). +End WithDef. + +Module WithModPriv (a' : A) (b' : B) (c' : C b' with Module a := A_private). +End WithModPriv. + +(* The initial bug report was concerning the extraction of WithModPriv + in Coq 8.4, which was suboptimal: it was compiling, but could have been + turned into some faulty code since A_private and c'.a were not seen as + identical by the extraction. + + In Coq 8.5 and 8.6, the extractions of WithMod, WithDef, WithModPriv + were all causing Anomaly or Assert Failure. This shoud be fixed now. +*) + +Require Extraction. + +Recursive Extraction WithMod. + +Recursive Extraction WithDef. + +Recursive Extraction WithModPriv. + +(* Let's even check that all this extracted code is actually compilable: *) + +Extraction TestCompile WithMod WithDef WithModPriv. diff --git a/test-suite/bugs/closed/4844.v b/test-suite/bugs/closed/4844.v new file mode 100644 index 0000000000..f140939ccd --- /dev/null +++ b/test-suite/bugs/closed/4844.v @@ -0,0 +1,47 @@ + +(* Bug report 4844 (and 4824): + The Haskell extraction was erroneously considering [Any] and + [()] as convertible ([Tunknown] an [Tdummy] internally). *) + +(* A value with inner logical parts. + Its extracted type will be [Sum () ()]. *) + +Definition semilogic : True + True := inl I. + +(* Higher-order record, whose projection [ST] isn't expressible + as an Haskell (or OCaml) type. Hence [ST] is extracted as the + unknown type [Any] in Haskell. *) + +Record SomeType := { ST : Type }. + +Definition SomeTrue := {| ST := True |}. + +(* A first version of the issue: + [abstrSum] is extracted as [Sum Any Any], so an unsafeCoerce + is required to cast [semilogic] into [abstrSum SomeTrue]. *) + +Definition abstrSum (t : SomeType) := ((ST t) + (ST t))%type. + +Definition semilogic' : abstrSum SomeTrue := semilogic. + +(* A deeper version of the issue. + In the previous example, the extraction could have reduced + [abstrSum SomeTrue] into [True+True], solving the issue. + It might do so in future versions. But if we put an inductive + in the way, a reduction isn't helpful. *) + +Inductive box (t : SomeType) := Box : ST t + ST t -> box t. + +Definition boxed_semilogic : box SomeTrue := + Box SomeTrue semilogic. + +Require Extraction. +Extraction Language Haskell. +Recursive Extraction semilogic' boxed_semilogic. +(* Warning! To fully check that this bug is still closed, + you should run ghc on the extracted code: + +Extraction "bug4844.hs" semilogic' boxed_semilogic. +ghc bug4844.hs + +*) diff --git a/test-suite/bugs/closed/5177.v b/test-suite/bugs/closed/5177.v new file mode 100644 index 0000000000..7c8af1e46e --- /dev/null +++ b/test-suite/bugs/closed/5177.v @@ -0,0 +1,22 @@ +(* Bug 5177 https://coq.inria.fr/bug/5177 : + Extraction and module type containing application and "with" *) + +Module Type T. + Parameter t: Type. +End T. + +Module Type A (MT: T). + Parameter t1: Type. + Parameter t2: Type. + Parameter bar: MT.t -> t1 -> t2. +End A. + +Module MakeA(MT: T): A MT with Definition t1 := nat. + Definition t1 := nat. + Definition t2 := nat. + Definition bar (m: MT.t) (x:t1) := x. +End MakeA. + +Require Extraction. +Recursive Extraction MakeA. +Extraction TestCompile MakeA. diff --git a/test-suite/bugs/closed/5205.v b/test-suite/bugs/closed/5205.v new file mode 100644 index 0000000000..406f37a4b1 --- /dev/null +++ b/test-suite/bugs/closed/5205.v @@ -0,0 +1,6 @@ +Definition foo (n : nat) (m : nat) : nat := m. + +Arguments foo {_} _, _ _. + +Check foo 1 1. +Check foo (n:=1) 1. diff --git a/test-suite/bugs/closed/5315.v b/test-suite/bugs/closed/5315.v new file mode 100644 index 0000000000..f1f1b8c051 --- /dev/null +++ b/test-suite/bugs/closed/5315.v @@ -0,0 +1,10 @@ +Require Import Recdef. + +Function dumb_works (a:nat) {struct a} := + match (fun x => x) a with O => O | S n' => dumb_works n' end. + +Function dumb_nope (a:nat) {struct a} := + match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end. + +(* This check is just present to ensure Function worked well *) +Check R_dumb_nope_complete.
\ No newline at end of file diff --git a/test-suite/bugs/closed/5365.v b/test-suite/bugs/closed/5365.v new file mode 100644 index 0000000000..be360d24d2 --- /dev/null +++ b/test-suite/bugs/closed/5365.v @@ -0,0 +1,13 @@ + +Inductive TupleT : nat -> Type := +| nilT : TupleT 0 +| consT {n} A : (A -> TupleT n) -> TupleT (S n). + +Inductive Tuple : forall n, TupleT n -> Type := + nil : Tuple _ nilT +| cons {n A} (x : A) (F : A -> TupleT n) : Tuple _ (F x) -> Tuple _ (consT A F). + +Inductive TupleMap : forall n, TupleT n -> TupleT n -> Type := + tmNil : TupleMap _ nilT nilT +| tmCons {n} {A B : Type} (F : A -> TupleT n) (G : B -> TupleT n) + : (forall x, sigT (fun y => TupleMap _ (F x) (G y))) -> TupleMap _ (consT A F) (consT B G). diff --git a/test-suite/bugs/closed/5618.v b/test-suite/bugs/closed/5618.v new file mode 100644 index 0000000000..ab88a88f44 --- /dev/null +++ b/test-suite/bugs/closed/5618.v @@ -0,0 +1,9 @@ +Require Import FunInd. + +Function test {T} (v : T) (x : nat) : nat := + match x with + | 0 => 0 + | S x' => test v x' + end. + +Check R_test_complete.
\ No newline at end of file diff --git a/test-suite/bugs/closed/5641.v b/test-suite/bugs/closed/5641.v new file mode 100644 index 0000000000..9f3246f33d --- /dev/null +++ b/test-suite/bugs/closed/5641.v @@ -0,0 +1,6 @@ +Set Universe Polymorphism. + +Definition foo@{i j} (A : Type@{i}) : Type@{j}. +Proof. +abstract (exact ltac:(abstract (exact A))). +Defined. diff --git a/test-suite/bugs/closed/5671.v b/test-suite/bugs/closed/5671.v new file mode 100644 index 0000000000..c9a085045a --- /dev/null +++ b/test-suite/bugs/closed/5671.v @@ -0,0 +1,7 @@ +(* Fixing Meta-unclean specialize *) + +Require Import Setoid. +Axiom a : forall x, x=0 -> True. +Lemma lem (x y1 y2:nat) (H:x=0) (H0:eq y1 y2) : y1 = y2. +specialize a with (1:=H). clear H x. intros _. +setoid_rewrite H0. diff --git a/test-suite/bugs/closed/HoTT_coq_123.v b/test-suite/bugs/closed/HoTT_coq_123.v index cd9cad4064..7bed956f3e 100644 --- a/test-suite/bugs/closed/HoTT_coq_123.v +++ b/test-suite/bugs/closed/HoTT_coq_123.v @@ -104,11 +104,15 @@ Record Functor (C D : PreCategory) := morphism_of : forall s d, morphism C s d -> morphism D (object_of s) (object_of d) }. +(** Workaround to simpl losing universe constraints, see bug #5645. *) +Ltac simpl' := + simpl; match goal with [ |- ?P ] => let T := type of P in idtac end. + Global Instance trunc_forall `{Funext} `{P : A -> Type} `{forall a, IsTrunc n (P a)} : IsTrunc n (forall a, P a) | 100. Proof. generalize dependent P. - induction n as [ | n' IH]; (simpl; intros P ?). + induction n as [ | n' IH]; (simpl'; intros P ?). - admit. - pose (fun f g => trunc_equiv (@apD10 A P f g) ^-1); admit. Defined. diff --git a/test-suite/coq-makefile/arg/run.sh b/test-suite/coq-makefile/arg/run.sh index e98da17c78..e7de90ff2f 100755 --- a/test-suite/coq-makefile/arg/run.sh +++ b/test-suite/coq-makefile/arg/run.sh @@ -1,9 +1,7 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make diff --git a/test-suite/coq-makefile/compat-subdirs/run.sh b/test-suite/coq-makefile/compat-subdirs/run.sh index 28d9878f9b..221dcd7bf8 100755 --- a/test-suite/coq-makefile/compat-subdirs/run.sh +++ b/test-suite/coq-makefile/compat-subdirs/run.sh @@ -1,9 +1,8 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh + coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make exec test -f "subdir/done" diff --git a/test-suite/coq-makefile/coqdoc1/run.sh b/test-suite/coq-makefile/coqdoc1/run.sh index e8291c89da..1feff7479b 100755 --- a/test-suite/coq-makefile/coqdoc1/run.sh +++ b/test-suite/coq-makefile/coqdoc1/run.sh @@ -1,17 +1,15 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/coqdoc2/run.sh b/test-suite/coq-makefile/coqdoc2/run.sh index e8291c89da..1feff7479b 100755 --- a/test-suite/coq-makefile/coqdoc2/run.sh +++ b/test-suite/coq-makefile/coqdoc2/run.sh @@ -1,17 +1,15 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/extend-subdirs/run.sh b/test-suite/coq-makefile/extend-subdirs/run.sh index ea5792a937..221dcd7bf8 100755 --- a/test-suite/coq-makefile/extend-subdirs/run.sh +++ b/test-suite/coq-makefile/extend-subdirs/run.sh @@ -1,10 +1,8 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make exec test -f "subdir/done" diff --git a/test-suite/coq-makefile/latex1/run.sh b/test-suite/coq-makefile/latex1/run.sh index 214a9d5b28..b2c5d5669b 100755 --- a/test-suite/coq-makefile/latex1/run.sh +++ b/test-suite/coq-makefile/latex1/run.sh @@ -1,13 +1,11 @@ #!/usr/bin/env bash -#set -x -set -e - if which pdflatex; then . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make exec make all.pdf diff --git a/test-suite/coq-makefile/merlin1/run.sh b/test-suite/coq-makefile/merlin1/run.sh index 752c0c2cea..1f262a9390 100755 --- a/test-suite/coq-makefile/merlin1/run.sh +++ b/test-suite/coq-makefile/merlin1/run.sh @@ -1,11 +1,9 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make .merlin cat > desired <<EOT B src diff --git a/test-suite/coq-makefile/mlpack1/run.sh b/test-suite/coq-makefile/mlpack1/run.sh index 10a200ddee..51669f28f5 100755 --- a/test-suite/coq-makefile/mlpack1/run.sh +++ b/test-suite/coq-makefile/mlpack1/run.sh @@ -1,16 +1,14 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/mlpack2/run.sh b/test-suite/coq-makefile/mlpack2/run.sh index 10a200ddee..51669f28f5 100755 --- a/test-suite/coq-makefile/mlpack2/run.sh +++ b/test-suite/coq-makefile/mlpack2/run.sh @@ -1,16 +1,14 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/multiroot/run.sh b/test-suite/coq-makefile/multiroot/run.sh index 3cd1ac305f..d3bb53106d 100755 --- a/test-suite/coq-makefile/multiroot/run.sh +++ b/test-suite/coq-makefile/multiroot/run.sh @@ -1,19 +1,17 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh cp -r theories theories2 mv src/test_plugin.mlpack src/test_plugin.mllib coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" make install-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/native1/run.sh b/test-suite/coq-makefile/native1/run.sh index 9f6295d644..3bec11cb75 100755 --- a/test-suite/coq-makefile/native1/run.sh +++ b/test-suite/coq-makefile/native1/run.sh @@ -1,19 +1,17 @@ #!/usr/bin/env bash -#set -x -set -e - NATIVECOMP=`grep "let no_native_compiler = false" ../../../config/coq_config.ml`||true if [[ `which ocamlopt` && $NATIVECOMP ]]; then . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/only/run.sh b/test-suite/coq-makefile/only/run.sh index 2ea3deffb7..8cf04bf2cd 100755 --- a/test-suite/coq-makefile/only/run.sh +++ b/test-suite/coq-makefile/only/run.sh @@ -1,11 +1,9 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make only TGTS="src/test.cmi src/test_aux.cmi" -j2 test -f src/test.cmi test -f src/test_aux.cmi diff --git a/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh b/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh index 6301aa03c0..88606cd473 100755 --- a/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh +++ b/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh @@ -27,6 +27,7 @@ let _ = Pre_env.empty_env EOT ${COQBIN}coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf if make VERBOSE=1; then # make command should have failed (but didn't) diff --git a/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh b/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh index 991fb4a61d..939ef9c7b7 100755 --- a/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh +++ b/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh @@ -28,5 +28,6 @@ let _ = Pre_env.empty_env EOT ${COQBIN}coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make VERBOSE=1 diff --git a/test-suite/coq-makefile/plugin1/run.sh b/test-suite/coq-makefile/plugin1/run.sh index c2d47166fe..5433d9e92d 100755 --- a/test-suite/coq-makefile/plugin1/run.sh +++ b/test-suite/coq-makefile/plugin1/run.sh @@ -1,17 +1,15 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh mv src/test_plugin.mlpack src/test_plugin.mllib coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/plugin2/run.sh b/test-suite/coq-makefile/plugin2/run.sh index c2d47166fe..5433d9e92d 100755 --- a/test-suite/coq-makefile/plugin2/run.sh +++ b/test-suite/coq-makefile/plugin2/run.sh @@ -1,17 +1,15 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh mv src/test_plugin.mlpack src/test_plugin.mllib coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/plugin3/run.sh b/test-suite/coq-makefile/plugin3/run.sh index c2d47166fe..5433d9e92d 100755 --- a/test-suite/coq-makefile/plugin3/run.sh +++ b/test-suite/coq-makefile/plugin3/run.sh @@ -1,17 +1,15 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh mv src/test_plugin.mlpack src/test_plugin.mllib coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" #make debug -(cd `find tmp -name user-contrib`; find .) | sort > actual +(cd `find tmp -name user-contrib` && find .) | sort > actual sort > desired <<EOT . ./test diff --git a/test-suite/coq-makefile/template/init.sh b/test-suite/coq-makefile/template/init.sh index c952d41a30..803fe8029a 100755 --- a/test-suite/coq-makefile/template/init.sh +++ b/test-suite/coq-makefile/template/init.sh @@ -1,3 +1,5 @@ +set -e +set -o pipefail export PATH=$COQBIN:$PATH diff --git a/test-suite/coq-makefile/timing/after/Fast.v b/test-suite/coq-makefile/timing/after/Fast.v new file mode 100644 index 0000000000..54d3cfc3eb --- /dev/null +++ b/test-suite/coq-makefile/timing/after/Fast.v @@ -0,0 +1,4 @@ +Require Coq.ZArith.BinInt. +Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. diff --git a/test-suite/coq-makefile/timing/after/Slow.v b/test-suite/coq-makefile/timing/after/Slow.v new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/test-suite/coq-makefile/timing/after/Slow.v @@ -0,0 +1 @@ + diff --git a/test-suite/coq-makefile/timing/after/_CoqProject b/test-suite/coq-makefile/timing/after/_CoqProject new file mode 100644 index 0000000000..36c3a18c2b --- /dev/null +++ b/test-suite/coq-makefile/timing/after/_CoqProject @@ -0,0 +1,2 @@ +Slow.v +Fast.v diff --git a/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired new file mode 100644 index 0000000000..729de2f366 --- /dev/null +++ b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired @@ -0,0 +1,16 @@ +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +COQDEP Fast.v +COQDEP Slow.v +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +COQC Slow.v +Slow (real: 0.04, user: 0.02, sys: 0.01, mem: 45512 ko) +COQC Fast.v +Fast (real: 0.41, user: 0.37, sys: 0.04, mem: 395200 ko) +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' diff --git a/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired new file mode 100644 index 0000000000..b25bc3683c --- /dev/null +++ b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired @@ -0,0 +1,16 @@ +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +COQDEP Fast.v +COQDEP Slow.v +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' +COQC Slow.v +Slow (real: 0.40, user: 0.35, sys: 0.04, mem: 394968 ko) +COQC Fast.v +Fast (real: 0.04, user: 0.03, sys: 0.00, mem: 46564 ko) +Makefile:69: warning: undefined variable '*' +Makefile:204: warning: undefined variable 'DSTROOT' diff --git a/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired new file mode 100644 index 0000000000..56815d241e --- /dev/null +++ b/test-suite/coq-makefile/timing/after/time-of-build-both.log.desired @@ -0,0 +1,6 @@ +After | File Name | Before || Change | % Change +-------------------------------------------------------- +0m00.38s | Total | 0m00.39s || -0m00.01s | -2.56% +-------------------------------------------------------- +0m00.35s | Slow | 0m00.02s || +0m00.32s | +1649.99% +0m00.03s | Fast | 0m00.37s || -0m00.34s | -91.89%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/aggregate/Fast.v b/test-suite/coq-makefile/timing/aggregate/Fast.v new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/test-suite/coq-makefile/timing/aggregate/Fast.v @@ -0,0 +1 @@ + diff --git a/test-suite/coq-makefile/timing/aggregate/Slow.v b/test-suite/coq-makefile/timing/aggregate/Slow.v new file mode 100644 index 0000000000..54d3cfc3eb --- /dev/null +++ b/test-suite/coq-makefile/timing/aggregate/Slow.v @@ -0,0 +1,4 @@ +Require Coq.ZArith.BinInt. +Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. diff --git a/test-suite/coq-makefile/timing/aggregate/_CoqProject b/test-suite/coq-makefile/timing/aggregate/_CoqProject new file mode 100644 index 0000000000..36c3a18c2b --- /dev/null +++ b/test-suite/coq-makefile/timing/aggregate/_CoqProject @@ -0,0 +1,2 @@ +Slow.v +Fast.v diff --git a/test-suite/coq-makefile/timing/before/Fast.v b/test-suite/coq-makefile/timing/before/Fast.v new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/test-suite/coq-makefile/timing/before/Fast.v @@ -0,0 +1 @@ + diff --git a/test-suite/coq-makefile/timing/before/Slow.v b/test-suite/coq-makefile/timing/before/Slow.v new file mode 100644 index 0000000000..54d3cfc3eb --- /dev/null +++ b/test-suite/coq-makefile/timing/before/Slow.v @@ -0,0 +1,4 @@ +Require Coq.ZArith.BinInt. +Definition foo0 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo1 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. +Definition foo2 := Eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl. diff --git a/test-suite/coq-makefile/timing/before/_CoqProject b/test-suite/coq-makefile/timing/before/_CoqProject new file mode 100644 index 0000000000..36c3a18c2b --- /dev/null +++ b/test-suite/coq-makefile/timing/before/_CoqProject @@ -0,0 +1,2 @@ +Slow.v +Fast.v diff --git a/test-suite/coq-makefile/timing/error/A.v b/test-suite/coq-makefile/timing/error/A.v new file mode 100644 index 0000000000..932363a122 --- /dev/null +++ b/test-suite/coq-makefile/timing/error/A.v @@ -0,0 +1 @@ +Check I : I. diff --git a/test-suite/coq-makefile/timing/error/_CoqProject b/test-suite/coq-makefile/timing/error/_CoqProject new file mode 100644 index 0000000000..790e057133 --- /dev/null +++ b/test-suite/coq-makefile/timing/error/_CoqProject @@ -0,0 +1 @@ +A.v diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v b/test-suite/coq-makefile/timing/per-file-after/A.v new file mode 100644 index 0000000000..851e2b9738 --- /dev/null +++ b/test-suite/coq-makefile/timing/per-file-after/A.v @@ -0,0 +1,4 @@ +Require Coq.ZArith.BinInt. +Declare Reduction comp := native_compute. +Definition foo0 := Eval comp in (Coq.ZArith.BinInt.Z.div_eucl, Coq.ZArith.BinInt.Z.div_eucl). +Definition foo1 := Eval comp in (foo0, foo0). diff --git a/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired new file mode 100644 index 0000000000..18f0f34b28 --- /dev/null +++ b/test-suite/coq-makefile/timing/per-file-after/A.v.timing.diff.desired @@ -0,0 +1,9 @@ +After | Code | Before || Change | % Change +--------------------------------------------------------------------------------------------------- +0m00.50s | Total | 0m04.17s || -0m03.66s | -87.96% +--------------------------------------------------------------------------------------------------- +0m00.145s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.192s || -0m00.04s | -24.47% +0m00.126s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.143s || -0m00.01s | -11.88% + N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | 0m00.s || +0m00.00s | N/A +0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | N/A || +0m00.00s | N/A +0m00.231s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m03.836s || -0m03.60s | -93.97%
\ No newline at end of file diff --git a/test-suite/coq-makefile/timing/per-file-after/_CoqProject b/test-suite/coq-makefile/timing/per-file-after/_CoqProject new file mode 100644 index 0000000000..790e057133 --- /dev/null +++ b/test-suite/coq-makefile/timing/per-file-after/_CoqProject @@ -0,0 +1 @@ +A.v diff --git a/test-suite/coq-makefile/timing/per-file-before/A.v b/test-suite/coq-makefile/timing/per-file-before/A.v new file mode 100644 index 0000000000..115c1f95bd --- /dev/null +++ b/test-suite/coq-makefile/timing/per-file-before/A.v @@ -0,0 +1,4 @@ +Require Coq.ZArith.BinInt. +Declare Reduction comp := vm_compute. +Definition foo0 := Eval comp in (Coq.ZArith.BinInt.Z.div_eucl, Coq.ZArith.BinInt.Z.div_eucl). +Definition foo1 := Eval comp in (foo0, foo0). diff --git a/test-suite/coq-makefile/timing/per-file-before/_CoqProject b/test-suite/coq-makefile/timing/per-file-before/_CoqProject new file mode 100644 index 0000000000..790e057133 --- /dev/null +++ b/test-suite/coq-makefile/timing/per-file-before/_CoqProject @@ -0,0 +1 @@ +A.v diff --git a/test-suite/coq-makefile/timing/run.sh b/test-suite/coq-makefile/timing/run.sh new file mode 100755 index 0000000000..9786af10a8 --- /dev/null +++ b/test-suite/coq-makefile/timing/run.sh @@ -0,0 +1,68 @@ +#!/usr/bin/env bash + +#set -x +set -e + +. ../template/init.sh + +cd error +coq_makefile -f _CoqProject -o Makefile +make cleanall +if make pretty-timed TGTS="all" -j1; then + echo "Error: make pretty-timed should have failed" + exit 1 +fi + +cd ../aggregate +coq_makefile -f _CoqProject -o Makefile +make cleanall +make pretty-timed TGTS="all" -j1 || exit $? + +cd ../before +coq_makefile -f _CoqProject -o Makefile +make cleanall +make make-pretty-timed-before TGTS="all" -j1 || exit $? + +cd ../after +coq_makefile -f _CoqProject -o Makefile +make cleanall +make make-pretty-timed-after TGTS="all" -j1 || exit $? +rm -f time-of-build-before.log +make print-pretty-timed-diff TIME_OF_BUILD_BEFORE_FILE=../before/time-of-build-before.log +cp ../before/time-of-build-before.log ./ +make print-pretty-timed-diff || exit $? + +for ext in "" .desired; do + for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do + cat ${file}${ext} | grep -v 'warning: undefined variable' | sed s'/[0-9]//g' | sed s'/ *$//g' | sed s'/^-*$/------/g' | sed s'/ */ /g' | sed s'/\(Total.*\)-\(.*\)-/\1+\2+/g' > ${file}${ext}.processed + done +done +for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do + diff -u $file.desired.processed $file.processed || exit $? +done + +cd ../per-file-before +coq_makefile -f _CoqProject -o Makefile +make cleanall +make all TIMING=before -j2 || exit $? + +cd ../per-file-after +coq_makefile -f _CoqProject -o Makefile +make cleanall +make all TIMING=after -j2 || exit $? + +find ../per-file-before/ -name "*.before-timing" -exec 'cp' '{}' './' ';' +make all.timing.diff -j2 || exit $? +cat A.v.timing.diff +echo + +for ext in "" .desired; do + for file in A.v.timing.diff; do + cat ${file}${ext} | sed s'/[0-9]*\.[0-9]*//g' | sed s'/0//g' | sed s'/ */ /g' | sed s'/+/-/g' | sort > ${file}${ext}.processed + done +done +for file in A.v.timing.diff; do + diff -u $file.desired.processed $file.processed || exit $? +done + +exit 0 diff --git a/test-suite/coq-makefile/uninstall1/run.sh b/test-suite/coq-makefile/uninstall1/run.sh index e525e12086..5354f794f7 100755 --- a/test-suite/coq-makefile/uninstall1/run.sh +++ b/test-suite/coq-makefile/uninstall1/run.sh @@ -1,11 +1,9 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" @@ -13,7 +11,7 @@ make install-doc DSTROOT="$PWD/tmp" make uninstall DSTROOT="$PWD/tmp" make uninstall-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired <<EOT . EOT diff --git a/test-suite/coq-makefile/uninstall2/run.sh b/test-suite/coq-makefile/uninstall2/run.sh index e525e12086..5354f794f7 100755 --- a/test-suite/coq-makefile/uninstall2/run.sh +++ b/test-suite/coq-makefile/uninstall2/run.sh @@ -1,11 +1,9 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make make html mlihtml make install DSTROOT="$PWD/tmp" @@ -13,7 +11,7 @@ make install-doc DSTROOT="$PWD/tmp" make uninstall DSTROOT="$PWD/tmp" make uninstall-doc DSTROOT="$PWD/tmp" #make debug -(for d in `find tmp -name user-contrib`; do pushd $d >/dev/null; find .; popd >/dev/null; done) | sort -u > actual +(for d in `find tmp -name user-contrib` ; do pushd $d >/dev/null && find . && popd >/dev/null; done) | sort -u > actual sort -u > desired <<EOT . EOT diff --git a/test-suite/coq-makefile/validate1/run.sh b/test-suite/coq-makefile/validate1/run.sh index aaa4194b38..43bf39de10 100755 --- a/test-suite/coq-makefile/validate1/run.sh +++ b/test-suite/coq-makefile/validate1/run.sh @@ -1,10 +1,8 @@ #!/usr/bin/env bash -#set -x -set -e - . ../template/init.sh coq_makefile -f _CoqProject -o Makefile +cat Makefile.conf make exec make validate diff --git a/test-suite/coqchk/cumulativity.v b/test-suite/coqchk/cumulativity.v index a978f6b901..7906a5b15e 100644 --- a/test-suite/coqchk/cumulativity.v +++ b/test-suite/coqchk/cumulativity.v @@ -1,5 +1,5 @@ Set Universe Polymorphism. -Set Inductive Cumulativity. +Set Polymorphic Inductive Cumulativity. Set Printing Universes. Inductive List (A: Type) := nil | cons : A -> List A -> List A. diff --git a/test-suite/coqdoc/bug5648.html.out b/test-suite/coqdoc/bug5648.html.out new file mode 100644 index 0000000000..06789c1c10 --- /dev/null +++ b/test-suite/coqdoc/bug5648.html.out @@ -0,0 +1,53 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" +"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> +<link href="coqdoc.css" rel="stylesheet" type="text/css" /> +<title>Coqdoc.bug5648</title> +</head> + +<body> + +<div id="page"> + +<div id="header"> +</div> + +<div id="main"> + +<h1 class="libtitle">Library Coqdoc.bug5648</h1> + +<div class="code"> +<span class="id" title="keyword">Lemma</span> <a name="a"><span class="id" title="lemma">a</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a>.<br/> +<span class="id" title="keyword">Proof</span>.<br/> +<span class="id" title="tactic">auto</span>.<br/> +<span class="id" title="keyword">Qed</span>.<br/> + +<br/> +<span class="id" title="keyword">Variant</span> <a name="t"><span class="id" title="inductive">t</span></a> :=<br/> +| <a name="A"><span class="id" title="constructor">A</span></a> | <a name="Add"><span class="id" title="constructor">Add</span></a> | <a name="G"><span class="id" title="constructor">G</span></a> | <a name="Goal"><span class="id" title="constructor">Goal</span></a> | <a name="L"><span class="id" title="constructor">L</span></a> | <a name="Lemma"><span class="id" title="constructor">Lemma</span></a> | <a name="P"><span class="id" title="constructor">P</span></a> | <a name="Proof"><span class="id" title="constructor">Proof</span></a> .<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> <span class="id" title="var">x</span> :=<br/> + <span class="id" title="keyword">match</span> <a class="idref" href="Coqdoc.bug5648.html#x"><span class="id" title="variable">x</span></a> <span class="id" title="keyword">with</span><br/> + | <a class="idref" href="Coqdoc.bug5648.html#A"><span class="id" title="constructor">A</span></a> => 0<br/> + | <a class="idref" href="Coqdoc.bug5648.html#Add"><span class="id" title="constructor">Add</span></a> => 1<br/> + | <a class="idref" href="Coqdoc.bug5648.html#G"><span class="id" title="constructor">G</span></a> => 2<br/> + | <a class="idref" href="Coqdoc.bug5648.html#Goal"><span class="id" title="constructor">Goal</span></a> => 3<br/> + | <a class="idref" href="Coqdoc.bug5648.html#L"><span class="id" title="constructor">L</span></a> => 4<br/> + | <a class="idref" href="Coqdoc.bug5648.html#Lemma"><span class="id" title="constructor">Lemma</span></a> => 5<br/> + | <a class="idref" href="Coqdoc.bug5648.html#P"><span class="id" title="constructor">P</span></a> => 6<br/> + | <a class="idref" href="Coqdoc.bug5648.html#Proof"><span class="id" title="constructor">Proof</span></a> => 7<br/> + <span class="id" title="keyword">end</span>.<br/> +</div> +</div> + +<div id="footer"> +<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://coq.inria.fr/">coqdoc</a> +</div> + +</div> + +</body> +</html>
\ No newline at end of file diff --git a/test-suite/coqdoc/bug5648.tex.out b/test-suite/coqdoc/bug5648.tex.out new file mode 100644 index 0000000000..b0b732effa --- /dev/null +++ b/test-suite/coqdoc/bug5648.tex.out @@ -0,0 +1,49 @@ +\documentclass[12pt]{report} +\usepackage[]{inputenc} +\usepackage[T1]{fontenc} +\usepackage{fullpage} +\usepackage{coqdoc} +\usepackage{amsmath,amssymb} +\usepackage{url} +\begin{document} +\coqlibrary{Coqdoc.bug5648}{Library }{Coqdoc.bug5648} + +\begin{coqdoccode} +\coqdocnoindent +\coqdockw{Lemma} \coqdef{Coqdoc.bug5648.a}{a}{\coqdoclemma{a}} : \coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}.\coqdoceol +\coqdocnoindent +\coqdockw{Proof}.\coqdoceol +\coqdocnoindent +\coqdoctac{auto}.\coqdoceol +\coqdocnoindent +\coqdockw{Qed}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Variant} \coqdef{Coqdoc.bug5648.t}{t}{\coqdocinductive{t}} :=\coqdoceol +\coqdocnoindent +\ensuremath{|} \coqdef{Coqdoc.bug5648.A}{A}{\coqdocconstructor{A}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Add}{Add}{\coqdocconstructor{Add}} \ensuremath{|} \coqdef{Coqdoc.bug5648.G}{G}{\coqdocconstructor{G}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Goal}{Goal}{\coqdocconstructor{Goal}} \ensuremath{|} \coqdef{Coqdoc.bug5648.L}{L}{\coqdocconstructor{L}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Lemma}{Lemma}{\coqdocconstructor{Lemma}} \ensuremath{|} \coqdef{Coqdoc.bug5648.P}{P}{\coqdocconstructor{P}} \ensuremath{|} \coqdef{Coqdoc.bug5648.Proof}{Proof}{\coqdocconstructor{Proof}} .\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.bug5648.d}{d}{\coqdocdefinition{d}} \coqdocvar{x} :=\coqdoceol +\coqdocindent{1.00em} +\coqdockw{match} \coqdocvariable{x} \coqdockw{with}\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.A}{\coqdocconstructor{A}} \ensuremath{\Rightarrow} 0\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.Add}{\coqdocconstructor{Add}} \ensuremath{\Rightarrow} 1\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.G}{\coqdocconstructor{G}} \ensuremath{\Rightarrow} 2\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.Goal}{\coqdocconstructor{Goal}} \ensuremath{\Rightarrow} 3\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.L}{\coqdocconstructor{L}} \ensuremath{\Rightarrow} 4\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.Lemma}{\coqdocconstructor{Lemma}} \ensuremath{\Rightarrow} 5\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.P}{\coqdocconstructor{P}} \ensuremath{\Rightarrow} 6\coqdoceol +\coqdocindent{1.00em} +\ensuremath{|} \coqref{Coqdoc.bug5648.Proof}{\coqdocconstructor{Proof}} \ensuremath{\Rightarrow} 7\coqdoceol +\coqdocindent{1.00em} +\coqdockw{end}.\coqdoceol +\end{coqdoccode} +\end{document} diff --git a/test-suite/coqdoc/bug5648.v b/test-suite/coqdoc/bug5648.v new file mode 100644 index 0000000000..9b62dd1e1e --- /dev/null +++ b/test-suite/coqdoc/bug5648.v @@ -0,0 +1,19 @@ +Lemma a : True. +Proof. +auto. +Qed. + +Variant t := +| A | Add | G | Goal | L | Lemma | P | Proof . + +Definition d x := + match x with + | A => 0 + | Add => 1 + | G => 2 + | Goal => 3 + | L => 4 + | Lemma => 5 + | P => 6 + | Proof => 7 + end. diff --git a/test-suite/coqdoc/links.html.out b/test-suite/coqdoc/links.html.out new file mode 100644 index 0000000000..7d7d01c1b4 --- /dev/null +++ b/test-suite/coqdoc/links.html.out @@ -0,0 +1,206 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" +"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml"> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> +<link href="coqdoc.css" rel="stylesheet" type="text/css" /> +<title>Coqdoc.links</title> +</head> + +<body> + +<div id="page"> + +<div id="header"> +</div> + +<div id="main"> + +<h1 class="libtitle">Library Coqdoc.links</h1> + +<div class="code"> +</div> + +<div class="doc"> +Various checks for coqdoc + +<div class="paragraph"> </div> + +<ul class="doclist"> +<li> symbols should not be inlined in string g + +</li> +<li> links to both kinds of notations in a' should work to the right notation + +</li> +<li> with utf8 option, forall must be unicode + +</li> +<li> splitting between symbols and ident should be correct in a' and c + +</li> +<li> ".." should be rendered correctly + +</li> +</ul> + +</div> +<div class="code"> + +<br/> +<span class="id" title="keyword">Require</span> <span class="id" title="keyword">Import</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Strings.String.html#"><span class="id" title="library">String</span></a>.<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="g"><span class="id" title="definition">g</span></a> := "dfjkh""sdfhj forall <> * ~"%<span class="id" title="var">string</span>.<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="a"><span class="id" title="definition">a</span></a> (<span class="id" title="var">b</span>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>) := <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">forall</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">"</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#mult"><span class="id" title="abbreviation">mult</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>). +<br/> +<span class="id" title="keyword">Notation</span> <a name="6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">"</span></a>n ** m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">"</span></a>n ▵ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 60).<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">"</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/> + +<br/> +<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#d43e996736952df71ebeeae74d10a287"><span class="id" title="notation">-></span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/> +<br/> +<span class="id" title="keyword">where</span> <a name="8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">"</span></a>x = y :> A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="variable">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:></span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">"</span></a>( x # y ; .. ; z )" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> .. (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#pair"><span class="id" title="constructor">pair</span></a> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) .. <span class="id" title="var">z</span>).<br/> + +<br/> +<span class="id" title="keyword">Definition</span> <a name="9f5a1d89cbd4d38f5e289576db7123d1"><span class="id" title="definition">b_α</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a><a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">(</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">#</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">;</span></a>0<a class="idref" href="Coqdoc.links.html#548d1059c499c9b2a9b95b07e68c2090"><span class="id" title="notation">)</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">,</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">(</span></a>0 <a class="idref" href="Coqdoc.links.html#6b97e27793a3d22f5c0d1dd63170fd68"><span class="id" title="notation">**</span></a> 0<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#44400027531d4bc3f586a1997dc874c0"><span class="id" title="notation">))</span></a>.<br/> + +<br/> +<span class="id" title="keyword">Notation</span> <a name="h"><span class="id" title="abbreviation">h</span></a> := <a class="idref" href="Coqdoc.links.html#a"><span class="id" title="definition">a</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Section</span> <a name="test"><span class="id" title="section">test</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Variables</span> <a name="test.b'"><span class="id" title="variable">b'</span></a> <a name="test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Notation</span> <a name="4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">"</span></a>n + m" := (<span class="id" title="var">n</span> <a class="idref" href="Coqdoc.links.html#3e01fbae4590c7b7699ff99ce61580e1"><span class="id" title="notation">▵</span></a> <span class="id" title="var">m</span>) : <span class="id" title="var">my_scope</span>.<br/> + +<br/> + <span class="id" title="keyword">Delimit</span> <span class="id" title="keyword">Scope</span> <span class="id" title="var">my_scope</span> <span class="id" title="keyword">with</span> <span class="id" title="var">my</span>.<br/> + +<br/> + <span class="id" title="keyword">Notation</span> <a name="l"><span class="id" title="abbreviation">l</span></a> := 0.<br/> + +<br/> + <span class="id" title="keyword">Definition</span> <a name="ab410a966ac148e9b78c65c6cdf301fd"><span class="id" title="definition">α</span></a> := (0 <a class="idref" href="Coqdoc.links.html#4ab0449b36c75cf94e08c5822ea83e3d"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#l"><span class="id" title="abbreviation">l</span></a>)%<span class="id" title="var">my</span>.<br/> + +<br/> + <span class="id" title="keyword">Definition</span> <a name="a'"><span class="id" title="definition">a'</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test.b'"><span class="id" title="variable">b'</span></a><a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a>0<a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a><a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Definition</span> <a name="c"><span class="id" title="definition">c</span></a> := <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}+{</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#True"><span class="id" title="inductive">True</span></a><a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Specif.html#5bf2050e90b21ebc82dc5463d1ba338e"><span class="id" title="notation">}</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> := (1<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a>2)%<span class="id" title="var">nat</span>.<br/> + +<br/> + <span class="id" title="keyword">Lemma</span> <a name="e"><span class="id" title="lemma">e</span></a> : <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#3dcaec3b772747610227247939f96b01"><span class="id" title="notation">+</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + <span class="id" title="var">Admitted</span>.<br/> + +<br/> + <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test"><span class="id" title="section">test</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Section</span> <a name="test2"><span class="id" title="section">test2</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Variables</span> <a name="test2.b'"><span class="id" title="variable">b'</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Section</span> <a name="test2.test"><span class="id" title="section">test</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Variables</span> <a name="test2.test.b2"><span class="id" title="variable">b2</span></a>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/> + +<br/> + <span class="id" title="keyword">Definition</span> <a name="a''"><span class="id" title="definition">a''</span></a> <span class="id" title="var">b</span> := <a class="idref" href="Coqdoc.links.html#test2.b'"><span class="id" title="variable">b'</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#O"><span class="id" title="constructor">O</span></a> <a class="idref" href="Coqdoc.links.html#1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#test2.test.b2"><span class="id" title="variable">b2</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">_</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">++</span></a> <a class="idref" href="Coqdoc.links.html#347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">x</span></a> <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#b3eea360671e1b32b18a26e15b3aace3"><span class="id" title="notation">+</span></a> <a class="idref" href="Coqdoc.links.html#h"><span class="id" title="abbreviation">h</span></a> 0.<br/> + +<br/> + <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2.test"><span class="id" title="section">test</span></a>.<br/> + +<br/> + <span class="id" title="keyword">End</span> <a class="idref" href="Coqdoc.links.html#test2"><span class="id" title="section">test2</span></a>.<br/> + +<br/> +</div> + +<div class="doc"> +skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +<div class="paragraph"> </div> + + skip +</div> +<div class="code"> + +<br/> +</div> +</div> + +<div id="footer"> +<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://coq.inria.fr/">coqdoc</a> +</div> + +</div> + +</body> +</html>
\ No newline at end of file diff --git a/test-suite/coqdoc/links.tex.out b/test-suite/coqdoc/links.tex.out new file mode 100644 index 0000000000..844fb3031c --- /dev/null +++ b/test-suite/coqdoc/links.tex.out @@ -0,0 +1,162 @@ +\documentclass[12pt]{report} +\usepackage[]{inputenc} +\usepackage[T1]{fontenc} +\usepackage{fullpage} +\usepackage{coqdoc} +\usepackage{amsmath,amssymb} +\usepackage{url} +\begin{document} +\coqlibrary{Coqdoc.links}{Library }{Coqdoc.links} + +\begin{coqdoccode} +\end{coqdoccode} +Various checks for coqdoc + + + +\begin{itemize} +\item symbols should not be inlined in string g + +\item links to both kinds of notations in a' should work to the right notation + +\item with utf8 option, forall must be unicode + +\item splitting between symbols and ident should be correct in a' and c + +\item ``..'' should be rendered correctly + +\end{itemize} +\begin{coqdoccode} +\coqdocemptyline +\coqdocnoindent +\coqdockw{Require} \coqdockw{Import} \coqexternalref{}{http://coq.inria.fr/stdlib/Coq.Strings.String}{\coqdoclibrary{String}}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.links.g}{g}{\coqdocdefinition{g}} := "dfjkh""sdfhj forall <> * \~{}"\%\coqdocvar{string}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.links.a}{a}{\coqdocdefinition{a}} (\coqdocvar{b}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}) := \coqdocvariable{b}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.links.f}{f}{\coqdocdefinition{f}} := \coqdockw{\ensuremath{\forall}} \coqdocvar{C}:\coqdockw{Prop}, \coqdocvariable{C}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}).\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::x '++' x}{"}{"}n ++ m" := (\coqexternalref{mult}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{mult}} \coqdocvar{n} \coqdocvar{m}). \coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::x '**' x}{"}{"}n ** m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::x 'xE2x96xB5' x}{"}{"}n ▵ m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 60).\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::x ''' ''' '++' 'x' x}{"}{"}n '\_' ++ 'x' m" := (\coqexternalref{plus}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocabbreviation{plus}} \coqdocvar{n} \coqdocvar{m}) (\coqdoctac{at} \coqdockw{level} 3).\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Inductive} \coqdef{Coqdoc.links.eq}{eq}{\coqdocinductive{eq}} (\coqdocvar{A}:\coqdockw{Type}) (\coqdocvar{x}:\coqdocvariable{A}) : \coqdocvar{A} \coqexternalref{:type scope:x '->' x}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocnotation{\ensuremath{\rightarrow}}} \coqdockw{Prop} := \coqdef{Coqdoc.links.eq refl}{eq\_refl}{\coqdocconstructor{eq\_refl}} : \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} \coqdocvariable{x} \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}}\coqdocvariable{A}\coqdoceol +\coqdocnoindent +\coqdoceol +\coqdocnoindent +\coqdockw{where} \coqdef{Coqdoc.links.:type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqdocvariable{eq} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{"}{"}( x \# y ; .. ; z )" := (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} .. (\coqexternalref{pair}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{pair}} \coqdocvar{x} \coqdocvar{y}) .. \coqdocvar{z}).\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Definition} \coqdef{Coqdoc.links.b xCExB1}{b\_α}{\coqdocdefinition{b\_α}} := \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{(}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{\#}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{;}}0\coqref{Coqdoc.links.::'(' x 'x23' x ';' '..' ';' x ')'}{\coqdocnotation{)}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{,}} \coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{(}}0 \coqref{Coqdoc.links.::x '**' x}{\coqdocnotation{**}} 0\coqexternalref{:core scope:'(' x ',' x ',' '..' ',' x ')'}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{))}}.\coqdoceol +\coqdocemptyline +\coqdocnoindent +\coqdockw{Notation} \coqdef{Coqdoc.links.h}{h}{\coqdocabbreviation{h}} := \coqref{Coqdoc.links.a}{\coqdocdefinition{a}}.\coqdoceol +\coqdocemptyline +\coqdocindent{1.00em} +\coqdockw{Section} \coqdef{Coqdoc.links.test}{test}{\coqdocsection{test}}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Variables} \coqdef{Coqdoc.links.test.b'}{b'}{\coqdocvariable{b'}} \coqdef{Coqdoc.links.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Notation} \coqdef{Coqdoc.links.test.:my scope:x '+' x}{"}{"}n + m" := (\coqdocvar{n} \coqref{Coqdoc.links.::x 'xE2x96xB5' x}{\coqdocnotation{▵}} \coqdocvar{m}) : \coqdocvar{my\_scope}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Delimit} \coqdockw{Scope} \coqdocvar{my\_scope} \coqdockw{with} \coqdocvar{my}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Notation} \coqdef{Coqdoc.links.l}{l}{\coqdocabbreviation{l}} := 0.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Definition} \coqdef{Coqdoc.links.xCExB1}{α}{\coqdocdefinition{α}} := (0 \coqref{Coqdoc.links.test.:my scope:x '+' x}{\coqdocnotation{+}} \coqref{Coqdoc.links.l}{\coqdocabbreviation{l}})\%\coqdocvar{my}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Definition} \coqdef{Coqdoc.links.a'}{a'}{\coqdocdefinition{a'}} \coqdocvar{b} := \coqdocvariable{b'}\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}0\coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}}\coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}}\coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Definition} \coqdef{Coqdoc.links.c}{c}{\coqdocdefinition{c}} := \coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}+\{}}\coqexternalref{True}{http://coq.inria.fr/stdlib/Coq.Init.Logic}{\coqdocinductive{True}}\coqexternalref{:type scope:'x7B' x 'x7D' '+' 'x7B' x 'x7D'}{http://coq.inria.fr/stdlib/Coq.Init.Specif}{\coqdocnotation{\}}}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Definition} \coqdef{Coqdoc.links.d}{d}{\coqdocdefinition{d}} := (1\coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}}2)\%\coqdocvar{nat}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Lemma} \coqdef{Coqdoc.links.e}{e}{\coqdoclemma{e}} : \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}} \coqexternalref{:type scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocnotation{+}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdocindent{2.00em} +\coqdocvar{Admitted}.\coqdoceol +\coqdocemptyline +\coqdocindent{1.00em} +\coqdockw{End} \coqref{Coqdoc.links.test}{\coqdocsection{test}}.\coqdoceol +\coqdocemptyline +\coqdocindent{1.00em} +\coqdockw{Section} \coqdef{Coqdoc.links.test2}{test2}{\coqdocsection{test2}}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Variables} \coqdef{Coqdoc.links.test2.b'}{b'}{\coqdocvariable{b'}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{Section} \coqdef{Coqdoc.links.test2.test}{test}{\coqdocsection{test}}.\coqdoceol +\coqdocemptyline +\coqdocindent{3.00em} +\coqdockw{Variables} \coqdef{Coqdoc.links.test2.test.b2}{b2}{\coqdocvariable{b2}}: \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol +\coqdocemptyline +\coqdocindent{3.00em} +\coqdockw{Definition} \coqdef{Coqdoc.links.a''}{a'{}'}{\coqdocdefinition{a'{}'}} \coqdocvar{b} := \coqdocvariable{b'} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqexternalref{O}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocconstructor{O}} \coqref{Coqdoc.links.::x '++' x}{\coqdocnotation{++}} \coqdocvariable{b2} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{\_}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{++}} \coqref{Coqdoc.links.::x ''' ''' '++' 'x' x}{\coqdocnotation{x}} \coqdocvariable{b} \coqexternalref{:nat scope:x '+' x}{http://coq.inria.fr/stdlib/Coq.Init.Peano}{\coqdocnotation{+}} \coqref{Coqdoc.links.h}{\coqdocabbreviation{h}} 0.\coqdoceol +\coqdocemptyline +\coqdocindent{2.00em} +\coqdockw{End} \coqref{Coqdoc.links.test2.test}{\coqdocsection{test}}.\coqdoceol +\coqdocemptyline +\coqdocindent{1.00em} +\coqdockw{End} \coqref{Coqdoc.links.test2}{\coqdocsection{test2}}.\coqdoceol +\coqdocemptyline +\end{coqdoccode} +skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip + + skip \begin{coqdoccode} +\coqdocemptyline +\end{coqdoccode} +\end{document} diff --git a/test-suite/failure/Tauto.v b/test-suite/failure/Tauto.v index d91d159d9c..19976b41bd 100644 --- a/test-suite/failure/Tauto.v +++ b/test-suite/failure/Tauto.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/clash_cons.v b/test-suite/failure/clash_cons.v index b3fbff680b..1761cc437d 100644 --- a/test-suite/failure/clash_cons.v +++ b/test-suite/failure/clash_cons.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/fixpoint1.v b/test-suite/failure/fixpoint1.v index c2b521c214..0739982442 100644 --- a/test-suite/failure/fixpoint1.v +++ b/test-suite/failure/fixpoint1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/guard.v b/test-suite/failure/guard.v index 8db2785837..312dc48bea 100644 --- a/test-suite/failure/guard.v +++ b/test-suite/failure/guard.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/illtype1.v b/test-suite/failure/illtype1.v index 8ed3af1ce4..fdd1bddd88 100644 --- a/test-suite/failure/illtype1.v +++ b/test-suite/failure/illtype1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/positivity.v b/test-suite/failure/positivity.v index 8089de2bf0..b21204b9e4 100644 --- a/test-suite/failure/positivity.v +++ b/test-suite/failure/positivity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/redef.v b/test-suite/failure/redef.v index c8dc6303f7..c49dbd7cae 100644 --- a/test-suite/failure/redef.v +++ b/test-suite/failure/redef.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/failure/search.v b/test-suite/failure/search.v index 648ab0820c..fae6cd6f3b 100644 --- a/test-suite/failure/search.v +++ b/test-suite/failure/search.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/ideal-features/Apply.v b/test-suite/ideal-features/Apply.v index c8e9af216e..85680e94b9 100644 --- a/test-suite/ideal-features/Apply.v +++ b/test-suite/ideal-features/Apply.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/misc/deps-checksum.sh b/test-suite/misc/deps-checksum.sh index 1e2afb7540..e07612b84c 100755 --- a/test-suite/misc/deps-checksum.sh +++ b/test-suite/misc/deps-checksum.sh @@ -1,4 +1,4 @@ -rm -f misc/deps/*/*.vo +rm -f misc/deps/A/*.vo misc/deps/B/*.vo $coqc -R misc/deps/A A misc/deps/A/A.v $coqc -R misc/deps/B A misc/deps/B/A.v $coqc -R misc/deps/B A misc/deps/B/B.v diff --git a/test-suite/misc/deps-order.sh b/test-suite/misc/deps-order.sh index 375b706f0a..299f494693 100755 --- a/test-suite/misc/deps-order.sh +++ b/test-suite/misc/deps-order.sh @@ -1,10 +1,10 @@ # Check that both coqdep and coqtop/coqc supports -R # Check that both coqdep and coqtop/coqc takes the later -R # See bugs 2242, 2337, 2339 -rm -f misc/deps/*/*.vo +rm -f misc/deps/lib/*.vo misc/deps/client/*.vo tmpoutput=`mktemp /tmp/coqcheck.XXXXXX` $coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > $tmpoutput -diff -u misc/deps/deps.out $tmpoutput 2>&1 +diff -u --strip-trailing-cr misc/deps/deps.out $tmpoutput 2>&1 R=$? times $coqc -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1 diff --git a/test-suite/modules/polymorphism.v b/test-suite/modules/polymorphism.v new file mode 100644 index 0000000000..63eaa382dc --- /dev/null +++ b/test-suite/modules/polymorphism.v @@ -0,0 +1,81 @@ +Set Universe Polymorphism. + +(** Tests for module subtyping of polymorphic terms *) + +Module Type S. + +Section Foo. + +Universes i j. +Constraint i <= j. + +Parameter foo : Type@{i} -> Type@{j}. + +End Foo. + +End S. + +(** Same constraints *) + +Module OK_1. + +Definition foo@{i j} (A : Type@{i}) : Type@{j} := A. + +End OK_1. + +Module OK_1_Test : S := OK_1. + +(** More general constraints *) + +Module OK_2. + +Inductive X@{i} : Type@{i} :=. +Definition foo@{i j} (A : Type@{i}) : Type@{j} := X@{j}. + +End OK_2. + +Module OK_2_Test : S := OK_2. + +(** Wrong instance length *) + +Module KO_1. + +Definition foo@{i} (A : Type@{i}) : Type@{i} := A. + +End KO_1. + +Fail Module KO_Test_1 : S := KO_1. + +(** Less general constraints *) + +Module KO_2. + +Section Foo. + +Universe i j. +Constraint i < j. + +Definition foo (A : Type@{i}) : Type@{j} := A. + +End Foo. + +End KO_2. + +Fail Module KO_Test_2 : S := KO_2. + +(** Less general constraints *) + +Module KO_3. + +Section Foo. + +Universe i j. +Constraint i = j. + +Definition foo (A : Type@{i}) : Type@{j} := A. + +End Foo. + +End KO_3. + +Fail Module KO_Test_3 : S := KO_3. diff --git a/test-suite/modules/polymorphism2.v b/test-suite/modules/polymorphism2.v new file mode 100644 index 0000000000..7e3327eee0 --- /dev/null +++ b/test-suite/modules/polymorphism2.v @@ -0,0 +1,87 @@ +Set Universe Polymorphism. + +(** Tests for module subtyping of polymorphic terms *) + +Module Type S. + +Section Foo. + +Universes i j. +Constraint i <= j. + +Inductive foo : Type@{i} -> Type@{j} :=. + +End Foo. + +End S. + +(** Same constraints *) + +Module OK_1. + +Section Foo. + +Universes i j. +Constraint i <= j. + +Inductive foo : Type@{i} -> Type@{j} :=. + +End Foo. + +End OK_1. + +Module OK_1_Test : S := OK_1. + +(** More general constraints *) + +Module OK_2. + +Inductive foo@{i j} : Type@{i} -> Type@{j} :=. + +End OK_2. + +Module OK_2_Test : S := OK_2. + +(** Wrong instance length *) + +Module KO_1. + +Inductive foo@{i} : Type@{i} -> Type@{i} :=. + +End KO_1. + +Fail Module KO_Test_1 : S := KO_1. + +(** Less general constraints *) + +Module KO_2. + +Section Foo. + +Universe i j. +Constraint i < j. + +Inductive foo : Type@{i} -> Type@{j} :=. + +End Foo. + +End KO_2. + +Fail Module KO_Test_2 : S := KO_2. + +(** Less general constraints *) + +Module KO_3. + +Section Foo. + +Universe i j. +Constraint i = j. + +Inductive foo : Type@{i} -> Type@{j} :=. + +End Foo. + +End KO_3. + +Fail Module KO_Test_3 : S := KO_3. diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v index 2ccca829d6..b9985a594f 100644 --- a/test-suite/output/Notations.v +++ b/test-suite/output/Notations.v @@ -1,3 +1,14 @@ +(* Bug 5568, don't warn for notations in repeated module import *) + +Module foo. +Notation compose := (fun g f => g f). +Notation "g & f" := (compose g f) (at level 10). +End foo. + +Import foo. +Import foo. +Import foo. + (**********************************************************************) (* Notations for if and let (submitted by Roland Zumkeller) *) diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out index ffea0819a5..a9ae74fd67 100644 --- a/test-suite/output/Notations3.out +++ b/test-suite/output/Notations3.out @@ -109,3 +109,9 @@ fun x : ?A => x === x : forall x : ?A, x = x where ?A : [x : ?A |- Type] (x cannot be used) +{0, 1} + : nat * nat +{0, 1, 2} + : nat * (nat * nat) +{0, 1, 2, 3} + : nat * (nat * (nat * nat)) diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v index 250aecafd4..dee0f70f79 100644 --- a/test-suite/output/Notations3.v +++ b/test-suite/output/Notations3.v @@ -160,3 +160,11 @@ End Bug4765. Notation "x === x" := (eq_refl x) (only printing, at level 10). Check (fun x => eq_refl x). + +(**********************************************************************) +(* Test recursive notations with the recursive pattern repeated on the right *) + +Notation "{ x , .. , y , z }" := (pair x .. (pair y z) ..). +Check {0,1}. +Check {0,1,2}. +Check {0,1,2,3}. diff --git a/test-suite/output/RecognizePluginWarning.out b/test-suite/output/RecognizePluginWarning.out new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/test-suite/output/RecognizePluginWarning.out diff --git a/test-suite/output/RecognizePluginWarning.v b/test-suite/output/RecognizePluginWarning.v new file mode 100644 index 0000000000..cd667bbd00 --- /dev/null +++ b/test-suite/output/RecognizePluginWarning.v @@ -0,0 +1,5 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "extraction-logical-axiom") -*- *) + +(* Test that mentioning a warning defined in plugins works. The failure +mode here is that these result in a warning about unknown warnings, since the +plugins are not known at command line parsing time. *) diff --git a/test-suite/output/TypeclassDebug.out b/test-suite/output/TypeclassDebug.out new file mode 100644 index 0000000000..8b38fe0ff4 --- /dev/null +++ b/test-suite/output/TypeclassDebug.out @@ -0,0 +1,18 @@ +Debug: 1: looking for foo without backtracking +Debug: 1.1: simple apply H on foo, 1 subgoal(s) +Debug: 1.1-1 : foo +Debug: 1.1-1: looking for foo without backtracking +Debug: 1.1-1.1: simple apply H on foo, 1 subgoal(s) +Debug: 1.1-1.1-1 : foo +Debug: 1.1-1.1-1: looking for foo without backtracking +Debug: 1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) +Debug: 1.1-1.1-1.1-1 : foo +Debug: 1.1-1.1-1.1-1: looking for foo without backtracking +Debug: 1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) +Debug: 1.1-1.1-1.1-1.1-1 : foo +Debug: 1.1-1.1-1.1-1.1-1: looking for foo without backtracking +Debug: 1.1-1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) +Debug: 1.1-1.1-1.1-1.1-1.1-1 : foo +The command has indeed failed with message: +Ltac call to "typeclasses eauto (int_or_var_opt) with (ne_preident_list)" failed. +Tactic failure: Proof search reached its limit. diff --git a/test-suite/output/TypeclassDebug.v b/test-suite/output/TypeclassDebug.v new file mode 100644 index 0000000000..d38e2a50e4 --- /dev/null +++ b/test-suite/output/TypeclassDebug.v @@ -0,0 +1,8 @@ +(* show alternating separators in typeclass debug output; see discussion in PR #868 *) + +Parameter foo : Prop. +Axiom H : foo -> foo. +Hint Resolve H : foo. +Goal foo. +Typeclasses eauto := debug. +Fail typeclasses eauto 5 with foo. diff --git a/test-suite/output/UsePluginWarning.out b/test-suite/output/UsePluginWarning.out new file mode 100644 index 0000000000..47409f3ec5 --- /dev/null +++ b/test-suite/output/UsePluginWarning.out @@ -0,0 +1 @@ +type foo = __ diff --git a/test-suite/output/UsePluginWarning.v b/test-suite/output/UsePluginWarning.v new file mode 100644 index 0000000000..c6e0054641 --- /dev/null +++ b/test-suite/output/UsePluginWarning.v @@ -0,0 +1,7 @@ +(* -*- mode: coq; coq-prog-args: ("-emacs" "-w" "-extraction-logical-axiom") -*- *) + +Require Extraction. +Axiom foo : Prop. + +Extraction foo. + diff --git a/test-suite/output/Warnings.out b/test-suite/output/Warnings.out new file mode 100644 index 0000000000..a70f8ca45a --- /dev/null +++ b/test-suite/output/Warnings.out @@ -0,0 +1,3 @@ +File "stdin", line 4, characters 0-22: +Warning: Projection value has no head constant: fun x : B => x in canonical +instance a of b, ignoring it. [projection-no-head-constant,typechecker] diff --git a/test-suite/output/Warnings.v b/test-suite/output/Warnings.v new file mode 100644 index 0000000000..7465442cab --- /dev/null +++ b/test-suite/output/Warnings.v @@ -0,0 +1,5 @@ +(* Term in warning was not printed in the right environment at some time *) +Record A := { B:Type; b:B->B }. +Definition a B := {| B:=B; b:=fun x => x |}. +Canonical Structure a. + diff --git a/test-suite/output/inference.v b/test-suite/output/inference.v index f761a4dc5a..73169dae65 100644 --- a/test-suite/output/inference.v +++ b/test-suite/output/inference.v @@ -14,6 +14,7 @@ Definition P (e:option L) := Print P. (* Check that plus is folded even if reduction is involved *) +Set Warnings Append "-deprecated-option". Set Refolding Reduction. Check (fun m n p (H : S m <= (S n) + p) => le_S_n _ _ H). diff --git a/test-suite/success/Check.v b/test-suite/success/Check.v index e4ee351c3a..0f677a8495 100644 --- a/test-suite/success/Check.v +++ b/test-suite/success/Check.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/Field.v b/test-suite/success/Field.v index 438e461357..018b22c489 100644 --- a/test-suite/success/Field.v +++ b/test-suite/success/Field.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/Hints.v b/test-suite/success/Hints.v index 1abe14774c..6962e43e7e 100644 --- a/test-suite/success/Hints.v +++ b/test-suite/success/Hints.v @@ -37,7 +37,6 @@ 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 *) @@ -80,8 +79,6 @@ 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. @@ -169,8 +166,6 @@ Instance foo f : E (id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ f ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id). Proof. - Fail Timeout 1 apply _. (* 3.7s *) - Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e) (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances. diff --git a/test-suite/success/Tauto.v b/test-suite/success/Tauto.v index 767f15be72..bffd96044d 100644 --- a/test-suite/success/Tauto.v +++ b/test-suite/success/Tauto.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/TestRefine.v b/test-suite/success/TestRefine.v index 023cb5f59d..87296744c4 100644 --- a/test-suite/success/TestRefine.v +++ b/test-suite/success/TestRefine.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/abstract_poly.v b/test-suite/success/abstract_poly.v new file mode 100644 index 0000000000..b736b734fd --- /dev/null +++ b/test-suite/success/abstract_poly.v @@ -0,0 +1,20 @@ +Set Universe Polymorphism. + +Inductive path@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := refl : path x x. +Inductive unit@{i} : Type@{i} := tt. + +Lemma foo@{i j} : forall (m n : unit@{i}) (P : unit -> Type@{j}), path m n -> P m -> P n. +Proof. +intros m n P e p. +abstract (rewrite e in p; exact p). +Defined. + +Check foo_subproof@{Set Set}. + +Lemma bar : forall (m n : unit) (P : unit -> Type), path m n -> P m -> P n. +Proof. +intros m n P e p. +abstract (rewrite e in p; exact p). +Defined. + +Check bar_subproof@{Set Set Set}. diff --git a/test-suite/success/cumulativity.v b/test-suite/success/cumulativity.v index ebf817cfc5..0ee85712e2 100644 --- a/test-suite/success/cumulativity.v +++ b/test-suite/success/cumulativity.v @@ -1,5 +1,11 @@ +Polymorphic Cumulative Inductive T1 := t1 : T1. +Fail Monomorphic Cumulative Inductive T2 := t2 : T2. + +Polymorphic Cumulative Record R1 := { r1 : T1 }. +Fail Monomorphic Cumulative Inductive R2 := {r2 : T1}. + Set Universe Polymorphism. -Set Inductive Cumulativity. +Set Polymorphic Inductive Cumulativity. Set Printing Universes. Inductive List (A: Type) := nil | cons : A -> List A -> List A. @@ -62,4 +68,33 @@ End subtyping_test. Record A : Type := { a :> Type; }. -Record B (X : A) : Type := { b : X; }.
\ No newline at end of file +Record B (X : A) : Type := { b : X; }. + +NonCumulative Inductive NCList (A: Type) + := ncnil | nccons : A -> NCList A -> NCList A. + +Section NCListLift. + Universe i j. + + Constraint i < j. + + Fail Definition LiftNCL {A} : NCList@{i} A -> NCList@{j} A := fun x => x. + +End NCListLift. + +Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x. + +Definition funext_type@{a b e} (A : Type@{a}) (B : A -> Type@{b}) + := forall f g : (forall a, B a), + (forall x, eq@{e} (f x) (g x)) + -> eq@{e} f g. + +Section down. + Universes a b e e'. + Constraint e' < e. + Lemma funext_down {A B} + : @funext_type@{a b e} A B -> @funext_type@{a b e'} A B. + Proof. + intros H f g Hfg. exact (H f g Hfg). + Defined. +End down. diff --git a/test-suite/success/eauto.v b/test-suite/success/eauto.v index 160f2d9deb..9b0ff1c8fe 100644 --- a/test-suite/success/eauto.v +++ b/test-suite/success/eauto.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/eqdecide.v b/test-suite/success/eqdecide.v index 724e2998ef..055434df01 100644 --- a/test-suite/success/eqdecide.v +++ b/test-suite/success/eqdecide.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/extraction.v b/test-suite/success/extraction.v index 89be144152..0ee2232502 100644 --- a/test-suite/success/extraction.v +++ b/test-suite/success/extraction.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -545,47 +545,96 @@ Recursive Extraction test_proj. (*** TO SUM UP: ***) -(* Was previously producing a "test_extraction.ml" *) -Recursive Extraction - idnat id id' test2 test3 test4 test5 test6 test7 d d2 - d3 d4 d5 d6 test8 id id' test9 test10 test11 test12 - test13 test19 test20 nat sumbool_rect c Finite tree - tree_size test14 test15 eta_c test16 test17 test18 bidon - tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1 - tp1bis Truc oups test24 loop horibilis PropSet natbool - zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop - f_arity f_normal Boite boite1 boite2 test_boite Box box1 - zarb test_proj. +Module Everything. + Definition idnat := idnat. + Definition id := id. + Definition id' := id'. + Definition test2 := test2. + Definition test3 := test3. + Definition test4 := test4. + Definition test5 := test5. + Definition test6 := test6. + Definition test7 := test7. + Definition d := d. + Definition d2 := d2. + Definition d3 := d3. + Definition d4 := d4. + Definition d5 := d5. + Definition d6 := d6. + Definition test8 := test8. + Definition test9 := test9. + Definition test10 := test10. + Definition test11 := test11. + Definition test12 := test12. + Definition test13 := test13. + Definition test19 := test19. + Definition test20 := test20. + Definition nat := nat. + Definition sumbool_rect := sumbool_rect. + Definition c := c. + Definition Finite := Finite. + Definition tree := tree. + Definition tree_size := tree_size. + Definition test14 := test14. + Definition test15 := test15. + Definition eta_c := eta_c. + Definition test16 := test16. + Definition test17 := test17. + Definition test18 := test18. + Definition bidon := bidon. + Definition tb := tb. + Definition fbidon := fbidon. + Definition fbidon2 := fbidon2. + Definition test_0 := test_0. + Definition test_1 := test_1. + Definition eq_rect := eq_rect. + Definition tp1 := tp1. + Definition tp1bis := tp1bis. + Definition Truc := Truc. + Definition oups := oups. + Definition test24 := test24. + Definition loop := loop. + Definition horibilis := horibilis. + Definition PropSet := PropSet. + Definition natbool := natbool. + Definition zerotrue := zerotrue. + Definition zeroTrue := zeroTrue. + Definition zeroprop := zeroprop. + Definition test21 := test21. + Definition test22 := test22. + Definition test23 := test23. + Definition f := f. + Definition f_prop := f_prop. + Definition f_arity := f_arity. + Definition f_normal := f_normal. + Definition Boite := Boite. + Definition boite1 := boite1. + Definition boite2 := boite2. + Definition test_boite := test_boite. + Definition Box := Box. + Definition box1 := box1. + Definition zarb := zarb. + Definition test_proj := test_proj. +End Everything. + +(* Extraction "test_extraction.ml" Everything. *) +Recursive Extraction Everything. +(* Check that the previous OCaml code is compilable *) +Extraction TestCompile Everything. Extraction Language Haskell. -(* Was previously producing a "Test_extraction.hs" *) -Recursive Extraction - idnat id id' test2 test3 test4 test5 test6 test7 d d2 - d3 d4 d5 d6 test8 id id' test9 test10 test11 test12 - test13 test19 test20 nat sumbool_rect c Finite tree - tree_size test14 test15 eta_c test16 test17 test18 bidon - tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1 - tp1bis Truc oups test24 loop horibilis PropSet natbool - zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop - f_arity f_normal Boite boite1 boite2 test_boite Box box1 - zarb test_proj. +(* Extraction "Test_extraction.hs" Everything. *) +Recursive Extraction Everything. Extraction Language Scheme. -(* Was previously producing a "test_extraction.scm" *) -Recursive Extraction - idnat id id' test2 test3 test4 test5 test6 test7 d d2 - d3 d4 d5 d6 test8 id id' test9 test10 test11 test12 - test13 test19 test20 nat sumbool_rect c Finite tree - tree_size test14 test15 eta_c test16 test17 test18 bidon - tb fbidon fbidon2 fbidon2 test_0 test_1 eq eq_rect tp1 - tp1bis Truc oups test24 loop horibilis PropSet natbool - zerotrue zeroTrue zeroprop test21 test22 test23 f f_prop - f_arity f_normal Boite boite1 boite2 test_boite Box box1 - zarb test_proj. +(* Extraction "test_extraction.scm" Everything. *) +Recursive Extraction Everything. (*** Finally, a test more focused on everyday's life situations ***) Require Import ZArith. -Recursive Extraction two_or_two_plus_one Zdiv_eucl_exist. +Extraction Language Ocaml. +Recursive Extraction Z_modulo_2 Zdiv_eucl_exist. +Extraction TestCompile Z_modulo_2 Zdiv_eucl_exist. diff --git a/test-suite/success/extraction_dep.v b/test-suite/success/extraction_dep.v index e770cf779a..fb0adabae9 100644 --- a/test-suite/success/extraction_dep.v +++ b/test-suite/success/extraction_dep.v @@ -4,7 +4,7 @@ Require Coq.extraction.Extraction. (** NB: we should someday check the produced code instead of - simply running the commands. *) + extracting and just compiling. *) (** 1) Without signature ... *) @@ -20,6 +20,7 @@ End A. Definition testA := A.u + A.B.x. Recursive Extraction testA. (* without: v w *) +Extraction TestCompile testA. (** 1b) Same with an Include *) @@ -31,6 +32,7 @@ End Abis. Definition testAbis := Abis.u + Abis.y. Recursive Extraction testAbis. (* without: A B v w x *) +Extraction TestCompile testAbis. (** 2) With signature, we only keep elements mentionned in signature. *) @@ -46,3 +48,4 @@ End Ater. Definition testAter := Ater.u. Recursive Extraction testAter. (* with only: u v *) +Extraction TestCompile testAter. diff --git a/test-suite/success/extraction_impl.v b/test-suite/success/extraction_impl.v index 5bf807b1c6..a38a688fb4 100644 --- a/test-suite/success/extraction_impl.v +++ b/test-suite/success/extraction_impl.v @@ -2,7 +2,7 @@ (** Examples of extraction with manually-declared implicit arguments *) (** NB: we should someday check the produced code instead of - simply running the commands. *) + extracting and just compiling. *) Require Coq.extraction.Extraction. @@ -22,9 +22,11 @@ Proof. Defined. Recursive Extraction dnat_nat. +Extraction TestCompile dnat_nat. Extraction Implicit dnat_nat [n]. Recursive Extraction dnat_nat. +Extraction TestCompile dnat_nat. (** Same, with a Fixpoint *) @@ -35,9 +37,11 @@ Fixpoint dnat_nat' n (d:dnat n) := end. Recursive Extraction dnat_nat'. +Extraction TestCompile dnat_nat'. Extraction Implicit dnat_nat' [n]. Recursive Extraction dnat_nat'. +Extraction TestCompile dnat_nat'. (** Bug #4243, part 2 *) @@ -56,6 +60,7 @@ Defined. Extraction Implicit es [n]. Extraction Implicit enat_nat [n]. Recursive Extraction enat_nat. +Extraction TestCompile enat_nat. (** Same, with a Fixpoint *) @@ -67,6 +72,7 @@ Fixpoint enat_nat' n (e:enat n) : nat := Extraction Implicit enat_nat' [n]. Recursive Extraction enat_nat'. +Extraction TestCompile enat_nat'. (** Bug #4228 *) @@ -82,3 +88,4 @@ Extraction Implicit two_course [n]. End Food. Recursive Extraction Food.Meal. +Extraction TestCompile Food.Meal. diff --git a/test-suite/success/inds_type_sec.v b/test-suite/success/inds_type_sec.v index c729b23ce7..7e9095dfd7 100644 --- a/test-suite/success/inds_type_sec.v +++ b/test-suite/success/inds_type_sec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/induct.v b/test-suite/success/induct.v index 1ed731f50f..35d7929877 100644 --- a/test-suite/success/induct.v +++ b/test-suite/success/induct.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/mutual_ind.v b/test-suite/success/mutual_ind.v index 45c1a5e584..c4c5623897 100644 --- a/test-suite/success/mutual_ind.v +++ b/test-suite/success/mutual_ind.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/success/primitiveproj.v b/test-suite/success/primitiveproj.v index 789854b2d6..576bdbf71b 100644 --- a/test-suite/success/primitiveproj.v +++ b/test-suite/success/primitiveproj.v @@ -184,6 +184,7 @@ Definition term' (x : wrap nat) := let f := (@unwrap2 nat) in f x. Require Coq.extraction.Extraction. Recursive Extraction term term'. +Extraction TestCompile term term'. (*Unset Printing Primitive Projection Parameters.*) (* Primitive projections in the presence of let-ins (was not failing in beta3)*) diff --git a/test-suite/success/unfold.v b/test-suite/success/unfold.v index d595cbc2b8..ce1c33fc40 100644 --- a/test-suite/success/unfold.v +++ b/test-suite/success/unfold.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/test-suite/typeclasses/NewSetoid.v b/test-suite/typeclasses/NewSetoid.v index 49f20a23f5..37d197a15c 100644 --- a/test-suite/typeclasses/NewSetoid.v +++ b/test-suite/typeclasses/NewSetoid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v index 953f7e4dbd..649819878a 100644 --- a/theories/Arith/Arith.v +++ b/theories/Arith/Arith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v index b378828efe..1493deb482 100644 --- a/theories/Arith/Arith_base.v +++ b/theories/Arith/Arith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v index 5a3d5631d5..9b40710858 100644 --- a/theories/Arith/Between.v +++ b/theories/Arith/Between.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Bool_nat.v b/theories/Arith/Bool_nat.v index 602555b60b..a1eaf02f71 100644 --- a/theories/Arith/Bool_nat.v +++ b/theories/Arith/Bool_nat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v index 610e9a697e..8381be5ced 100644 --- a/theories/Arith/Compare.v +++ b/theories/Arith/Compare.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v index 976507b565..1e3237d105 100644 --- a/theories/Arith/Compare_dec.v +++ b/theories/Arith/Compare_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Div2.v b/theories/Arith/Div2.v index 016cb85e90..ecb9a5706c 100644 --- a/theories/Arith/Div2.v +++ b/theories/Arith/Div2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v index f998c19fc7..722615428b 100644 --- a/theories/Arith/EqNat.v +++ b/theories/Arith/EqNat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v index fbe98d172a..6c6bf7fef5 100644 --- a/theories/Arith/Euclid.v +++ b/theories/Arith/Euclid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v index 3c8c250ab5..f30d05c7a4 100644 --- a/theories/Arith/Even.v +++ b/theories/Arith/Even.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Factorial.v b/theories/Arith/Factorial.v index b119bb0007..0625c03da4 100644 --- a/theories/Arith/Factorial.v +++ b/theories/Arith/Factorial.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v index 67c94fdf64..2d783f9e28 100644 --- a/theories/Arith/Gt.v +++ b/theories/Arith/Gt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v index 0fbcec5721..d95b057702 100644 --- a/theories/Arith/Le.v +++ b/theories/Arith/Le.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v index bfc2b91a9f..035c4e466d 100644 --- a/theories/Arith/Lt.v +++ b/theories/Arith/Lt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v index 49152549a4..d8c6f6528c 100644 --- a/theories/Arith/Max.v +++ b/theories/Arith/Max.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v index 38e59b7b8e..4826013f05 100644 --- a/theories/Arith/Min.v +++ b/theories/Arith/Min.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v index 1fc8f7907a..950f985d4a 100644 --- a/theories/Arith/Minus.v +++ b/theories/Arith/Minus.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v index a173efc10a..e4084ba471 100644 --- a/theories/Arith/Mult.v +++ b/theories/Arith/Mult.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/PeanoNat.v b/theories/Arith/PeanoNat.v index e3240bb78d..bde6f1bb49 100644 --- a/theories/Arith/PeanoNat.v +++ b/theories/Arith/PeanoNat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v index f8020a50e0..88cda79d82 100644 --- a/theories/Arith/Peano_dec.v +++ b/theories/Arith/Peano_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v index 94bbd50a9e..c9693dbb47 100644 --- a/theories/Arith/Wf_nat.v +++ b/theories/Arith/Wf_nat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v index 06096c66ac..fe050ca268 100644 --- a/theories/Bool/Bool.v +++ b/theories/Bool/Bool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/BoolEq.v b/theories/Bool/BoolEq.v index aec4f0bbf4..aaa7749047 100644 --- a/theories/Bool/BoolEq.v +++ b/theories/Bool/BoolEq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v index 09f643c8ee..d697bd86e7 100644 --- a/theories/Bool/Bvector.v +++ b/theories/Bool/Bvector.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v index 501366ce25..78bca1f5ed 100644 --- a/theories/Bool/DecBool.v +++ b/theories/Bool/DecBool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/IfProp.v b/theories/Bool/IfProp.v index 4257b4bc1a..fea952585b 100644 --- a/theories/Bool/IfProp.v +++ b/theories/Bool/IfProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v index fd7f42e2bd..065c979c97 100644 --- a/theories/Bool/Sumbool.v +++ b/theories/Bool/Sumbool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v index 16e47ac5a6..b2fc58f309 100644 --- a/theories/Bool/Zerob.v +++ b/theories/Bool/Zerob.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/CEquivalence.v b/theories/Classes/CEquivalence.v index bd01de47e3..6e0f9e0149 100644 --- a/theories/Classes/CEquivalence.v +++ b/theories/Classes/CEquivalence.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/CMorphisms.v b/theories/Classes/CMorphisms.v index 74ca5d4c8a..fae132fc65 100644 --- a/theories/Classes/CMorphisms.v +++ b/theories/Classes/CMorphisms.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8; coq-prog-args: ("-coqlib" "../.." "-R" ".." "Coq" "-top" "Coq.Classes.CMorphisms") -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/CRelationClasses.v b/theories/Classes/CRelationClasses.v index cfe0e08edb..02baa9114c 100644 --- a/theories/Classes/CRelationClasses.v +++ b/theories/Classes/CRelationClasses.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/DecidableClass.v b/theories/Classes/DecidableClass.v index a3b7e31154..34ed6f7a49 100644 --- a/theories/Classes/DecidableClass.v +++ b/theories/Classes/DecidableClass.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/EquivDec.v b/theories/Classes/EquivDec.v index 52313735eb..1278dac64f 100644 --- a/theories/Classes/EquivDec.v +++ b/theories/Classes/EquivDec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Equivalence.v b/theories/Classes/Equivalence.v index 80b0b7e4c6..76c3e768fb 100644 --- a/theories/Classes/Equivalence.v +++ b/theories/Classes/Equivalence.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Init.v b/theories/Classes/Init.v index c13b36fd1f..bddaa44b51 100644 --- a/theories/Classes/Init.v +++ b/theories/Classes/Init.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Morphisms.v b/theories/Classes/Morphisms.v index 6396e5390a..9859fb52fe 100644 --- a/theories/Classes/Morphisms.v +++ b/theories/Classes/Morphisms.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8; coq-prog-args: ("-coqlib" "../.." "-R" ".." "Coq" "-top" "Coq.Classes.Morphisms") -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Morphisms_Prop.v b/theories/Classes/Morphisms_Prop.v index 1590017711..24529ff37b 100644 --- a/theories/Classes/Morphisms_Prop.v +++ b/theories/Classes/Morphisms_Prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/Morphisms_Relations.v b/theories/Classes/Morphisms_Relations.v index 6048fe067c..c12b6b7bd0 100644 --- a/theories/Classes/Morphisms_Relations.v +++ b/theories/Classes/Morphisms_Relations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/RelationClasses.v b/theories/Classes/RelationClasses.v index 57728d305d..63225853db 100644 --- a/theories/Classes/RelationClasses.v +++ b/theories/Classes/RelationClasses.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/SetoidClass.v b/theories/Classes/SetoidClass.v index 4b133a4d17..6281607113 100644 --- a/theories/Classes/SetoidClass.v +++ b/theories/Classes/SetoidClass.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/SetoidDec.v b/theories/Classes/SetoidDec.v index 7201c0b161..54e54cd896 100644 --- a/theories/Classes/SetoidDec.v +++ b/theories/Classes/SetoidDec.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Classes/SetoidTactics.v b/theories/Classes/SetoidTactics.v index 190397ae49..292e8fc2e8 100644 --- a/theories/Classes/SetoidTactics.v +++ b/theories/Classes/SetoidTactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Compat/AdmitAxiom.v b/theories/Compat/AdmitAxiom.v index 4d9f55cfe1..7747b75eda 100644 --- a/theories/Compat/AdmitAxiom.v +++ b/theories/Compat/AdmitAxiom.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Compat/Coq85.v b/theories/Compat/Coq85.v index 64ba6b1e30..56a9130d1a 100644 --- a/theories/Compat/Coq85.v +++ b/theories/Compat/Coq85.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Compat/Coq86.v b/theories/Compat/Coq86.v index 4a511d6c48..34061ddd6d 100644 --- a/theories/Compat/Coq86.v +++ b/theories/Compat/Coq86.v @@ -1,11 +1,13 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (** Compatibility file for making Coq act similar to Coq v8.6 *) +Require Export Coq.Compat.Coq87. + Require Export Coq.extraction.Extraction. Require Export Coq.funind.FunInd. diff --git a/grammar/compat5.ml b/theories/Compat/Coq87.v index 33c1cd602b..61e911678a 100644 --- a/grammar/compat5.ml +++ b/theories/Compat/Coq87.v @@ -1,13 +1,9 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* This file is meant for camlp5, for which there is nothing to - add to gain camlp5 compatibility :-). - - See [compat5.mlp] for the [camlp4] counterpart -*) +(** Compatibility file for making Coq act similar to Coq v8.7 *) diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v index b1c0fdaa2f..3e76649293 100644 --- a/theories/FSets/FMapPositive.v +++ b/theories/FSets/FMapPositive.v @@ -654,19 +654,19 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Lemma xelements_bits_lt_1 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p. - Proof. + Proof using. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. - revert p0 q m v H. + revert p0 H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. Lemma xelements_bits_lt_2 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0. - Proof. + Proof using. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. - revert p0 q m v H. + revert p0 H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v index 41e1fea61d..22e10e2e43 100644 --- a/theories/Init/Datatypes.v +++ b/theories/Init/Datatypes.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -336,7 +336,7 @@ Proof. intros. apply CompareSpec2Type; assumption. Defined. (** [identity A a] is the family of datatypes on [A] whose sole non-empty member is the singleton datatype [identity A a a] whose - sole inhabitant is denoted [refl_identity A a] *) + sole inhabitant is denoted [identity_refl A a] *) Inductive identity (A:Type) (a:A) : A -> Type := identity_refl : identity a a. diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v index 4db11ae77d..037d37daff 100644 --- a/theories/Init/Logic.v +++ b/theories/Init/Logic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Logic_Type.v b/theories/Init/Logic_Type.v index 4536dfc0fd..567d2c15c5 100644 --- a/theories/Init/Logic_Type.v +++ b/theories/Init/Logic_Type.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v index b8920586f1..e942ca5623 100644 --- a/theories/Init/Nat.v +++ b/theories/Init/Nat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v index 2b0fe13620..e67ae6a925 100644 --- a/theories/Init/Notations.v +++ b/theories/Init/Notations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v index 6c4a63501d..571d2f2dd2 100644 --- a/theories/Init/Peano.v +++ b/theories/Init/Peano.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v index 28049e9ee5..f0867a0347 100644 --- a/theories/Init/Prelude.v +++ b/theories/Init/Prelude.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v index 95734991d6..3b4f833a31 100644 --- a/theories/Init/Specif.v +++ b/theories/Init/Specif.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v index aab385ef75..5d0e7602a9 100644 --- a/theories/Init/Tactics.v +++ b/theories/Init/Tactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Init/Wf.v b/theories/Init/Wf.v index b5b17e5e8d..690a3f6445 100644 --- a/theories/Init/Wf.v +++ b/theories/Init/Wf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/List.v b/theories/Lists/List.v index 1aece3f60b..fbf992dbf4 100644 --- a/theories/Lists/List.v +++ b/theories/Lists/List.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/ListDec.v b/theories/Lists/ListDec.v index 3e2eeac048..b03461e0b2 100644 --- a/theories/Lists/ListDec.v +++ b/theories/Lists/ListDec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/ListSet.v b/theories/Lists/ListSet.v index 655d3940c9..31970da813 100644 --- a/theories/Lists/ListSet.v +++ b/theories/Lists/ListSet.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v index 537d5f684f..0d42b7499e 100644 --- a/theories/Lists/ListTactics.v +++ b/theories/Lists/ListTactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/StreamMemo.v b/theories/Lists/StreamMemo.v index 5a16cc4390..5fccd0dec9 100644 --- a/theories/Lists/StreamMemo.v +++ b/theories/Lists/StreamMemo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Lists/Streams.v b/theories/Lists/Streams.v index 1c302b22f4..64e8dffaa0 100644 --- a/theories/Lists/Streams.v +++ b/theories/Lists/Streams.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Berardi.v b/theories/Logic/Berardi.v index 1e0bd0fede..dac43ad526 100644 --- a/theories/Logic/Berardi.v +++ b/theories/Logic/Berardi.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v index 116897f4ce..78ec8ff247 100644 --- a/theories/Logic/ChoiceFacts.v +++ b/theories/Logic/ChoiceFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Classical.v b/theories/Logic/Classical.v index 14d83501f5..044ca21229 100644 --- a/theories/Logic/Classical.v +++ b/theories/Logic/Classical.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalChoice.v b/theories/Logic/ClassicalChoice.v index 7041ee40b6..27cb59a8fe 100644 --- a/theories/Logic/ClassicalChoice.v +++ b/theories/Logic/ClassicalChoice.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalDescription.v b/theories/Logic/ClassicalDescription.v index 9e6d07b2fc..304ae59f8f 100644 --- a/theories/Logic/ClassicalDescription.v +++ b/theories/Logic/ClassicalDescription.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v index 0e91613d94..e660e95667 100644 --- a/theories/Logic/ClassicalEpsilon.v +++ b/theories/Logic/ClassicalEpsilon.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v index 021408a37b..c90a97612f 100644 --- a/theories/Logic/ClassicalFacts.v +++ b/theories/Logic/ClassicalFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ClassicalUniqueChoice.v b/theories/Logic/ClassicalUniqueChoice.v index 57f367e545..1309f91a3d 100644 --- a/theories/Logic/ClassicalUniqueChoice.v +++ b/theories/Logic/ClassicalUniqueChoice.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Classical_Pred_Type.v b/theories/Logic/Classical_Pred_Type.v index 6665798dd4..06c2984667 100644 --- a/theories/Logic/Classical_Pred_Type.v +++ b/theories/Logic/Classical_Pred_Type.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v index 2c69d4f0e5..f7b53f1dc2 100644 --- a/theories/Logic/Classical_Prop.v +++ b/theories/Logic/Classical_Prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ConstructiveEpsilon.v b/theories/Logic/ConstructiveEpsilon.v index a304dd24eb..71ce2a40a8 100644 --- a/theories/Logic/ConstructiveEpsilon.v +++ b/theories/Logic/ConstructiveEpsilon.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Decidable.v b/theories/Logic/Decidable.v index 8b6054f9d0..acb34771f9 100644 --- a/theories/Logic/Decidable.v +++ b/theories/Logic/Decidable.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Description.v b/theories/Logic/Description.v index 0239222e36..4ab52ae46b 100644 --- a/theories/Logic/Description.v +++ b/theories/Logic/Description.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v index 896be7c339..c124e71419 100644 --- a/theories/Logic/Diaconescu.v +++ b/theories/Logic/Diaconescu.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Epsilon.v b/theories/Logic/Epsilon.v index ffbb5758f1..96f677e43c 100644 --- a/theories/Logic/Epsilon.v +++ b/theories/Logic/Epsilon.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Eqdep.v b/theories/Logic/Eqdep.v index 5ef86b8e77..ac003bf1a3 100644 --- a/theories/Logic/Eqdep.v +++ b/theories/Logic/Eqdep.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v index bd59159bb5..c9dca432a5 100644 --- a/theories/Logic/EqdepFacts.v +++ b/theories/Logic/EqdepFacts.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v index b7b4dec22e..beb4d0b3d8 100644 --- a/theories/Logic/Eqdep_dec.v +++ b/theories/Logic/Eqdep_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ExtensionalFunctionRepresentative.v b/theories/Logic/ExtensionalFunctionRepresentative.v index a9da68e165..becc9f147d 100644 --- a/theories/Logic/ExtensionalFunctionRepresentative.v +++ b/theories/Logic/ExtensionalFunctionRepresentative.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ExtensionalityFacts.v b/theories/Logic/ExtensionalityFacts.v index 0e34e7e97d..86539544b9 100644 --- a/theories/Logic/ExtensionalityFacts.v +++ b/theories/Logic/ExtensionalityFacts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/FinFun.v b/theories/Logic/FinFun.v index 0646680152..8bdbfe85b5 100644 --- a/theories/Logic/FinFun.v +++ b/theories/Logic/FinFun.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v index 9551fea1ab..ac95ddd0c5 100644 --- a/theories/Logic/FunctionalExtensionality.v +++ b/theories/Logic/FunctionalExtensionality.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/Hurkens.v b/theories/Logic/Hurkens.v index a10c180ccf..4590d609d5 100644 --- a/theories/Logic/Hurkens.v +++ b/theories/Logic/Hurkens.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/IndefiniteDescription.v b/theories/Logic/IndefiniteDescription.v index 21be50323f..10ef72ade4 100644 --- a/theories/Logic/IndefiniteDescription.v +++ b/theories/Logic/IndefiniteDescription.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v index 86d05e8fb2..aa6193bc76 100644 --- a/theories/Logic/JMeq.v +++ b/theories/Logic/JMeq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ProofIrrelevance.v b/theories/Logic/ProofIrrelevance.v index 305839cd00..d11e7c8723 100644 --- a/theories/Logic/ProofIrrelevance.v +++ b/theories/Logic/ProofIrrelevance.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/ProofIrrelevanceFacts.v b/theories/Logic/ProofIrrelevanceFacts.v index 19b3e9e6f4..f359a21091 100644 --- a/theories/Logic/ProofIrrelevanceFacts.v +++ b/theories/Logic/ProofIrrelevanceFacts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/PropExtensionality.v b/theories/Logic/PropExtensionality.v index 796c602734..b8bc9a52c1 100644 --- a/theories/Logic/PropExtensionality.v +++ b/theories/Logic/PropExtensionality.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/PropExtensionalityFacts.v b/theories/Logic/PropExtensionalityFacts.v index 7e455dfa1e..8a1cf9708a 100644 --- a/theories/Logic/PropExtensionalityFacts.v +++ b/theories/Logic/PropExtensionalityFacts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/RelationalChoice.v b/theories/Logic/RelationalChoice.v index d16835f810..668568b034 100644 --- a/theories/Logic/RelationalChoice.v +++ b/theories/Logic/RelationalChoice.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/SetIsType.v b/theories/Logic/SetIsType.v index 33fce6cc7f..19b6f62dd7 100644 --- a/theories/Logic/SetIsType.v +++ b/theories/Logic/SetIsType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/SetoidChoice.v b/theories/Logic/SetoidChoice.v index 84432dda1b..62979330d2 100644 --- a/theories/Logic/SetoidChoice.v +++ b/theories/Logic/SetoidChoice.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/WKL.v b/theories/Logic/WKL.v index 95f3e83f1d..7f98d8e914 100644 --- a/theories/Logic/WKL.v +++ b/theories/Logic/WKL.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Logic/WeakFan.v b/theories/Logic/WeakFan.v index 4416d38db0..0068f72eb0 100644 --- a/theories/Logic/WeakFan.v +++ b/theories/Logic/WeakFan.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/BinNat.v b/theories/NArith/BinNat.v index 4c39857370..75a8bfdb39 100644 --- a/theories/NArith/BinNat.v +++ b/theories/NArith/BinNat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v index 4df4242e84..ba923d0624 100644 --- a/theories/NArith/BinNatDef.v +++ b/theories/NArith/BinNatDef.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v index 12d3ad2fdb..64eea44190 100644 --- a/theories/NArith/NArith.v +++ b/theories/NArith/NArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ndec.v b/theories/NArith/Ndec.v index 37fd9ddeda..892bbe7cdc 100644 --- a/theories/NArith/Ndec.v +++ b/theories/NArith/Ndec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ndigits.v b/theories/NArith/Ndigits.v index a1e51c9d34..9aadf985de 100644 --- a/theories/NArith/Ndigits.v +++ b/theories/NArith/Ndigits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ndist.v b/theories/NArith/Ndist.v index 0ab8be5873..d81c119d39 100644 --- a/theories/NArith/Ndist.v +++ b/theories/NArith/Ndist.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ndiv_def.v b/theories/NArith/Ndiv_def.v index 4bdf6529f8..974e93994c 100644 --- a/theories/NArith/Ndiv_def.v +++ b/theories/NArith/Ndiv_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Ngcd_def.v b/theories/NArith/Ngcd_def.v index 277fd26f08..cfca82eb37 100644 --- a/theories/NArith/Ngcd_def.v +++ b/theories/NArith/Ngcd_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Nnat.v b/theories/NArith/Nnat.v index 4e007878f4..798ab28289 100644 --- a/theories/NArith/Nnat.v +++ b/theories/NArith/Nnat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/NArith/Nsqrt_def.v b/theories/NArith/Nsqrt_def.v index dd44b6e2d4..97de41c20a 100644 --- a/theories/NArith/Nsqrt_def.v +++ b/theories/NArith/Nsqrt_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/BinNums.v b/theories/Numbers/BinNums.v index e4f3cd6cfa..d7e4185f74 100644 --- a/theories/Numbers/BinNums.v +++ b/theories/Numbers/BinNums.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v index 8575801988..1777743fab 100644 --- a/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v +++ b/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Abstract/DoubleType.v b/theories/Numbers/Cyclic/Abstract/DoubleType.v index d60c19ea5d..73a064acde 100644 --- a/theories/Numbers/Cyclic/Abstract/DoubleType.v +++ b/theories/Numbers/Cyclic/Abstract/DoubleType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Abstract/NZCyclic.v b/theories/Numbers/Cyclic/Abstract/NZCyclic.v index 3f9b7b2971..94f8608419 100644 --- a/theories/Numbers/Cyclic/Abstract/NZCyclic.v +++ b/theories/Numbers/Cyclic/Abstract/NZCyclic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Int31/Cyclic31.v b/theories/Numbers/Cyclic/Int31/Cyclic31.v index ba55003f7a..d2390e2ce5 100644 --- a/theories/Numbers/Cyclic/Int31/Cyclic31.v +++ b/theories/Numbers/Cyclic/Int31/Cyclic31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Int31/Int31.v b/theories/Numbers/Cyclic/Int31/Int31.v index ff4b998e72..cc359bfdf6 100644 --- a/theories/Numbers/Cyclic/Int31/Int31.v +++ b/theories/Numbers/Cyclic/Int31/Int31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/Int31/Ring31.v b/theories/Numbers/Cyclic/Int31/Ring31.v index d160f5f1de..c076dbd9a0 100644 --- a/theories/Numbers/Cyclic/Int31/Ring31.v +++ b/theories/Numbers/Cyclic/Int31/Ring31.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Cyclic/ZModulo/ZModulo.v b/theories/Numbers/Cyclic/ZModulo/ZModulo.v index a3d7edbf4b..e7658841a3 100644 --- a/theories/Numbers/Cyclic/ZModulo/ZModulo.v +++ b/theories/Numbers/Cyclic/ZModulo/ZModulo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZAdd.v b/theories/Numbers/Integer/Abstract/ZAdd.v index f7fdc17950..9d94ff65d5 100644 --- a/theories/Numbers/Integer/Abstract/ZAdd.v +++ b/theories/Numbers/Integer/Abstract/ZAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZAddOrder.v b/theories/Numbers/Integer/Abstract/ZAddOrder.v index 6bf5e9d4c5..84bb1a24a5 100644 --- a/theories/Numbers/Integer/Abstract/ZAddOrder.v +++ b/theories/Numbers/Integer/Abstract/ZAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZAxioms.v b/theories/Numbers/Integer/Abstract/ZAxioms.v index ad10e65f00..6efb7ea235 100644 --- a/theories/Numbers/Integer/Abstract/ZAxioms.v +++ b/theories/Numbers/Integer/Abstract/ZAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZBase.v b/theories/Numbers/Integer/Abstract/ZBase.v index 9b1b30f878..b2014135f1 100644 --- a/theories/Numbers/Integer/Abstract/ZBase.v +++ b/theories/Numbers/Integer/Abstract/ZBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZBits.v b/theories/Numbers/Integer/Abstract/ZBits.v index c919e121db..68d27fec93 100644 --- a/theories/Numbers/Integer/Abstract/ZBits.v +++ b/theories/Numbers/Integer/Abstract/ZBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZDivEucl.v b/theories/Numbers/Integer/Abstract/ZDivEucl.v index c2fa69e535..967b68d365 100644 --- a/theories/Numbers/Integer/Abstract/ZDivEucl.v +++ b/theories/Numbers/Integer/Abstract/ZDivEucl.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -602,6 +602,14 @@ Proof. apply div_mod; order. Qed. +Lemma mod_div: forall a b, b~=0 -> + a mod b / b == 0. +Proof. + intros a b Hb. + rewrite div_small_iff by assumption. + auto using mod_always_pos. +Qed. + (** A last inequality: *) Theorem div_mul_le: diff --git a/theories/Numbers/Integer/Abstract/ZDivFloor.v b/theories/Numbers/Integer/Abstract/ZDivFloor.v index 310748ddb3..a9077127ed 100644 --- a/theories/Numbers/Integer/Abstract/ZDivFloor.v +++ b/theories/Numbers/Integer/Abstract/ZDivFloor.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -650,6 +650,14 @@ Proof. apply div_mod; order. Qed. +Lemma mod_div: forall a b, b~=0 -> + a mod b / b == 0. +Proof. + intros a b Hb. + rewrite div_small_iff by assumption. + auto using mod_bound_or. +Qed. + (** A last inequality: *) Theorem div_mul_le: diff --git a/theories/Numbers/Integer/Abstract/ZDivTrunc.v b/theories/Numbers/Integer/Abstract/ZDivTrunc.v index 0430107792..bbb8ad5ae9 100644 --- a/theories/Numbers/Integer/Abstract/ZDivTrunc.v +++ b/theories/Numbers/Integer/Abstract/ZDivTrunc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -622,6 +622,14 @@ Proof. apply quot_rem; order. Qed. +Lemma rem_quot: forall a b, b~=0 -> + a rem b ÷ b == 0. +Proof. + intros a b Hb. + rewrite quot_small_iff by assumption. + auto using rem_bound_abs. +Qed. + (** A last inequality: *) Theorem quot_mul_le: diff --git a/theories/Numbers/Integer/Abstract/ZGcd.v b/theories/Numbers/Integer/Abstract/ZGcd.v index 30adaeb4b1..1144bd2bfa 100644 --- a/theories/Numbers/Integer/Abstract/ZGcd.v +++ b/theories/Numbers/Integer/Abstract/ZGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZLcm.v b/theories/Numbers/Integer/Abstract/ZLcm.v index ef33308c28..4b0f9f9789 100644 --- a/theories/Numbers/Integer/Abstract/ZLcm.v +++ b/theories/Numbers/Integer/Abstract/ZLcm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZLt.v b/theories/Numbers/Integer/Abstract/ZLt.v index 0c92918d13..f43d74d706 100644 --- a/theories/Numbers/Integer/Abstract/ZLt.v +++ b/theories/Numbers/Integer/Abstract/ZLt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMaxMin.v b/theories/Numbers/Integer/Abstract/ZMaxMin.v index 24a47f002f..40c3980a5b 100644 --- a/theories/Numbers/Integer/Abstract/ZMaxMin.v +++ b/theories/Numbers/Integer/Abstract/ZMaxMin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMul.v b/theories/Numbers/Integer/Abstract/ZMul.v index 830c0a7da0..2550ae1c5e 100644 --- a/theories/Numbers/Integer/Abstract/ZMul.v +++ b/theories/Numbers/Integer/Abstract/ZMul.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZMulOrder.v b/theories/Numbers/Integer/Abstract/ZMulOrder.v index 320c8f355a..adea36f0e8 100644 --- a/theories/Numbers/Integer/Abstract/ZMulOrder.v +++ b/theories/Numbers/Integer/Abstract/ZMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZParity.v b/theories/Numbers/Integer/Abstract/ZParity.v index 952d8e9c12..db379474bf 100644 --- a/theories/Numbers/Integer/Abstract/ZParity.v +++ b/theories/Numbers/Integer/Abstract/ZParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZPow.v b/theories/Numbers/Integer/Abstract/ZPow.v index 02b8501c79..478724e2ec 100644 --- a/theories/Numbers/Integer/Abstract/ZPow.v +++ b/theories/Numbers/Integer/Abstract/ZPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZProperties.v b/theories/Numbers/Integer/Abstract/ZProperties.v index 1dec3c5869..4a0ce5e5bf 100644 --- a/theories/Numbers/Integer/Abstract/ZProperties.v +++ b/theories/Numbers/Integer/Abstract/ZProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Abstract/ZSgnAbs.v b/theories/Numbers/Integer/Abstract/ZSgnAbs.v index a10552ab3b..b2f77c3f59 100644 --- a/theories/Numbers/Integer/Abstract/ZSgnAbs.v +++ b/theories/Numbers/Integer/Abstract/ZSgnAbs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/Binary/ZBinary.v b/theories/Numbers/Integer/Binary/ZBinary.v index eae8204d41..553bd68acf 100644 --- a/theories/Numbers/Integer/Binary/ZBinary.v +++ b/theories/Numbers/Integer/Binary/ZBinary.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Integer/NatPairs/ZNatPairs.v b/theories/Numbers/Integer/NatPairs/ZNatPairs.v index 0aaf336576..c640145ba3 100644 --- a/theories/Numbers/Integer/NatPairs/ZNatPairs.v +++ b/theories/Numbers/Integer/NatPairs/ZNatPairs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NaryFunctions.v b/theories/Numbers/NaryFunctions.v index eaac7d690a..cf0d2e8352 100644 --- a/theories/Numbers/NaryFunctions.v +++ b/theories/Numbers/NaryFunctions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAdd.v b/theories/Numbers/NatInt/NZAdd.v index 8cc52940a2..4beab1e1ba 100644 --- a/theories/Numbers/NatInt/NZAdd.v +++ b/theories/Numbers/NatInt/NZAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAddOrder.v b/theories/Numbers/NatInt/NZAddOrder.v index 705f291022..82e500ca21 100644 --- a/theories/Numbers/NatInt/NZAddOrder.v +++ b/theories/Numbers/NatInt/NZAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZAxioms.v b/theories/Numbers/NatInt/NZAxioms.v index 5a7f20728d..c0851791d7 100644 --- a/theories/Numbers/NatInt/NZAxioms.v +++ b/theories/Numbers/NatInt/NZAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZBase.v b/theories/Numbers/NatInt/NZBase.v index cf4ad35440..e0d55b8937 100644 --- a/theories/Numbers/NatInt/NZBase.v +++ b/theories/Numbers/NatInt/NZBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZBits.v b/theories/Numbers/NatInt/NZBits.v index 209bd94717..d731de62d6 100644 --- a/theories/Numbers/NatInt/NZBits.v +++ b/theories/Numbers/NatInt/NZBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZDiv.v b/theories/Numbers/NatInt/NZDiv.v index b2c0be6f56..5610eccb75 100644 --- a/theories/Numbers/NatInt/NZDiv.v +++ b/theories/Numbers/NatInt/NZDiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZDomain.v b/theories/Numbers/NatInt/NZDomain.v index 3881a27ff8..f5ee1351d4 100644 --- a/theories/Numbers/NatInt/NZDomain.v +++ b/theories/Numbers/NatInt/NZDomain.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZGcd.v b/theories/Numbers/NatInt/NZGcd.v index 44088f8c4a..f8af97196a 100644 --- a/theories/Numbers/NatInt/NZGcd.v +++ b/theories/Numbers/NatInt/NZGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZLog.v b/theories/Numbers/NatInt/NZLog.v index 3dfa2eef24..239f20a42d 100644 --- a/theories/Numbers/NatInt/NZLog.v +++ b/theories/Numbers/NatInt/NZLog.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZMul.v b/theories/Numbers/NatInt/NZMul.v index 36cd08271b..145f56352b 100644 --- a/theories/Numbers/NatInt/NZMul.v +++ b/theories/Numbers/NatInt/NZMul.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZMulOrder.v b/theories/Numbers/NatInt/NZMulOrder.v index 8569fc56b0..430f8fd2e1 100644 --- a/theories/Numbers/NatInt/NZMulOrder.v +++ b/theories/Numbers/NatInt/NZMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZOrder.v b/theories/Numbers/NatInt/NZOrder.v index 0b9d65983a..37ec464108 100644 --- a/theories/Numbers/NatInt/NZOrder.v +++ b/theories/Numbers/NatInt/NZOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v index 4a1352ccd7..de3bbbca76 100644 --- a/theories/Numbers/NatInt/NZParity.v +++ b/theories/Numbers/NatInt/NZParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZPow.v b/theories/Numbers/NatInt/NZPow.v index 261febbcfc..350047fa1e 100644 --- a/theories/Numbers/NatInt/NZPow.v +++ b/theories/Numbers/NatInt/NZPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZProperties.v b/theories/Numbers/NatInt/NZProperties.v index 79a9d73350..aee3b6245a 100644 --- a/theories/Numbers/NatInt/NZProperties.v +++ b/theories/Numbers/NatInt/NZProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NatInt/NZSqrt.v b/theories/Numbers/NatInt/NZSqrt.v index 7f9bb9c25c..c03107299f 100644 --- a/theories/Numbers/NatInt/NZSqrt.v +++ b/theories/Numbers/NatInt/NZSqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAdd.v b/theories/Numbers/Natural/Abstract/NAdd.v index eecec3ac1a..899fa39333 100644 --- a/theories/Numbers/Natural/Abstract/NAdd.v +++ b/theories/Numbers/Natural/Abstract/NAdd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAddOrder.v b/theories/Numbers/Natural/Abstract/NAddOrder.v index 9d68a006e8..d62903db61 100644 --- a/theories/Numbers/Natural/Abstract/NAddOrder.v +++ b/theories/Numbers/Natural/Abstract/NAddOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NAxioms.v b/theories/Numbers/Natural/Abstract/NAxioms.v index 25e285d590..d67689dbda 100644 --- a/theories/Numbers/Natural/Abstract/NAxioms.v +++ b/theories/Numbers/Natural/Abstract/NAxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NBase.v b/theories/Numbers/Natural/Abstract/NBase.v index f949a0f6ff..85a015cf26 100644 --- a/theories/Numbers/Natural/Abstract/NBase.v +++ b/theories/Numbers/Natural/Abstract/NBase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NBits.v b/theories/Numbers/Natural/Abstract/NBits.v index 3dd603e26f..1e7644edaf 100644 --- a/theories/Numbers/Natural/Abstract/NBits.v +++ b/theories/Numbers/Natural/Abstract/NBits.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NDefOps.v b/theories/Numbers/Natural/Abstract/NDefOps.v index b3a53617b6..e934eda9b5 100644 --- a/theories/Numbers/Natural/Abstract/NDefOps.v +++ b/theories/Numbers/Natural/Abstract/NDefOps.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NDiv.v b/theories/Numbers/Natural/Abstract/NDiv.v index 84e1219ef6..eff27abc52 100644 --- a/theories/Numbers/Natural/Abstract/NDiv.v +++ b/theories/Numbers/Natural/Abstract/NDiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NGcd.v b/theories/Numbers/Natural/Abstract/NGcd.v index 1eac134d5c..943caef637 100644 --- a/theories/Numbers/Natural/Abstract/NGcd.v +++ b/theories/Numbers/Natural/Abstract/NGcd.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NIso.v b/theories/Numbers/Natural/Abstract/NIso.v index e6cac0ba94..2b61f97840 100644 --- a/theories/Numbers/Natural/Abstract/NIso.v +++ b/theories/Numbers/Natural/Abstract/NIso.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NLcm.v b/theories/Numbers/Natural/Abstract/NLcm.v index 3d74979975..2e7bcf40c2 100644 --- a/theories/Numbers/Natural/Abstract/NLcm.v +++ b/theories/Numbers/Natural/Abstract/NLcm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NLog.v b/theories/Numbers/Natural/Abstract/NLog.v index 0c9da29bbb..d22510ab9b 100644 --- a/theories/Numbers/Natural/Abstract/NLog.v +++ b/theories/Numbers/Natural/Abstract/NLog.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NMaxMin.v b/theories/Numbers/Natural/Abstract/NMaxMin.v index b4c9db9160..1020fe375d 100644 --- a/theories/Numbers/Natural/Abstract/NMaxMin.v +++ b/theories/Numbers/Natural/Abstract/NMaxMin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NMulOrder.v b/theories/Numbers/Natural/Abstract/NMulOrder.v index a4b523963f..ace1e736eb 100644 --- a/theories/Numbers/Natural/Abstract/NMulOrder.v +++ b/theories/Numbers/Natural/Abstract/NMulOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NOrder.v b/theories/Numbers/Natural/Abstract/NOrder.v index 60e955f5f1..f05d783ad0 100644 --- a/theories/Numbers/Natural/Abstract/NOrder.v +++ b/theories/Numbers/Natural/Abstract/NOrder.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NParity.v b/theories/Numbers/Natural/Abstract/NParity.v index e1f573f657..fd136ff93f 100644 --- a/theories/Numbers/Natural/Abstract/NParity.v +++ b/theories/Numbers/Natural/Abstract/NParity.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NPow.v b/theories/Numbers/Natural/Abstract/NPow.v index c9b2177f92..d31d67a1ce 100644 --- a/theories/Numbers/Natural/Abstract/NPow.v +++ b/theories/Numbers/Natural/Abstract/NPow.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NProperties.v b/theories/Numbers/Natural/Abstract/NProperties.v index 819a5be938..b753d659a9 100644 --- a/theories/Numbers/Natural/Abstract/NProperties.v +++ b/theories/Numbers/Natural/Abstract/NProperties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NSqrt.v b/theories/Numbers/Natural/Abstract/NSqrt.v index 4ae414071b..68c06775e4 100644 --- a/theories/Numbers/Natural/Abstract/NSqrt.v +++ b/theories/Numbers/Natural/Abstract/NSqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NStrongRec.v b/theories/Numbers/Natural/Abstract/NStrongRec.v index fa3a5351e8..8e825ef7d8 100644 --- a/theories/Numbers/Natural/Abstract/NStrongRec.v +++ b/theories/Numbers/Natural/Abstract/NStrongRec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Abstract/NSub.v b/theories/Numbers/Natural/Abstract/NSub.v index 21f12037ce..dce78f610b 100644 --- a/theories/Numbers/Natural/Abstract/NSub.v +++ b/theories/Numbers/Natural/Abstract/NSub.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Binary/NBinary.v b/theories/Numbers/Natural/Binary/NBinary.v index 037b10d994..bdb715f330 100644 --- a/theories/Numbers/Natural/Binary/NBinary.v +++ b/theories/Numbers/Natural/Binary/NBinary.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/Natural/Peano/NPeano.v b/theories/Numbers/Natural/Peano/NPeano.v index d0168bd9ec..787ef81dc9 100644 --- a/theories/Numbers/Natural/Peano/NPeano.v +++ b/theories/Numbers/Natural/Peano/NPeano.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Numbers/NumPrelude.v b/theories/Numbers/NumPrelude.v index f323aaeb17..f01d5880e4 100644 --- a/theories/Numbers/NumPrelude.v +++ b/theories/Numbers/NumPrelude.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/BinPos.v b/theories/PArith/BinPos.v index d6385ee314..ff880eefa4 100644 --- a/theories/PArith/BinPos.v +++ b/theories/PArith/BinPos.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v index 74a292c63c..2b647555cc 100644 --- a/theories/PArith/BinPosDef.v +++ b/theories/PArith/BinPosDef.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/PArith.v b/theories/PArith/PArith.v index 6ee8d6d7bc..66e1ae1525 100644 --- a/theories/PArith/PArith.v +++ b/theories/PArith/PArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/POrderedType.v b/theories/PArith/POrderedType.v index 7619f6395d..b73ddff828 100644 --- a/theories/PArith/POrderedType.v +++ b/theories/PArith/POrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/PArith/Pnat.v b/theories/PArith/Pnat.v index 9c2608f4ae..461967de85 100644 --- a/theories/PArith/Pnat.v +++ b/theories/PArith/Pnat.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Basics.v b/theories/Program/Basics.v index 644b9b5a72..ff0d5b91b2 100644 --- a/theories/Program/Basics.v +++ b/theories/Program/Basics.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v index 772018aa0f..90db10ef1a 100644 --- a/theories/Program/Combinators.v +++ b/theories/Program/Combinators.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Equality.v b/theories/Program/Equality.v index d6f9bb9df0..5e3d0b1a71 100644 --- a/theories/Program/Equality.v +++ b/theories/Program/Equality.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Program.v b/theories/Program/Program.v index 4a6f2786f8..be8bb26d3f 100644 --- a/theories/Program/Program.v +++ b/theories/Program/Program.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Subset.v b/theories/Program/Subset.v index 2a3ec926b2..c68be0d229 100644 --- a/theories/Program/Subset.v +++ b/theories/Program/Subset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Syntax.v b/theories/Program/Syntax.v index 2fccf6249e..a623487165 100644 --- a/theories/Program/Syntax.v +++ b/theories/Program/Syntax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v index dfd6b0eae0..9aca56f479 100644 --- a/theories/Program/Tactics.v +++ b/theories/Program/Tactics.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Utils.v b/theories/Program/Utils.v index 396c96181d..8d75488037 100644 --- a/theories/Program/Utils.v +++ b/theories/Program/Utils.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Program/Wf.v b/theories/Program/Wf.v index 6e51f61873..da9020bc10 100644 --- a/theories/Program/Wf.v +++ b/theories/Program/Wf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/QArith.v b/theories/QArith/QArith.v index 5ad08b6507..439006abfb 100644 --- a/theories/QArith/QArith.v +++ b/theories/QArith/QArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v index 62304876e3..a19f9f9025 100644 --- a/theories/QArith/QArith_base.v +++ b/theories/QArith/QArith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/QOrderedType.v b/theories/QArith/QOrderedType.v index 25e98f0b0c..cf18ed8963 100644 --- a/theories/QArith/QOrderedType.v +++ b/theories/QArith/QOrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v index c60d045171..116aa0d429 100644 --- a/theories/QArith/Qabs.v +++ b/theories/QArith/Qabs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qcabs.v b/theories/QArith/Qcabs.v index e433ecffa1..1883c77be5 100644 --- a/theories/QArith/Qcabs.v +++ b/theories/QArith/Qcabs.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v index 9f9651d84a..0b399febee 100644 --- a/theories/QArith/Qcanon.v +++ b/theories/QArith/Qcanon.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qfield.v b/theories/QArith/Qfield.v index bbaf6027e6..bb1bb20795 100644 --- a/theories/QArith/Qfield.v +++ b/theories/QArith/Qfield.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qminmax.v b/theories/QArith/Qminmax.v index 86584d9ee5..254c5b57fb 100644 --- a/theories/QArith/Qminmax.v +++ b/theories/QArith/Qminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qpower.v b/theories/QArith/Qpower.v index af89d30058..187bef2ab1 100644 --- a/theories/QArith/Qpower.v +++ b/theories/QArith/Qpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v index 5f04cf242e..e6f7e7ac99 100644 --- a/theories/QArith/Qreals.v +++ b/theories/QArith/Qreals.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v index 131214f516..88e1298fbe 100644 --- a/theories/QArith/Qreduction.v +++ b/theories/QArith/Qreduction.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v index da11c2b1d1..9569348b96 100644 --- a/theories/QArith/Qring.v +++ b/theories/QArith/Qring.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/QArith/Qround.v b/theories/QArith/Qround.v index e94ef408db..6e72dd2c24 100644 --- a/theories/QArith/Qround.v +++ b/theories/QArith/Qround.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v index 0e1608a32f..155bf977bb 100644 --- a/theories/Reals/Alembert.v +++ b/theories/Reals/Alembert.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v index 17ffc0fe32..9e106f2678 100644 --- a/theories/Reals/AltSeries.v +++ b/theories/Reals/AltSeries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v index 67584f7759..4cdc035bbe 100644 --- a/theories/Reals/ArithProp.v +++ b/theories/Reals/ArithProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Binomial.v b/theories/Reals/Binomial.v index f878abfabc..d608a93592 100644 --- a/theories/Reals/Binomial.v +++ b/theories/Reals/Binomial.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v index 5cf6f17d4e..61af31e345 100644 --- a/theories/Reals/Cauchy_prod.v +++ b/theories/Reals/Cauchy_prod.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v index eb4a3b8047..194d6fda29 100644 --- a/theories/Reals/Cos_plus.v +++ b/theories/Reals/Cos_plus.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v index f5fcac47d8..b5ae769398 100644 --- a/theories/Reals/Cos_rel.v +++ b/theories/Reals/Cos_rel.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v index 7f26c1b86f..5dc5269c72 100644 --- a/theories/Reals/DiscrR.v +++ b/theories/Reals/DiscrR.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v index 76f4e14495..6666dc3a13 100644 --- a/theories/Reals/Exp_prop.v +++ b/theories/Reals/Exp_prop.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Integration.v b/theories/Reals/Integration.v index e3760e01ef..3db55efed2 100644 --- a/theories/Reals/Integration.v +++ b/theories/Reals/Integration.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v index 26c51583b9..a4b3845e82 100644 --- a/theories/Reals/MVT.v +++ b/theories/Reals/MVT.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Machin.v b/theories/Reals/Machin.v index 2d2385703b..6ed0658a0c 100644 --- a/theories/Reals/Machin.v +++ b/theories/Reals/Machin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v index ed5ae90c2b..405296f721 100644 --- a/theories/Reals/NewtonInt.v +++ b/theories/Reals/NewtonInt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v index 03ac6582b9..dbef02e021 100644 --- a/theories/Reals/PSeries_reg.v +++ b/theories/Reals/PSeries_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v index 37d54a6df1..1376c5134c 100644 --- a/theories/Reals/PartSum.v +++ b/theories/Reals/PartSum.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v index 711703ad70..7bcd2799a9 100644 --- a/theories/Reals/RIneq.v +++ b/theories/Reals/RIneq.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v index 924d5117b8..f739d1550f 100644 --- a/theories/Reals/RList.v +++ b/theories/Reals/RList.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/ROrderedType.v b/theories/Reals/ROrderedType.v index f2dc7fd090..e20652aad7 100644 --- a/theories/Reals/ROrderedType.v +++ b/theories/Reals/ROrderedType.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v index 46583d374e..5705eacbd2 100644 --- a/theories/Reals/R_Ifp.v +++ b/theories/Reals/R_Ifp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v index a8937e36fd..057a169760 100644 --- a/theories/Reals/R_sqr.v +++ b/theories/Reals/R_sqr.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v index 0c1e0b7e86..7a386bd2ef 100644 --- a/theories/Reals/R_sqrt.v +++ b/theories/Reals/R_sqrt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v index 88ebb88b23..66e37e867e 100644 --- a/theories/Reals/Ranalysis.v +++ b/theories/Reals/Ranalysis.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v index 9e3abd8158..7f7344031f 100644 --- a/theories/Reals/Ranalysis1.v +++ b/theories/Reals/Ranalysis1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v index b749da0d2a..04ee7a7bfc 100644 --- a/theories/Reals/Ranalysis2.v +++ b/theories/Reals/Ranalysis2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v index d4597aebaf..1fa2b69656 100644 --- a/theories/Reals/Ranalysis3.v +++ b/theories/Reals/Ranalysis3.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v index 23daedb8ba..0ea698d8da 100644 --- a/theories/Reals/Ranalysis4.v +++ b/theories/Reals/Ranalysis4.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis5.v b/theories/Reals/Ranalysis5.v index ccb4207ba0..61c0debb7e 100644 --- a/theories/Reals/Ranalysis5.v +++ b/theories/Reals/Ranalysis5.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ranalysis_reg.v b/theories/Reals/Ranalysis_reg.v index 0c27d407c3..f5ebb4c53a 100644 --- a/theories/Reals/Ranalysis_reg.v +++ b/theories/Reals/Ranalysis_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Ratan.v b/theories/Reals/Ratan.v index e438750df0..8c631dade0 100644 --- a/theories/Reals/Ratan.v +++ b/theories/Reals/Ratan.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v index 7f9db3b18f..947972bd55 100644 --- a/theories/Reals/Raxioms.v +++ b/theories/Reals/Raxioms.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v index e56ce28d6f..11d5a5b295 100644 --- a/theories/Reals/Rbase.v +++ b/theories/Reals/Rbase.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v index df16624976..17b3c5099a 100644 --- a/theories/Reals/Rbasic_fun.v +++ b/theories/Reals/Rbasic_fun.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v index 3520c26c34..783b81974b 100644 --- a/theories/Reals/Rcomplete.v +++ b/theories/Reals/Rcomplete.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v index cb5dea93ad..c668a708e7 100644 --- a/theories/Reals/Rdefinitions.v +++ b/theories/Reals/Rdefinitions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v index 5fb6bd2b71..67a06e2906 100644 --- a/theories/Reals/Rderiv.v +++ b/theories/Reals/Rderiv.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v index 8265f65ad4..8c4a9727e4 100644 --- a/theories/Reals/Reals.v +++ b/theories/Reals/Reals.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v index 6061363331..c70ec42eff 100644 --- a/theories/Reals/Rfunctions.v +++ b/theories/Reals/Rfunctions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v index 7423ffce79..a7002e959d 100644 --- a/theories/Reals/Rgeom.v +++ b/theories/Reals/Rgeom.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v index 4c0466ac04..f8617b01e8 100644 --- a/theories/Reals/RiemannInt.v +++ b/theories/Reals/RiemannInt.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v index af7cbb940d..0829dac526 100644 --- a/theories/Reals/RiemannInt_SF.v +++ b/theories/Reals/RiemannInt_SF.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v index 843aa27521..d769593a45 100644 --- a/theories/Reals/Rlimit.v +++ b/theories/Reals/Rlimit.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rlogic.v b/theories/Reals/Rlogic.v index b9a9458c8d..4ad3339ec9 100644 --- a/theories/Reals/Rlogic.v +++ b/theories/Reals/Rlogic.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rminmax.v b/theories/Reals/Rminmax.v index 152988dcc4..57e485cb71 100644 --- a/theories/Reals/Rminmax.v +++ b/theories/Reals/Rminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rpow_def.v b/theories/Reals/Rpow_def.v index f331bb2039..6279e1f163 100644 --- a/theories/Reals/Rpow_def.v +++ b/theories/Reals/Rpow_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v index 0e0246cbfa..a646104cd7 100644 --- a/theories/Reals/Rpower.v +++ b/theories/Reals/Rpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v index 883e4e1a9d..2cda84a585 100644 --- a/theories/Reals/Rprod.v +++ b/theories/Reals/Rprod.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v index c6b0c3f37a..4ed943070f 100644 --- a/theories/Reals/Rseries.v +++ b/theories/Reals/Rseries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v index ced2b3dacb..91b1a979a1 100644 --- a/theories/Reals/Rsigma.v +++ b/theories/Reals/Rsigma.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v index 6c2b0a1a77..584ba125d0 100644 --- a/theories/Reals/Rsqrt_def.v +++ b/theories/Reals/Rsqrt_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v index df3b95be4c..91b7429789 100644 --- a/theories/Reals/Rtopology.v +++ b/theories/Reals/Rtopology.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v index ecef0d682f..db1c46e9c3 100644 --- a/theories/Reals/Rtrigo.v +++ b/theories/Reals/Rtrigo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo1.v b/theories/Reals/Rtrigo1.v index 5a999eebe6..32b5cb6948 100644 --- a/theories/Reals/Rtrigo1.v +++ b/theories/Reals/Rtrigo1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v index 55cb74e35d..f03ba549b5 100644 --- a/theories/Reals/Rtrigo_alt.v +++ b/theories/Reals/Rtrigo_alt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v index 53056cabdf..3cffaee6c5 100644 --- a/theories/Reals/Rtrigo_calc.v +++ b/theories/Reals/Rtrigo_calc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v index b46df202e2..88b72f0df3 100644 --- a/theories/Reals/Rtrigo_def.v +++ b/theories/Reals/Rtrigo_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v index f395f9ae3d..4b44237263 100644 --- a/theories/Reals/Rtrigo_fun.v +++ b/theories/Reals/Rtrigo_fun.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v index d9c18d3587..a0ae737709 100644 --- a/theories/Reals/Rtrigo_reg.v +++ b/theories/Reals/Rtrigo_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v index 6a5233b643..62a954ce8c 100644 --- a/theories/Reals/SeqProp.v +++ b/theories/Reals/SeqProp.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v index 1123e7ee7e..667164d22b 100644 --- a/theories/Reals/SeqSeries.v +++ b/theories/Reals/SeqSeries.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v index a78a6e1986..3dc6ca1f37 100644 --- a/theories/Reals/SplitAbsolu.v +++ b/theories/Reals/SplitAbsolu.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v index 074a76315b..ab656440f1 100644 --- a/theories/Reals/SplitRmult.v +++ b/theories/Reals/SplitRmult.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v index 12d5cbbf0f..04062fbbd6 100644 --- a/theories/Reals/Sqrt_reg.v +++ b/theories/Reals/Sqrt_reg.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v index fe8a96acc7..e8d80f4692 100644 --- a/theories/Relations/Operators_Properties.v +++ b/theories/Relations/Operators_Properties.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v index 9c98879cea..2198ab165c 100644 --- a/theories/Relations/Relation_Definitions.v +++ b/theories/Relations/Relation_Definitions.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v index 88239475c3..fb6f11158c 100644 --- a/theories/Relations/Relation_Operators.v +++ b/theories/Relations/Relation_Operators.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v index ce6bdbc60b..403e69238e 100644 --- a/theories/Relations/Relations.v +++ b/theories/Relations/Relations.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v index 55b301c377..2bc0bc3b24 100644 --- a/theories/Setoids/Setoid.v +++ b/theories/Setoids/Setoid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v index 837437a227..68ef08e606 100644 --- a/theories/Sets/Classical_sets.v +++ b/theories/Sets/Classical_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v index 6291248eb5..823b5cb844 100644 --- a/theories/Sets/Constructive_sets.v +++ b/theories/Sets/Constructive_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v index b5db90306e..a6208ebb2e 100644 --- a/theories/Sets/Cpo.v +++ b/theories/Sets/Cpo.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v index 0fefb354b2..cb340f2607 100644 --- a/theories/Sets/Ensembles.v +++ b/theories/Sets/Ensembles.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v index edbc1efec0..8934a322ad 100644 --- a/theories/Sets/Finite_sets.v +++ b/theories/Sets/Finite_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v index 31cc11e1a9..714de75ac8 100644 --- a/theories/Sets/Finite_sets_facts.v +++ b/theories/Sets/Finite_sets_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v index e74ef41e4b..27ce2d4dc5 100644 --- a/theories/Sets/Image.v +++ b/theories/Sets/Image.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v index 98eeb7d74f..845861d70a 100644 --- a/theories/Sets/Infinite_sets.v +++ b/theories/Sets/Infinite_sets.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v index 057fc9b669..1471a44e15 100644 --- a/theories/Sets/Integers.v +++ b/theories/Sets/Integers.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Multiset.v b/theories/Sets/Multiset.v index 42d0c76dcc..01805fe920 100644 --- a/theories/Sets/Multiset.v +++ b/theories/Sets/Multiset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v index 335fec5b09..a9f136eff2 100644 --- a/theories/Sets/Partial_Order.v +++ b/theories/Sets/Partial_Order.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v index adbde18e60..48d2248da1 100644 --- a/theories/Sets/Permut.v +++ b/theories/Sets/Permut.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Powerset.v b/theories/Sets/Powerset.v index 7c2435da04..a98b4aca29 100644 --- a/theories/Sets/Powerset.v +++ b/theories/Sets/Powerset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v index e802beac9a..66cc44fbdb 100644 --- a/theories/Sets/Powerset_Classical_facts.v +++ b/theories/Sets/Powerset_Classical_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v index e9696a1cad..2dd559a95c 100644 --- a/theories/Sets/Powerset_facts.v +++ b/theories/Sets/Powerset_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_1.v b/theories/Sets/Relations_1.v index 45fb8134c8..7f1b03cf35 100644 --- a/theories/Sets/Relations_1.v +++ b/theories/Sets/Relations_1.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_1_facts.v b/theories/Sets/Relations_1_facts.v index bf8a42612e..679525bf42 100644 --- a/theories/Sets/Relations_1_facts.v +++ b/theories/Sets/Relations_1_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_2.v b/theories/Sets/Relations_2.v index 1e0b83fe51..8d19eab8c5 100644 --- a/theories/Sets/Relations_2.v +++ b/theories/Sets/Relations_2.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_2_facts.v b/theories/Sets/Relations_2_facts.v index da93e922d3..1fc5a2f104 100644 --- a/theories/Sets/Relations_2_facts.v +++ b/theories/Sets/Relations_2_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_3.v b/theories/Sets/Relations_3.v index c05b5ee76a..292cdbb5db 100644 --- a/theories/Sets/Relations_3.v +++ b/theories/Sets/Relations_3.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Relations_3_facts.v b/theories/Sets/Relations_3_facts.v index 89fb900ce3..59a987f154 100644 --- a/theories/Sets/Relations_3_facts.v +++ b/theories/Sets/Relations_3_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sets/Uniset.v b/theories/Sets/Uniset.v index e297d97e3c..8406c049e4 100644 --- a/theories/Sets/Uniset.v +++ b/theories/Sets/Uniset.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v index 20c6feb9ad..eaadb440f3 100644 --- a/theories/Sorting/Heap.v +++ b/theories/Sorting/Heap.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Mergesort.v b/theories/Sorting/Mergesort.v index 4b967c163a..51e34f42db 100644 --- a/theories/Sorting/Mergesort.v +++ b/theories/Sorting/Mergesort.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v index 45d27e35e3..90f64beecf 100644 --- a/theories/Sorting/PermutEq.v +++ b/theories/Sorting/PermutEq.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v index 0697a5e471..3ccf15d5e2 100644 --- a/theories/Sorting/PermutSetoid.v +++ b/theories/Sorting/PermutSetoid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v index 44f8ff6a71..301548a1df 100644 --- a/theories/Sorting/Permutation.v +++ b/theories/Sorting/Permutation.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Sorted.v b/theories/Sorting/Sorted.v index df03ff1c62..2e99f0d6b1 100644 --- a/theories/Sorting/Sorted.v +++ b/theories/Sorting/Sorted.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v index 6e9702f29e..1152c1118e 100644 --- a/theories/Sorting/Sorting.v +++ b/theories/Sorting/Sorting.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v index 55a533c55a..0f0e760c7c 100644 --- a/theories/Strings/Ascii.v +++ b/theories/Strings/Ascii.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Strings/String.v b/theories/Strings/String.v index 451b65cbe9..c39b47fb16 100644 --- a/theories/Strings/String.v +++ b/theories/Strings/String.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Unicode/Utf8.v b/theories/Unicode/Utf8.v index d5c2fa739c..a8b512a8fb 100644 --- a/theories/Unicode/Utf8.v +++ b/theories/Unicode/Utf8.v @@ -1,7 +1,7 @@ (* -*- coding:utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v index 44a0700aff..a0545c0a46 100644 --- a/theories/Unicode/Utf8_core.v +++ b/theories/Unicode/Utf8_core.v @@ -1,7 +1,7 @@ (* -*- coding:utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v index ebfc27b38e..693b0892ae 100644 --- a/theories/Wellfounded/Disjoint_Union.v +++ b/theories/Wellfounded/Disjoint_Union.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v index 1ff9b0055b..7fba5ef8dd 100644 --- a/theories/Wellfounded/Inclusion.v +++ b/theories/Wellfounded/Inclusion.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v index 7786c8b3b5..b743edc2b0 100644 --- a/theories/Wellfounded/Inverse_Image.v +++ b/theories/Wellfounded/Inverse_Image.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v index d90f9956bb..83a4926e4b 100644 --- a/theories/Wellfounded/Lexicographic_Exponentiation.v +++ b/theories/Wellfounded/Lexicographic_Exponentiation.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v index b2ada2f919..0b09ada9fd 100644 --- a/theories/Wellfounded/Lexicographic_Product.v +++ b/theories/Wellfounded/Lexicographic_Product.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Transitive_Closure.v b/theories/Wellfounded/Transitive_Closure.v index eb12d5d7b3..b7a8e63e5c 100644 --- a/theories/Wellfounded/Transitive_Closure.v +++ b/theories/Wellfounded/Transitive_Closure.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v index 61355c8d10..cf897afd75 100644 --- a/theories/Wellfounded/Union.v +++ b/theories/Wellfounded/Union.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v index b5acc28772..aab864e838 100644 --- a/theories/Wellfounded/Well_Ordering.v +++ b/theories/Wellfounded/Well_Ordering.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/Wellfounded/Wellfounded.v b/theories/Wellfounded/Wellfounded.v index 397f35aab0..17b3138e42 100644 --- a/theories/Wellfounded/Wellfounded.v +++ b/theories/Wellfounded/Wellfounded.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v index 1e3ab66876..e6fd0f22eb 100644 --- a/theories/ZArith/BinInt.v +++ b/theories/ZArith/BinInt.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v index 8c2e7d9418..7686fbae87 100644 --- a/theories/ZArith/BinIntDef.v +++ b/theories/ZArith/BinIntDef.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v index 4fbbac268e..f6583a3358 100644 --- a/theories/ZArith/Wf_Z.v +++ b/theories/ZArith/Wf_Z.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v index f86a7e52af..5f7b571d98 100644 --- a/theories/ZArith/ZArith.v +++ b/theories/ZArith/ZArith.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/ZArith_base.v b/theories/ZArith/ZArith_base.v index a1da544deb..9135f55917 100644 --- a/theories/ZArith/ZArith_base.v +++ b/theories/ZArith/ZArith_base.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v index 8947295e0b..0ee233a35b 100644 --- a/theories/ZArith/ZArith_dec.v +++ b/theories/ZArith/ZArith_dec.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v index df9db5b221..d4a46930a6 100644 --- a/theories/ZArith/Zabs.v +++ b/theories/ZArith/Zabs.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v index 41d1b2b508..407aef3b6d 100644 --- a/theories/ZArith/Zbool.v +++ b/theories/ZArith/Zbool.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v index 2627f1743f..f823c41a2c 100644 --- a/theories/ZArith/Zcompare.v +++ b/theories/ZArith/Zcompare.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v index 5bdb32fcf6..eb1e171807 100644 --- a/theories/ZArith/Zcomplements.v +++ b/theories/ZArith/Zcomplements.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zdigits.v b/theories/ZArith/Zdigits.v index bc3694bc1d..f80494c5e8 100644 --- a/theories/ZArith/Zdigits.v +++ b/theories/ZArith/Zdigits.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v index 2ba865bd00..fa1ddf56f2 100644 --- a/theories/ZArith/Zdiv.v +++ b/theories/ZArith/Zdiv.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -508,6 +508,13 @@ Qed. (** Unfortunately, the previous result isn't always true on negative numbers. For instance: 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) *) +Lemma Zmod_div : forall a b, a mod b / b = 0. +Proof. + intros a b. + zero_or_not b. + auto using Z.mod_div. +Qed. + (** A last inequality: *) Theorem Zdiv_mult_le: diff --git a/theories/ZArith/Zeuclid.v b/theories/ZArith/Zeuclid.v index 38a824cd4d..3839d1d771 100644 --- a/theories/ZArith/Zeuclid.v +++ b/theories/ZArith/Zeuclid.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v index d4051ef71f..42a6a8ee37 100644 --- a/theories/ZArith/Zeven.v +++ b/theories/ZArith/Zeven.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zgcd_alt.v b/theories/ZArith/Zgcd_alt.v index 3977ca9d33..3a460a5631 100644 --- a/theories/ZArith/Zgcd_alt.v +++ b/theories/ZArith/Zgcd_alt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v index c4e201e323..424b35a43f 100644 --- a/theories/ZArith/Zhints.v +++ b/theories/ZArith/Zhints.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v index fdfd71e123..28a2e287e4 100644 --- a/theories/ZArith/Zlogarithm.v +++ b/theories/ZArith/Zlogarithm.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v index 529e9f1d4d..b52da85638 100644 --- a/theories/ZArith/Zmax.v +++ b/theories/ZArith/Zmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v index 782a515862..d9e3ab19ef 100644 --- a/theories/ZArith/Zmin.v +++ b/theories/ZArith/Zmin.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v index ea9a5f8617..7e62d6689b 100644 --- a/theories/ZArith/Zminmax.v +++ b/theories/ZArith/Zminmax.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v index 65831c783e..a6f29936b3 100644 --- a/theories/ZArith/Zmisc.v +++ b/theories/ZArith/Zmisc.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v index 06428a7c4b..be712db6b0 100644 --- a/theories/ZArith/Znat.v +++ b/theories/ZArith/Znat.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v index ee6efb3cbf..5dfc370955 100644 --- a/theories/ZArith/Znumtheory.v +++ b/theories/ZArith/Znumtheory.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v index 18915216a0..ff8e22029c 100644 --- a/theories/ZArith/Zorder.v +++ b/theories/ZArith/Zorder.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zpow_alt.v b/theories/ZArith/Zpow_alt.v index 79a5a555e6..e1220dcee4 100644 --- a/theories/ZArith/Zpow_alt.v +++ b/theories/ZArith/Zpow_alt.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zpow_def.v b/theories/ZArith/Zpow_def.v index 9eafa07692..a768868bdb 100644 --- a/theories/ZArith/Zpow_def.v +++ b/theories/ZArith/Zpow_def.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zpow_facts.v b/theories/ZArith/Zpow_facts.v index 2930e677da..3ea3ae4ab0 100644 --- a/theories/ZArith/Zpow_facts.v +++ b/theories/ZArith/Zpow_facts.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v index 6f3a89f18f..6dcbdbdee7 100644 --- a/theories/ZArith/Zpower.v +++ b/theories/ZArith/Zpower.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zquot.v b/theories/ZArith/Zquot.v index 0d92f1d54c..efb56c4695 100644 --- a/theories/ZArith/Zquot.v +++ b/theories/ZArith/Zquot.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zsqrt_compat.v b/theories/ZArith/Zsqrt_compat.v index f4baba1902..fb7f71b4b5 100644 --- a/theories/ZArith/Zsqrt_compat.v +++ b/theories/ZArith/Zsqrt_compat.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v index 90754af3b4..ca4b386dc1 100644 --- a/theories/ZArith/Zwf.v +++ b/theories/ZArith/Zwf.v @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v index c6c3897606..494cb30dd5 100644 --- a/theories/ZArith/auxiliary.v +++ b/theories/ZArith/auxiliary.v @@ -1,7 +1,7 @@ (* -*- coding: utf-8 -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in index 7b01c1b663..3a8ca7b8d6 100644 --- a/tools/CoqMakefile.in +++ b/tools/CoqMakefile.in @@ -10,6 +10,7 @@ INITIAL_VARS := $(.VARIABLES) # To implement recursion we save the name of the main Makefile SELF := $(lastword $(MAKEFILE_LIST)) +PARENT := $(firstword $(MAKEFILE_LIST)) # This file is generated by coq_makefile and contains many variable # definitions, like the list of .v files or the path to Coq @@ -62,22 +63,46 @@ VERBOSE ?= # Time the Coq process (set to non empty), and how (see default value) TIMED?= TIMECMD?= -STDTIME?=/usr/bin/time -f "$* (user: %U mem: %M ko)" +# Use /usr/bin/time on linux, gtime on Mac OS +TIMEFMT?="$* (real: %e, user: %U, sys: %S, mem: %M ko)" +ifneq (,$(TIMED)) +ifeq (0,$(shell /usr/bin/time -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +STDTIME?=/usr/bin/time -f $(TIMEFMT) +else +ifeq (0,$(shell gtime -f $(TIMEFMT) true >/dev/null 2>/dev/null; echo $$?)) +STDTIME?=gtime -f $(TIMEFMT) +else +STDTIME?=time +endif +endif +else +STDTIME?=/usr/bin/time -f $(TIMEFMT) +endif # Coq binaries COQC ?= "$(COQBIN)coqc" +COQTOP ?= "$(COQBIN)coqtop" COQCHK ?= "$(COQBIN)coqchk" COQDEP ?= "$(COQBIN)coqdep" GALLINA ?= "$(COQBIN)gallina" COQDOC ?= "$(COQBIN)coqdoc" COQMKTOP ?= "$(COQBIN)coqmktop" +COQMKFILE ?= "$(COQBIN)coq_makefile" + +# Timing scripts +COQMAKE_ONE_TIME_FILE ?= "$(COQLIB)/tools/make-one-time-file.py" +COQMAKE_BOTH_TIME_FILES ?= "$(COQLIB)/tools/make-both-time-files.py" +COQMAKE_BOTH_SINGLE_TIMING_FILES ?= "$(COQLIB)/tools/make-both-single-timing-files.py" +BEFORE ?= +AFTER ?= # OCaml binaries -CAMLC ?= $(OCAMLFIND) ocamlc -c -rectypes -thread -CAMLOPTC ?= $(OCAMLFIND) opt -c -rectypes -thread -CAMLLINK ?= $(OCAMLFIND) ocamlc -rectypes -thread -CAMLOPTLINK ?= $(OCAMLFIND) opt -rectypes -thread -CAMLDEP ?= $(OCAMLFIND) ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack +CAMLC ?= "$(OCAMLFIND)" ocamlc -c -rectypes -thread +CAMLOPTC ?= "$(OCAMLFIND)" opt -c -rectypes -thread +CAMLLINK ?= "$(OCAMLFIND)" ocamlc -rectypes -thread +CAMLOPTLINK ?= "$(OCAMLFIND)" opt -rectypes -thread +CAMLDOC ?= "$(OCAMLFIND)" ocamldoc -rectypes +CAMLDEP ?= "$(OCAMLFIND)" ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack # DESTDIR is prepended to all installation paths DESTDIR ?= @@ -86,7 +111,15 @@ DESTDIR ?= CAMLDEBUG ?= COQDEBUG ?= - +# Option for making timing files +TIMING?= +# Output file names for timed builds +TIME_OF_BUILD_FILE ?= time-of-build.log +TIME_OF_BUILD_BEFORE_FILE ?= time-of-build-before.log +TIME_OF_BUILD_AFTER_FILE ?= time-of-build-after.log +TIME_OF_PRETTY_BUILD_FILE ?= time-of-build-pretty.log +TIME_OF_PRETTY_BOTH_BUILD_FILE ?= time-of-build-both.log +TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line ########## End of parameters ################################################## # What follows may be relevant to you only if you need to @@ -137,9 +170,9 @@ COQMAKEFILE_VERSION:=@COQ_VERSION@ COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)$(d)") -CAMLFLAGS=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB) +CAMLFLAGS=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB) $(OCAML_API_FLAGS) -CAMLLIB:=$(shell $(OCAMLFIND) printconf stdlib) +CAMLLIB:=$(shell "$(OCAMLFIND)" printconf stdlib) # FIXME This should be generated by Coq GRAMMARS:=grammar.cma @@ -149,17 +182,34 @@ else CAMLP4EXTEND= endif -PP:=-pp '$(CAMLP4O) -I $(CAMLLIB) -I $(COQLIB)/grammar compat5.cmo $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl' +PP:=-pp '$(CAMLP4O) -I $(CAMLLIB) -I "$(COQLIB)/grammar" $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl' -COQLIBINSTALL = $(COQLIB)user-contrib -COQDOCINSTALL = $(DOCDIR)user-contrib -COQTOPINSTALL = $(COQLIB)toploop +ifneq (,$(TIMING)) +TIMING_ARG=-time +ifeq (after,$(TIMING)) +TIMING_EXT=after-timing +else +ifeq (before,$(TIMING)) +TIMING_EXT=before-timing +else +TIMING_EXT=timing +endif +endif +else +TIMING_ARG= +endif # Retro compatibility (DESTDIR is standard on Unix, DESTROOT is not) ifneq "$(DSTROOT)" "" DESTDIR := $(DSTROOT) endif +concat_path = $(if $(1),$(1)/$(subst $(COQMF_WINDRIVE),/,$(2)),$(2)) + +COQLIBINSTALL = $(call concat_path,$(DESTDIR),$(COQLIB)user-contrib) +COQDOCINSTALL = $(call concat_path,$(DESTDIR),$(DOCDIR)user-contrib) +COQTOPINSTALL = $(call concat_path,$(DESTDIR),$(COQLIB)toploop) + # Files ####################################################################### # # We here define a bunch of variables about the files being part of the @@ -176,7 +226,7 @@ ALLSRCFILES := \ # helpers vo_to_obj = $(addsuffix .o,\ $(filter-out Warning: Error:,\ - $(shell $(COQBIN)coqtop -q -noinit -batch -quiet -print-mod-uid $(1)))) + $(shell $(COQTOP) -q -noinit -batch -quiet -print-mod-uid $(1)))) strip_dotslash = $(patsubst ./%,%,$(1)) VO = vo @@ -254,6 +304,41 @@ all: $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all .PHONY: all +all.timing.diff: + $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all + $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all.timing.diff TIME_OF_PRETTY_BUILD_EXTRA_FILES="" + $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all +.PHONY: all.timing.diff + +make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE) +make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE) +make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: + $(HIDE)rm -f pretty-timed-success.ok + $(HIDE)($(MAKE) --no-print-directory -f "$(PARENT)" $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE) + $(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed +print-pretty-timed:: + $(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +print-pretty-timed-diff:: + $(HIDE)$(COQMAKE_BOTH_TIME_FILES) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +ifeq (,$(BEFORE)) +print-pretty-single-time-diff:: + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + $(HIDE)false +else +ifeq (,$(AFTER)) +print-pretty-single-time-diff:: + @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing' + $(HIDE)false +else +print-pretty-single-time-diff:: + $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) $(BEFORE) $(AFTER) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) +endif +endif +pretty-timed: + $(HIDE)$(MAKE) --no-print-directory -f "$(PARENT)" make-pretty-timed + $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-timed +.PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff + # Extension points for actions to be performed before/after the all target pre-all:: @# Extension point @@ -270,6 +355,9 @@ post-all:: real-all: $(VOFILES) $(if $(USEBYTE),bytefiles,optfiles) .PHONY: real-all +real-all.timing.diff: $(VOFILES:.vo=.v.timing.diff) +.PHONE: real-all.timing.diff + bytefiles: $(CMOFILES) $(CMAFILES) .PHONY: bytefiles @@ -306,14 +394,14 @@ html: $(GLOBFILES) $(VFILES) -toc $(COQDOCFLAGS) -html $(GAL) $(COQDOCLIBS) -d html $(VFILES) mlihtml: $(MLIFILES:.mli=.cmi) - $(SHOW)'OCAMLDOC -d $@' + $(SHOW)'CAMLDOC -d $@' $(HIDE)mkdir $@ || rm -rf $@/* - $(HIDE)$(OCAMLFIND) ocamldoc -html -rectypes \ + $(HIDE)$(CAMLDOC) -html \ -d $@ -m A $(CAMLDEBUG) $(CAMLFLAGS) $(MLIFILES) all-mli.tex: $(MLIFILES:.mli=.cmi) - $(SHOW)'OCAMLDOC -latex $@' - $(OCAMLFIND) ocamldoc -latex -rectypes \ + $(SHOW)'CAMLDOC -latex $@' + $(HIDE)$(CAMLDOC) -latex \ -o $@ -m A $(CAMLDEBUG) $(CAMLFLAGS) $(MLIFILES) gallina: $(GFILES) @@ -354,13 +442,13 @@ beautify: $(BEAUTYFILES) install: install-extra $(HIDE)for f in $(FILESTOINSTALL); do\ - df="`$(COQMF_MAKEFILE) -destination-of "$$f" $(COQLIBS)`";\ - if [ -z "$$df" ]; then\ + df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\ + if [ "$$?" != "0" -o -z "$$df" ]; then\ echo SKIP "$$f" since it has no logical path;\ else\ - install -d "$(DESTDIR)$(COQLIBINSTALL)/$$df"; \ - install -m 0644 "$$f" "$(DESTDIR)$(COQLIBINSTALL)/$$df"; \ - echo INSTALL "$$f" "$(DESTDIR)$(COQLIBINSTALL)/$$df";\ + install -d "$(COQLIBINSTALL)/$$df" &&\ + install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\ + echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\ fi;\ done install-extra:: @@ -369,28 +457,28 @@ install-extra:: install-byte: $(HIDE)for f in $(BYTEFILESTOINSTALL); do\ - df="`$(COQMF_MAKEFILE) -destination-of "$$f" $(COQLIBS)`";\ - if [ -z "$$df" ]; then\ + df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\ + if [ "$$?" != "0" -o -z "$$df" ]; then\ echo SKIP "$$f" since it has no logical path;\ else\ - install -d "$(DESTDIR)$(COQLIBINSTALL)/$$df"; \ - install -m 0644 "$$f" "$(DESTDIR)$(COQLIBINSTALL)/$$df"; \ - echo INSTALL "$$f" "$(DESTDIR)$(COQLIBINSTALL)/$$df";\ + install -d "$(COQLIBINSTALL)/$$df" &&\ + install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\ + echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\ fi;\ done install-doc:: html mlihtml @# Extension point - $(HIDE)install -d "$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" + $(HIDE)install -d "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" $(HIDE)for i in html/*; do \ - dest="$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ + dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ install -m 0644 "$$i" "$$dest";\ echo INSTALL "$$i" "$$dest";\ done $(HIDE)install -d \ - "$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" + "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" $(HIDE)for i in mlihtml/*; do \ - dest="$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ + dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ install -m 0644 "$$i" "$$dest";\ echo INSTALL "$$i" "$$dest";\ done @@ -399,21 +487,21 @@ install-doc:: html mlihtml uninstall:: @# Extension point $(HIDE)for f in $(FILESTOINSTALL); do \ - df="`$(COQMF_MAKEFILE) -destination-of "$$f" $(COQLIBS)`";\ - instf="$(DESTDIR)$(COQLIBINSTALL)/$$df/`basename $$f`"; \ - rm -f "$$instf";\ - echo RM "$$instf"; \ - rmdir "$(DESTDIR)$(COQLIBINSTALL)/$$df/" || true; \ + df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\ + instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\ + rm -f "$$instf" &&\ + echo RM "$$instf" &&\ + (rmdir "$(call concat_path,,$(COQLIBINSTALL)/$$df/)" || true); \ done .PHONY: uninstall uninstall-doc:: @# Extension point - $(SHOW)'RM $(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html' - $(HIDE)rm -rf "$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" - $(SHOW)'RM $(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml' - $(HIDE)rm -rf "$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" - $(HIDE) rmdir "$(DESTDIR)$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true + $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html' + $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" + $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml' + $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" + $(HIDE) rmdir "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true .PHONY: uninstall-doc # Cleaning #################################################################### @@ -443,13 +531,19 @@ clean:: $(HIDE)rm -f $(VFILES:.v=.glob) $(HIDE)rm -f $(VFILES:.v=.tex) $(HIDE)rm -f $(VFILES:.v=.g.tex) + $(HIDE)rm -f pretty-timed-success.ok $(HIDE)rm -rf html mlihtml .PHONY: clean cleanall:: clean @# Extension point - $(SHOW)'CLEAN *.aux' + $(SHOW)'CLEAN *.aux *.timing' $(HIDE)rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux) + $(HIDE)rm -f $(TIME_OF_BUILD_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) + $(HIDE)rm -f $(VOFILES:.vo=.v.timing) + $(HIDE)rm -f $(VOFILES:.vo=.v.before-timing) + $(HIDE)rm -f $(VOFILES:.vo=.v.after-timing) + $(HIDE)rm -f $(VOFILES:.vo=.v.timing.diff) .PHONY: cleanall archclean:: @@ -518,9 +612,15 @@ $(filter-out $(MLLIBFILES:.mllib=.cmxs) $(MLPACKFILES:.mlpack=.cmxs) $(addsuffix $(SHOW)'[deprecated,use-mllib-or-mlpack] CAMLOPT -shared -o $@' $(HIDE)$(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) -shared -o $@ $< +ifneq (,$(TIMING)) +TIMING_EXTRA = > $<.$(TIMING_EXT) +else +TIMING_EXTRA = +endif + $(VOFILES): %.vo: %.v $(SHOW)COQC $< - $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $< + $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(COQFLAGS) $< $(TIMING_EXTRA) # FIXME ?merge with .vo / .vio ? $(GLOBFILES): %.glob: %.v @@ -530,6 +630,10 @@ $(VFILES:.v=.vio): %.vio: %.v $(SHOW)COQC -quick $< $(HIDE)$(TIMER) $(COQC) -quick $(COQDEBUG) $(COQFLAGS) $< +$(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing + $(SHOW)PYTHON TIMING-DIFF $< + $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-single-time-diff BEFORE=$*.before-timing AFTER=$*.after-timing TIME_OF_PRETTY_BUILD_FILE="$@" + $(BEAUTYFILES): %.v.beautified: %.v $(SHOW)'BEAUTIFY $<' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) -beautify $< @@ -556,7 +660,7 @@ $(GHTMLFILES): %.g.html: %.v %.glob # Dependency files ############################################################ -ifneq ($(filter-out archclean clean cleanall printenv,$(MAKECMDGOALS)),) +ifneq ($(filter-out archclean clean cleanall printenv make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff,$(MAKECMDGOALS)),) -include $(ALLDFILES) else ifeq ($(MAKECMDGOALS),) @@ -631,14 +735,14 @@ printenv:: .merlin: $(SHOW)'FILL .merlin' $(HIDE)echo 'FLG -rectypes' > .merlin - $(HIDE)echo "B $(COQLIB)" >> .merlin - $(HIDE)echo "S $(COQLIB)" >> .merlin + $(HIDE)echo 'B $(COQLIB)' >> .merlin + $(HIDE)echo 'S $(COQLIB)' >> .merlin $(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \ - echo "B $(COQLIB)$(d)" >> .merlin;) + echo 'B $(COQLIB)$(d)' >> .merlin;) $(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \ - echo "S $(COQLIB)$(d)" >> .merlin;) - $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo "B $(d)" >> .merlin;) - $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo "S $(d)" >> .merlin;) + echo 'S $(COQLIB)$(d)' >> .merlin;) + $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'B $(d)' >> .merlin;) + $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'S $(d)' >> .merlin;) $(HIDE)$(MAKE) merlin-hook -f "$(SELF)" .PHONY: merlin diff --git a/tools/TimeFileMaker.py b/tools/TimeFileMaker.py new file mode 100644 index 0000000000..a207c2171b --- /dev/null +++ b/tools/TimeFileMaker.py @@ -0,0 +1,187 @@ +#!/usr/bin/env python +from __future__ import with_statement +import os, sys, re + +# This script parses the output of `make TIMED=1` into a dictionary +# mapping names of compiled files to the number of minutes and seconds +# that they took to compile. + +STRIP_REG = re.compile('^(coq/|contrib/|)(?:theories/|src/)?') +STRIP_REP = r'\1' +INFINITY = '\xe2\x88\x9e' + +def reformat_time_string(time): + seconds, milliseconds = time.split('.') + seconds = int(seconds) + minutes, seconds = int(seconds / 60), seconds % 60 + return '%dm%02d.%ss' % (minutes, seconds, milliseconds) + +def get_times(file_name): + ''' + Reads the contents of file_name, which should be the output of + 'make TIMED=1', and parses it to construct a dict mapping file + names to compile durations, as strings. Removes common prefixes + using STRIP_REG and STRIP_REP. + ''' + if file_name == '-': + lines = sys.stdin.read() + else: + with open(file_name, 'r') as f: + lines = f.read() + reg = re.compile(r'^([^\s]+) \([^\)]*?user: ([0-9\.]+)[^\)]*?\)$', re.MULTILINE) + times = reg.findall(lines) + if all(time in ('0.00', '0.01') for name, time in times): + reg = re.compile(r'^([^\s]*) \([^\)]*?real: ([0-9\.]+)[^\)]*?\)$', re.MULTILINE) + times = reg.findall(lines) + if all(STRIP_REG.search(name.strip()) for name, time in times): + times = tuple((STRIP_REG.sub(STRIP_REP, name.strip()), time) for name, time in times) + return dict((name, reformat_time_string(time)) for name, time in times) + +def get_single_file_times(file_name): + ''' + Reads the contents of file_name, which should be the output of + 'coqc -time', and parses it to construct a dict mapping lines to + to compile durations, as strings. + ''' + if file_name == '-': + lines = sys.stdin.read() + else: + with open(file_name, 'r') as f: + lines = f.read() + reg = re.compile(r'^Chars ([0-9]+) - ([0-9]+) ([^ ]+) ([0-9\.]+) secs (.*)$', re.MULTILINE) + times = reg.findall(lines) + if len(times) == 0: return dict() + longest = max(max((len(start), len(stop))) for start, stop, name, time, extra in times) + FORMAT = 'Chars %%0%dd - %%0%dd %%s' % (longest, longest) + return dict((FORMAT % (int(start), int(stop), name), reformat_time_string(time)) for start, stop, name, time, extra in times) + +def make_sorting_key(times_dict, descending=True): + def get_key(name): + minutes, seconds = times_dict[name].replace('s', '').split('m') + def fix_sign(num): + return -num if descending else num + return (fix_sign(int(minutes)), fix_sign(float(seconds)), name) + return get_key + +def get_sorted_file_list_from_times_dict(times_dict, descending=True): + ''' + Takes the output dict of get_times and returns the list of keys, + sorted by duration. + ''' + return sorted(times_dict.keys(), key=make_sorting_key(times_dict, descending=descending)) + +def to_seconds(time): + ''' + Converts a string time into a number of seconds. + ''' + minutes, seconds = time.replace('s', '').split('m') + sign = -1 if time[0] == '-' else 1 + return sign * (abs(int(minutes)) * 60 + float(seconds)) + +def from_seconds(seconds, signed=False): + ''' + Converts a number of seconds into a string time. + ''' + sign = ('-' if seconds < 0 else '+') if signed else '' + seconds = abs(seconds) + minutes = int(seconds) / 60 + seconds -= minutes * 60 + full_seconds = int(seconds) + partial_seconds = int(100 * (seconds - full_seconds)) + return sign + '%dm%02d.%02ds' % (minutes, full_seconds, partial_seconds) + +def sum_times(times, signed=False): + ''' + Takes the values of an output from get_times, parses the time + strings, and returns their sum, in the same string format. + ''' + return from_seconds(sum(map(to_seconds, times)), signed=signed) + +def format_percentage(num, signed=True): + sign = ('-' if num < 0 else '+') if signed else '' + num = abs(num) + whole_part = int(num * 100) + frac_part = int(100 * (num * 100 - whole_part)) + return sign + '%d.%02d%%' % (whole_part, frac_part) + +def make_diff_table_string(left_times_dict, right_times_dict, + descending=True, + left_tag="After", tag="File Name", right_tag="Before", with_percent=True, + change_tag="Change", percent_change_tag="% Change"): + # We first get the names of all of the compiled files: all files + # that were compiled either before or after. + all_names_dict = dict() + all_names_dict.update(right_times_dict) + all_names_dict.update(left_times_dict) # do the left (after) last, so that we give precedence to those ones + if len(all_names_dict.keys()) == 0: return 'No timing data' + prediff_times = tuple((name, to_seconds(left_times_dict.get(name,'0m0.0s')), to_seconds(right_times_dict.get(name,'0m0.0s'))) + for name in all_names_dict.keys()) + diff_times_dict = dict((name, from_seconds(lseconds - rseconds, signed=True)) + for name, lseconds, rseconds in prediff_times) + percent_diff_times_dict = dict((name, ((format_percentage((lseconds - rseconds) / rseconds)) + if rseconds != 0 else (INFINITY if lseconds > 0 else 'N/A'))) + for name, lseconds, rseconds in prediff_times) + # update to sort by approximate difference, first + get_key = make_sorting_key(all_names_dict, descending=descending) + all_names_dict = dict((name, (abs(int(to_seconds(diff_times_dict[name]))), get_key(name))) + for name in all_names_dict.keys()) + names = sorted(all_names_dict.keys(), key=all_names_dict.get) + #names = get_sorted_file_list_from_times_dict(all_names_dict, descending=descending) + # set the widths of each of the columns by the longest thing to go in that column + left_sum = sum_times(left_times_dict.values()) + right_sum = sum_times(right_times_dict.values()) + left_sum_float = sum(map(to_seconds, left_times_dict.values())) + right_sum_float = sum(map(to_seconds, right_times_dict.values())) + diff_sum = from_seconds(left_sum_float - right_sum_float, signed=True) + percent_diff_sum = (format_percentage((left_sum_float - right_sum_float) / right_sum_float) + if right_sum_float > 0 else 'N/A') + left_width = max(max(map(len, ['N/A'] + list(left_times_dict.values()))), len(left_sum)) + right_width = max(max(map(len, ['N/A'] + list(right_times_dict.values()))), len(right_sum)) + far_right_width = max(max(map(len, ['N/A', change_tag] + list(diff_times_dict.values()))), len(diff_sum)) + far_far_right_width = max(max(map(len, ['N/A', percent_change_tag] + list(percent_diff_times_dict.values()))), len(percent_diff_sum)) + middle_width = max(map(len, names + [tag, "Total"])) + format_string = ("%%(left)-%ds | %%(middle)-%ds | %%(right)-%ds || %%(far_right)-%ds" + % (left_width, middle_width, right_width, far_right_width)) + if with_percent: + format_string += " | %%(far_far_right)-%ds" % far_far_right_width + header = format_string % {'left': left_tag, 'middle': tag, 'right': right_tag, 'far_right': change_tag, 'far_far_right': percent_change_tag} + total = format_string % {'left': left_sum, 'middle': "Total", 'right': right_sum, 'far_right': diff_sum, 'far_far_right': percent_diff_sum} + # separator to go between headers and body + sep = '-' * len(header) + # the representation of the default value (0), to get replaced by N/A + left_rep, right_rep, far_right_rep, far_far_right_rep = ("%%-%ds | " % left_width) % 0, (" | %%-%ds || " % right_width) % 0, ("|| %%-%ds" % far_right_width) % 0, ("| %%-%ds" % far_far_right_width) % 0 + return '\n'.join([header, sep, total, sep] + + [format_string % {'left': left_times_dict.get(name, 0), + 'middle': name, + 'right': right_times_dict.get(name, 0), + 'far_right': diff_times_dict.get(name, 0), + 'far_far_right': percent_diff_times_dict.get(name, 0)} + for name in names]).replace(left_rep, 'N/A'.center(len(left_rep) - 3) + ' | ').replace(right_rep, ' | ' + 'N/A'.center(len(right_rep) - 7) + ' || ').replace(far_right_rep, '|| ' + 'N/A'.center(len(far_right_rep) - 3)).replace(far_far_right_rep, '| ' + 'N/A'.center(len(far_far_right_rep) - 2)) + +def make_table_string(times_dict, + descending=True, + tag="Time"): + if len(times_dict.keys()) == 0: return 'No timing data' + # We first get the names of all of the compiled files, sorted by + # duration + names = get_sorted_file_list_from_times_dict(times_dict, descending=descending) + # compute the widths of the columns + times_width = max(max(map(len, times_dict.values())), len(sum_times(times_dict.values()))) + names_width = max(map(len, names + ["File Name", "Total"])) + format_string = "%%-%ds | %%-%ds" % (times_width, names_width) + header = format_string % (tag, "File Name") + total = format_string % (sum_times(times_dict.values()), + "Total") + sep = '-' * len(header) + return '\n'.join([header, sep, total, sep] + + [format_string % (times_dict[name], + name) + for name in names]) + +def print_or_write_table(table, files): + if len(files) == 0 or '-' in files: + print(table) + for file_name in files: + if file_name != '-': + with open(file_name, 'w') as f: + f.write(table) diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml index e4f1359774..0f38d19386 100644 --- a/tools/coq_makefile.ml +++ b/tools/coq_makefile.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -118,7 +118,7 @@ let makefile_template = let template = "/tools/CoqMakefile.in" in Coq_config.coqlib ^ template -let quote s = if String.contains s ' ' then "\"" ^ s ^ "\"" else s +let quote s = if String.contains s ' ' then "'" ^ s ^ "'" else s let generate_makefile oc conf_file local_file args project = let s = read_whole_file makefile_template in @@ -193,13 +193,23 @@ let generate_conf_includes oc { ml_includes; r_includes; q_includes } = (S.concat " " (map (fun ({ path },l) -> dash2 "R" path l) r_includes)) ;; +let windrive s = + if Coq_config.arch_is_win32 && Str.(string_match (regexp "^[a-zA-Z]:") s 0) + then Str.matched_string s + else s +;; + let generate_conf_coq_config oc args bypass_API = section oc "Coq configuration."; let src_dirs = if bypass_API then Coq_config.all_src_dirs else Coq_config.api_dirs @ Coq_config.plugins_dirs in Envars.print_config ~prefix_var_name:"COQMF_" oc src_dirs; - fprintf oc "COQMF_MAKEFILE=%s\n" (quote (List.hd args)); + if bypass_API then + Printf.fprintf oc "OCAML_API_FLAGS=\n" + else + Printf.fprintf oc "OCAML_API_FLAGS=-open API\n"; + fprintf oc "COQMF_WINDRIVE=%s\n" (windrive Coq_config.coqlib) ;; let generate_conf_files oc diff --git a/tools/coq_tex.ml b/tools/coq_tex.ml index e17011b39a..7bc547c684 100644 --- a/tools/coq_tex.ml +++ b/tools/coq_tex.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqc.ml b/tools/coqc.ml index c1f0182d9c..4595af6e88 100644 --- a/tools/coqc.ml +++ b/tools/coqc.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -86,16 +86,15 @@ let parse_args () = Envars.print_config stdout Coq_config.all_src_dirs; exit 0 - |"--print-version" :: _ -> + | ("-print-version" | "--print-version") :: _ -> Usage.machine_readable_version 0 (* Options for coqtop : a) options with 0 argument *) - | ("-notactics"|"-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac" + | ("-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac" |"-batch"|"-noinit"|"-nois"|"-noglob"|"-no-glob" - |"-q"|"-full"|"-profile"|"-just-parsing"|"-echo" |"-unsafe"|"-quiet" - |"-silent"|"-m"|"-xml"|"-v7"|"-v8"|"-beautify"|"-strict-implicit" - |"-dont-load-proofs"|"-load-proofs"|"-force-load-proofs" + |"-q"|"-profile"|"-just-parsing"|"-echo" |"-quiet" + |"-silent"|"-m"|"-xml"|"-beautify"|"-strict-implicit" |"-impredicative-set"|"-vm"|"-native-compiler" |"-indices-matter"|"-quick"|"-type-in-type" |"-async-proofs-always-delegate"|"-async-proofs-never-reopen-branch" @@ -110,7 +109,7 @@ let parse_args () = |"-load-ml-source"|"-require"|"-load-ml-object" |"-init-file"|"-dump-glob"|"-compat"|"-coqlib"|"-top" |"-async-proofs-j" |"-async-proofs-private-flags" |"-async-proofs" |"-w" - |"-o"|"-profile-ltac-cutoff" + |"-o"|"-profile-ltac-cutoff" as o) :: rem -> begin match rem with diff --git a/tools/coqdep.ml b/tools/coqdep.ml index cba9c3eb07..fd4be08b12 100644 --- a/tools/coqdep.ml +++ b/tools/coqdep.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdep_boot.ml b/tools/coqdep_boot.ml index 25f62d2bec..0cb18f6a86 100644 --- a/tools/coqdep_boot.ml +++ b/tools/coqdep_boot.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdep_common.ml b/tools/coqdep_common.ml index bf8bcd0c44..ab5196beb7 100644 --- a/tools/coqdep_common.ml +++ b/tools/coqdep_common.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdep_common.mli b/tools/coqdep_common.mli index 8c1787d315..99ec2cab4b 100644 --- a/tools/coqdep_common.mli +++ b/tools/coqdep_common.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdep_lexer.mli b/tools/coqdep_lexer.mli index bb17fdf9f4..8bef3d39e6 100644 --- a/tools/coqdep_lexer.mli +++ b/tools/coqdep_lexer.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll index 9224cdafe8..8eeb59898f 100644 --- a/tools/coqdep_lexer.mll +++ b/tools/coqdep_lexer.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -46,10 +46,9 @@ } let space = [' ' '\t' '\n' '\r'] -let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255'] -let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] -let identchar = - ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] +let lowercase = ['a'-'z'] +let uppercase = ['A'-'Z'] +let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9'] let caml_up_ident = uppercase identchar* let caml_low_ident = lowercase identchar* diff --git a/tools/coqdoc/alpha.ml b/tools/coqdoc/alpha.ml index 6a6db95567..961eac6465 100644 --- a/tools/coqdoc/alpha.ml +++ b/tools/coqdoc/alpha.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/alpha.mli b/tools/coqdoc/alpha.mli index f6d47a55de..7494f04020 100644 --- a/tools/coqdoc/alpha.mli +++ b/tools/coqdoc/alpha.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/cdglobals.ml b/tools/coqdoc/cdglobals.ml index ef203960b5..325df6137d 100644 --- a/tools/coqdoc/cdglobals.ml +++ b/tools/coqdoc/cdglobals.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/cpretty.mli b/tools/coqdoc/cpretty.mli index 58b19184e7..81fdd177c9 100644 --- a/tools/coqdoc/cpretty.mli +++ b/tools/coqdoc/cpretty.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/cpretty.mll b/tools/coqdoc/cpretty.mll index 919f37b91b..60a245dc4d 100644 --- a/tools/coqdoc/cpretty.mll +++ b/tools/coqdoc/cpretty.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/index.ml b/tools/coqdoc/index.ml index 4d118b9788..8ba6156709 100644 --- a/tools/coqdoc/index.ml +++ b/tools/coqdoc/index.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/index.mli b/tools/coqdoc/index.mli index e44bbd593a..490168edbf 100644 --- a/tools/coqdoc/index.mli +++ b/tools/coqdoc/index.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/main.ml b/tools/coqdoc/main.ml index fe4387381d..4c8e39bc27 100644 --- a/tools/coqdoc/main.ml +++ b/tools/coqdoc/main.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml index 9723905790..d043c4a584 100644 --- a/tools/coqdoc/output.ml +++ b/tools/coqdoc/output.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -693,25 +693,21 @@ module Html = struct printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s) let ident s loc = - if is_keyword s then begin - printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s) - end else begin - try - match loc with - | None -> raise Not_found - | Some loc -> - reference (translate s) (Index.find (get_module false) loc) - with Not_found -> - if is_tactic s then - printf "<span class=\"id\" title=\"tactic\">%s</span>" (translate s) - else - if !Cdglobals.interpolate && !in_doc (* always a var otherwise *) - then - try reference (translate s) (Index.find_string (get_module false) s) - with _ -> Tokens.output_tagged_ident_string s - else - Tokens.output_tagged_ident_string s - end + try + match loc with + | None -> raise Not_found + | Some loc -> + reference (translate s) (Index.find (get_module false) loc) + with Not_found -> + if is_tactic s then + printf "<span class=\"id\" title=\"tactic\">%s</span>" (translate s) + else if is_keyword s then + printf "<span class=\"id\" title=\"keyword\">%s</span>" (translate s) + else if !Cdglobals.interpolate && !in_doc (* always a var otherwise *) then + try reference (translate s) (Index.find_string (get_module false) s) + with Not_found -> Tokens.output_tagged_ident_string s + else + Tokens.output_tagged_ident_string s let proofbox () = printf "<font size=-2>☐</font>" diff --git a/tools/coqdoc/output.mli b/tools/coqdoc/output.mli index 235f2588c8..efc7058950 100644 --- a/tools/coqdoc/output.mli +++ b/tools/coqdoc/output.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/tokens.ml b/tools/coqdoc/tokens.ml index b6a1057aa8..12e92614e4 100644 --- a/tools/coqdoc/tokens.ml +++ b/tools/coqdoc/tokens.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqdoc/tokens.mli b/tools/coqdoc/tokens.mli index f07efedf9e..2972113895 100644 --- a/tools/coqdoc/tokens.mli +++ b/tools/coqdoc/tokens.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqmktop.ml b/tools/coqmktop.ml index 9bca135127..28a3c791cb 100644 --- a/tools/coqmktop.ml +++ b/tools/coqmktop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -175,8 +175,6 @@ let parse_args () = | "-top" :: rem -> top := true ; parse (op,fl) rem | "-no-start" :: rem -> no_start:=true; parse (op, fl) rem | "-echo" :: rem -> echo := true ; parse (op,fl) rem - | ("-v8"|"-full" as o) :: rem -> - Printf.eprintf "warning: option %s deprecated\n" o; parse (op,fl) rem (* Extra options with arity 0 or 1, directly passed to ocamlc/ocamlopt *) | ("-noassert"|"-compact"|"-g"|"-p"|"-thread"|"-dtypes" as o) :: rem -> diff --git a/tools/coqwc.mll b/tools/coqwc.mll index cd07d4216f..a0b6bfbbed 100644 --- a/tools/coqwc.mll +++ b/tools/coqwc.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/coqworkmgr.ml b/tools/coqworkmgr.ml index b8e69d6c6d..e1d1c60d72 100644 --- a/tools/coqworkmgr.ml +++ b/tools/coqworkmgr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml index 4dad16fd8c..a9da27ba23 100644 --- a/tools/fake_ide.ml +++ b/tools/fake_ide.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -293,15 +293,28 @@ let usage () = module Coqide = Spawn.Sync(struct end) let main = - Sys.set_signal Sys.sigpipe + if Sys.os_type = "Unix" then Sys.set_signal Sys.sigpipe (Sys.Signal_handle (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); let def_args = ["--xml_format=Ppcmds"; "-ideslave"] in - let coqtop_name, coqtop_args, input_file = match Sys.argv with - | [| _; f |] -> "coqtop", Array.of_list def_args, f + let coqtop_name = (* from ide/ideutils.ml *) + let prog_name = "fake_ide" in + let len_prog_name = String.length prog_name in + let fake_ide_path = Sys.executable_name in + let fake_ide_path_len = String.length fake_ide_path in + let pos = fake_ide_path_len - len_prog_name in + let rex = Str.regexp_string prog_name in + try + let i = Str.search_backward rex fake_ide_path pos in + String.sub fake_ide_path 0 i ^ "coqtop" ^ + String.sub fake_ide_path (i + len_prog_name) + (fake_ide_path_len - i - len_prog_name) + with Not_found -> assert false in + let coqtop_args, input_file = match Sys.argv with + | [| _; f |] -> Array.of_list def_args, f | [| _; f; ct |] -> let ct = Str.split (Str.regexp " ") ct in - List.hd ct, Array.of_list (def_args @ List.tl ct), f + Array.of_list (def_args @ ct), f | _ -> usage () in let inc = if input_file = "-" then stdin else open_in input_file in let coq = diff --git a/tools/gallina.ml b/tools/gallina.ml index 0bf98a8f0f..7a29c6cf5e 100644 --- a/tools/gallina.ml +++ b/tools/gallina.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/gallina_lexer.mll b/tools/gallina_lexer.mll index 432b18e645..3e118b85fd 100644 --- a/tools/gallina_lexer.mll +++ b/tools/gallina_lexer.mll @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/tools/make-both-single-timing-files.py b/tools/make-both-single-timing-files.py new file mode 100755 index 0000000000..2d33503c36 --- /dev/null +++ b/tools/make-both-single-timing-files.py @@ -0,0 +1,18 @@ +#!/usr/bin/env python +import sys +from TimeFileMaker import * + +if __name__ == '__main__': + USAGE = 'Usage: %s AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0] + HELP_STRING = r'''Formats timing information from the output of two invocations of `coqc -time` into a sorted table''' + if len(sys.argv) < 3 or '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(USAGE) + if '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(HELP_STRING) + if len(sys.argv) == 2: sys.exit(0) + sys.exit(1) + else: + left_dict = get_single_file_times(sys.argv[1]) + right_dict = get_single_file_times(sys.argv[2]) + table = make_diff_table_string(left_dict, right_dict, tag="Code") + print_or_write_table(table, sys.argv[3:]) diff --git a/tools/make-both-time-files.py b/tools/make-both-time-files.py new file mode 100755 index 0000000000..69ec5a6631 --- /dev/null +++ b/tools/make-both-time-files.py @@ -0,0 +1,22 @@ +#!/usr/bin/env python +import sys +from TimeFileMaker import * + +if __name__ == '__main__': + USAGE = 'Usage: %s AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0] + HELP_STRING = r'''Formats timing information from the output of two invocations of `make TIMED=1` into a sorted table. + +The input is expected to contain lines in the format: +FILE_NAME (...user: NUMBER_IN_SECONDS...) +''' + if len(sys.argv) < 3 or '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(USAGE) + if '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(HELP_STRING) + if len(sys.argv) == 2: sys.exit(0) + sys.exit(1) + else: + left_dict = get_times(sys.argv[1]) + right_dict = get_times(sys.argv[2]) + table = make_diff_table_string(left_dict, right_dict) + print_or_write_table(table, sys.argv[3:]) diff --git a/tools/make-one-time-file.py b/tools/make-one-time-file.py new file mode 100755 index 0000000000..e66136df9d --- /dev/null +++ b/tools/make-one-time-file.py @@ -0,0 +1,21 @@ +#!/usr/bin/env python +import sys +from TimeFileMaker import * + +if __name__ == '__main__': + USAGE = 'Usage: %s FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0] + HELP_STRING = r'''Formats timing information from the output of `make TIMED=1` into a sorted table. + +The input is expected to contain lines in the format: +FILE_NAME (...user: NUMBER_IN_SECONDS...) +''' + if len(sys.argv) < 2 or '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(USAGE) + if '--help' in sys.argv[1:] or '-h' in sys.argv[1:]: + print(HELP_STRING) + if len(sys.argv) == 2: sys.exit(0) + sys.exit(1) + else: + times_dict = get_times(sys.argv[1]) + table = make_table_string(times_dict) + print_or_write_table(table, sys.argv[2:]) diff --git a/tools/ocamllibdep.mll b/tools/ocamllibdep.mll index 5d11e30089..308bb582ac 100644 --- a/tools/ocamllibdep.mll +++ b/tools/ocamllibdep.mll @@ -20,10 +20,9 @@ } let space = [' ' '\t' '\n' '\r'] -let lowercase = ['a'-'z' '\223'-'\246' '\248'-'\255'] -let uppercase = ['A'-'Z' '\192'-'\214' '\216'-'\222'] -let identchar = - ['A'-'Z' 'a'-'z' '_' '\192'-'\214' '\216'-'\246' '\248'-'\255' '\'' '0'-'9'] +let lowercase = ['a'-'z'] +let uppercase = ['A'-'Z'] +let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9'] let caml_up_ident = uppercase identchar* let caml_low_ident = lowercase identchar* diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml index f36d0c348e..326ef54715 100644 --- a/toplevel/coqinit.ml +++ b/toplevel/coqinit.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -127,7 +127,8 @@ let init_ocaml_path () = List.iter add_subdir Coq_config.all_src_dirs let get_compat_version ?(allow_old = true) = function - | "8.7" -> Flags.Current + | "8.8" -> Flags.Current + | "8.7" -> Flags.V8_7 | "8.6" -> Flags.V8_6 | "8.5" -> Flags.V8_5 | ("8.4" | "8.3" | "8.2" | "8.1" | "8.0") as s -> diff --git a/toplevel/coqinit.mli b/toplevel/coqinit.mli index 787dfb61a9..bf8558d10a 100644 --- a/toplevel/coqinit.mli +++ b/toplevel/coqinit.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml index 0b0ef67176..d76703d980 100644 --- a/toplevel/coqloop.ml +++ b/toplevel/coqloop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/coqloop.mli b/toplevel/coqloop.mli index a0e2f1e02a..8eaa68914e 100644 --- a/toplevel/coqloop.mli +++ b/toplevel/coqloop.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 5f0716fd9f..8fe27b3b97 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -58,16 +58,18 @@ let init_color () = match colors with | None -> (** Default colors *) - Topfmt.init_color_output () + Topfmt.init_terminal_output ~color:true | Some "" -> (** No color output *) - () + Topfmt.init_terminal_output ~color:false | Some s -> (** Overwrite all colors *) Topfmt.clear_styles (); Topfmt.parse_color_config s; - Topfmt.init_color_output () + Topfmt.init_terminal_output ~color:true end + else + Topfmt.init_terminal_output ~color:false let toploop_init = ref begin fun x -> let () = init_color () in @@ -136,8 +138,6 @@ let set_toplevel_name dir = if Names.DirPath.is_empty dir then user_err Pp.(str "Need a non empty toplevel module name"); toplevel_name := dir -let remove_top_ml () = Mltop.remove () - let warn_deprecated_inputstate = CWarnings.create ~name:"deprecated-inputstate" ~category:"deprecated" (fun () -> strbrk "The inputstate option is deprecated and discouraged.") @@ -207,6 +207,7 @@ let add_compat_require v = match v with | Flags.V8_5 -> add_require "Coq.Compat.Coq85" | Flags.V8_6 -> add_require "Coq.Compat.Coq86" + | Flags.V8_7 -> add_require "Coq.Compat.Coq87" | Flags.VOld | Flags.Current -> () let compile_list = ref ([] : (bool * string) list) @@ -582,25 +583,10 @@ let parse_args arglist = |"-type-in-type" -> set_type_in_type () |"-unicode" -> add_require "Utf8_core" |"-v"|"--version" -> Usage.version (exitcode ()) - |"--print-version" -> Usage.machine_readable_version (exitcode ()) + |"-print-version"|"--print-version" -> Usage.machine_readable_version (exitcode ()) |"-where" -> print_where := true |"-xml" -> Flags.xml_export := true - (* Deprecated options *) - |"-byte" -> warning "option -byte deprecated, call with .byte suffix" - |"-opt" -> warning "option -opt deprecated, call with .opt suffix" - |"-full" -> warning "option -full deprecated" - |"-notactics" -> warning "Obsolete option \"-notactics\"."; remove_top_ml () - |"-emacs-U" -> - warning "Obsolete option \"-emacs-U\", use -emacs instead."; set_emacs () - |"-v7" -> user_err Pp.(str "This version of Coq does not support v7 syntax") - |"-v8" -> warning "Obsolete option \"-v8\"." - |"-lazy-load-proofs" -> warning "Obsolete option \"-lazy-load-proofs\"." - |"-dont-load-proofs" -> warning "Obsolete option \"-dont-load-proofs\"." - |"-force-load-proofs" -> warning "Obsolete option \"-force-load-proofs\"." - |"-unsafe" -> warning "Obsolete option \"-unsafe\"."; ignore (next ()) - |"-quality" -> warning "Obsolete option \"-quality\"." - (* Unknown option *) | s -> extras := s :: !extras end; @@ -611,6 +597,7 @@ let parse_args arglist = with any -> fatal_error any let init_toplevel arglist = + Profile.init_profile (); init_gc (); Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *) let init_feeder = Feedback.add_feeder coqtop_init_feed in diff --git a/toplevel/coqtop.mli b/toplevel/coqtop.mli index c9d1ba45d5..892d64d917 100644 --- a/toplevel/coqtop.mli +++ b/toplevel/coqtop.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/usage.ml b/toplevel/usage.ml index b50fbfda0a..962bb4302b 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -57,7 +57,7 @@ let print_usage_channel co command = \n -where print Coq's standard library location and exit\ \n -config, --config print Coq's configuration information and exit\ \n -v, --version print Coq version and exit\ -\n --print-version print Coq version in easy to parse format and exit\ +\n -print-version print Coq version in easy to parse format and exit\ \n -list-tags print highlight color tags known by Coq and exit\ \n\ \n -quiet unset display of extra information (implies -w \"-all\")\ diff --git a/toplevel/usage.mli b/toplevel/usage.mli index c46c7a79c0..48b4792de0 100644 --- a/toplevel/usage.mli +++ b/toplevel/usage.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index 74c7663ca5..fe853c093d 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli index bbc095c687..77c4f44e12 100644 --- a/toplevel/vernac.mli +++ b/toplevel/vernac.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml index 726115653b..6711b14da0 100644 --- a/vernac/assumptions.ml +++ b/vernac/assumptions.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -187,7 +187,7 @@ let rec traverse current ctx accu t = match kind_of_term t with let body () = id |> Global.lookup_named |> NamedDecl.get_value in traverse_object accu body (VarRef id) | Const (kn, _) -> - let body () = Global.body_of_constant_body (lookup_constant kn) in + let body () = Option.map fst (Global.body_of_constant_body (lookup_constant kn)) in traverse_object accu body (ConstRef kn) | Ind ((mind, _) as ind, _) -> traverse_inductive accu mind (IndRef ind) @@ -200,7 +200,7 @@ let rec traverse current ctx accu t = match kind_of_term t with | Lambda(_,_,oty), Const (kn, _) when Vars.noccurn 1 oty && not (Declareops.constant_has_body (lookup_constant kn)) -> - let body () = Global.body_of_constant_body (lookup_constant kn) in + let body () = Option.map fst (Global.body_of_constant_body (lookup_constant kn)) in traverse_object ~inhabits:(current,ctx,Vars.subst1 mkProp oty) accu body (ConstRef kn) | _ -> @@ -311,10 +311,7 @@ let traverse current t = (** Hopefully bullet-proof function to recover the type of a constant. It just ignores all the universe stuff. There are many issues that can arise when considering terms out of any valid environment, so use with caution. *) -let type_of_constant cb = match cb.Declarations.const_type with -| Declarations.RegularArity ty -> ty -| Declarations.TemplateArity (ctx, arity) -> - Term.mkArity (ctx, Sorts.sort_of_univ arity.Declarations.template_level) +let type_of_constant cb = cb.Declarations.const_type let assumptions ?(add_opaque=false) ?(add_transparent=false) st gr t = let (idts, knst) = st in diff --git a/vernac/assumptions.mli b/vernac/assumptions.mli index 0726757839..46730f8247 100644 --- a/vernac/assumptions.mli +++ b/vernac/assumptions.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml index 9e6e5e313b..59920742d8 100644 --- a/vernac/auto_ind_decl.ml +++ b/vernac/auto_ind_decl.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -105,7 +105,7 @@ let mkFullInd (ind,u) n = else mkIndU (ind,u) let check_bool_is_defined () = - try let _ = Global.type_of_global_unsafe Coqlib.glob_bool in () + try let _ = Global.type_of_global_in_context (Global.env ()) Coqlib.glob_bool in () with e when CErrors.noncritical e -> raise (UndefinedCst "bool") let beq_scheme_kind_aux = ref (fun _ -> failwith "Undefined") diff --git a/vernac/auto_ind_decl.mli b/vernac/auto_ind_decl.mli index 60232ba8f4..d841cca111 100644 --- a/vernac/auto_ind_decl.mli +++ b/vernac/auto_ind_decl.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/class.ml b/vernac/class.ml index 104f3c1db5..be682977e5 100644 --- a/vernac/class.ml +++ b/vernac/class.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -62,7 +62,9 @@ let explain_coercion_error g = function (* Verifications pour l'ajout d'une classe *) let check_reference_arity ref = - if not (Reductionops.is_arity (Global.env()) Evd.empty (EConstr.of_constr (Global.type_of_global_unsafe ref))) (** FIXME *) then + let env = Global.env () in + let c, _ = Global.type_of_global_in_context env ref in + if not (Reductionops.is_arity env Evd.empty (EConstr.of_constr c)) (** FIXME *) then raise (CoercionError (NotAClass ref)) let check_arity = function @@ -252,7 +254,7 @@ let warn_uniform_inheritance = let add_new_coercion_core coef stre poly source target isid = check_source source; - let t = Global.type_of_global_unsafe coef in + let t, _ = Global.type_of_global_in_context (Global.env ()) coef in if coercion_exists coef then raise (CoercionError AlreadyExists); let tg,lp = prods_of t in let llp = List.length lp in diff --git a/vernac/class.mli b/vernac/class.mli index 5f9ae28f62..29486073bd 100644 --- a/vernac/class.mli +++ b/vernac/class.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/classes.ml b/vernac/classes.ml index 2e8ebb8531..ab1892a18e 100644 --- a/vernac/classes.ml +++ b/vernac/classes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -68,7 +68,7 @@ let _ = 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 instance, _ = Global.type_of_global_in_context (Global.env ()) c in let _, r = decompose_prod_assum instance in match class_of_constr Evd.empty (EConstr.of_constr r) with | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob @@ -164,7 +164,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p let ctx'' = ctx' @ ctx in let (k, u), args = Typeclasses.dest_class_app (push_rel_context ctx'' env) !evars (EConstr.of_constr c) in let u = EConstr.EInstance.kind !evars u in - let cl, u = Typeclasses.typeclass_univ_instance (k, u) in + let cl = Typeclasses.typeclass_univ_instance (k, u) in let _, args = List.fold_right (fun decl (args, args') -> match decl with diff --git a/vernac/classes.mli b/vernac/classes.mli index 69ea841582..fc2fdbbf34 100644 --- a/vernac/classes.mli +++ b/vernac/classes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/command.ml b/vernac/command.ml index fd49e53243..e04bebe33b 100644 --- a/vernac/command.ml +++ b/vernac/command.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -383,7 +383,7 @@ let make_conclusion_flexible evdref ty poly = | Type u -> (match Univ.universe_level u with | Some u -> - evdref := Evd.make_flexible_variable !evdref true u + evdref := Evd.make_flexible_variable !evdref ~algebraic:true u | None -> ()) | _ -> () else () diff --git a/vernac/command.mli b/vernac/command.mli index 1887885de9..8d17f27c30 100644 --- a/vernac/command.mli +++ b/vernac/command.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/discharge.ml b/vernac/discharge.ml index 18f93334b1..474c0b4dd2 100644 --- a/vernac/discharge.ml +++ b/vernac/discharge.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -77,42 +77,36 @@ let refresh_polymorphic_type_of_inductive (_,mip) = let ctx = List.rev mip.mind_arity_ctxt in mkArity (List.rev ctx, Type ar.template_level), true -let process_inductive (sechyps,abs_ctx) modlist mib = +let process_inductive (sechyps,_,_ as info) modlist mib = + let sechyps = Lib.named_of_variable_context sechyps in let nparams = mib.mind_nparams in - let subst, univs = + let subst, ind_univs = match mib.mind_universes with - | Monomorphic_ind ctx -> Univ.Instance.empty, ctx + | Monomorphic_ind ctx -> Univ.empty_level_subst, Monomorphic_ind_entry ctx | Polymorphic_ind auctx -> - Univ.AUContext.instance auctx, Univ.instantiate_univ_context auctx + let subst, auctx = Lib.discharge_abstract_universe_context info auctx in + let auctx = Univ.AUContext.repr auctx in + subst, Polymorphic_ind_entry auctx | Cumulative_ind cumi -> let auctx = Univ.ACumulativityInfo.univ_context cumi in - Univ.AUContext.instance auctx, Univ.instantiate_univ_context auctx + let subst, auctx = Lib.discharge_abstract_universe_context info auctx in + let auctx = Univ.AUContext.repr auctx in + subst, Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context auctx) in + let discharge c = Vars.subst_univs_level_constr subst (expmod_constr modlist c) in let inds = Array.map_to_list (fun mip -> let ty, template = refresh_polymorphic_type_of_inductive (mib,mip) in - let arity = expmod_constr modlist ty in - let arity = Vars.subst_instance_constr subst arity in - let lc = Array.map - (fun c -> Vars.subst_instance_constr subst (expmod_constr modlist c)) - mip.mind_user_lc - in + let arity = discharge ty in + let lc = Array.map discharge mip.mind_user_lc in (mip.mind_typename, arity, template, Array.to_list mip.mind_consnames, Array.to_list lc)) mib.mind_packets in - let sechyps' = Context.Named.map (expmod_constr modlist) sechyps in + let sechyps' = Context.Named.map discharge sechyps in let (params',inds') = abstract_inductive sechyps' nparams inds in - let abs_ctx = Univ.instantiate_univ_context abs_ctx in - let univs = Univ.UContext.union abs_ctx univs in - let ind_univs = - match mib.mind_universes with - | Monomorphic_ind _ -> Monomorphic_ind_entry univs - | Polymorphic_ind _ -> Polymorphic_ind_entry univs - | Cumulative_ind _ -> - Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context univs) in let record = match mib.mind_record with | Some (Some (id, _, _)) -> Some (Some id) | Some None -> Some None diff --git a/vernac/discharge.mli b/vernac/discharge.mli index 3845c04a11..c8c7e3b8b8 100644 --- a/vernac/discharge.mli +++ b/vernac/discharge.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -11,5 +11,4 @@ open Entries open Opaqueproof val process_inductive : - ((Term.constr, Term.constr) Context.Named.pt * Univ.abstract_universe_context) - -> work_list -> mutual_inductive_body -> mutual_inductive_entry + Lib.abstr_info -> work_list -> mutual_inductive_body -> mutual_inductive_entry diff --git a/vernac/explainErr.ml b/vernac/explainErr.ml index 021fde961e..2178a7caa0 100644 --- a/vernac/explainErr.ml +++ b/vernac/explainErr.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -18,7 +18,7 @@ let guill s = str "\"" ++ str s ++ str "\"" (** Invariant : exceptions embedded in EvaluatedError satisfy Errors.noncritical *) -exception EvaluatedError of std_ppcmds * exn option +exception EvaluatedError of Pp.t * exn option (** Registration of generic errors Nota: explain_exn does NOT end with a newline anymore! diff --git a/vernac/explainErr.mli b/vernac/explainErr.mli index 9202729cee..0cbd71fa4f 100644 --- a/vernac/explainErr.mli +++ b/vernac/explainErr.mli @@ -1,13 +1,13 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) (** Toplevel Exception *) -exception EvaluatedError of Pp.std_ppcmds * exn option +exception EvaluatedError of Pp.t * exn option (** Pre-explain a vernac interpretation error *) @@ -16,6 +16,6 @@ val process_vernac_interp_error : ?allow_uncaught:bool -> Util.iexn -> Util.iexn (** General explain function. Should not be used directly now, see instead function [Errors.print] and variants *) -val explain_exn_default : exn -> Pp.std_ppcmds +val explain_exn_default : exn -> Pp.t -val register_additional_error_info : (Util.iexn -> (Pp.std_ppcmds option Loc.located) option) -> unit +val register_additional_error_info : (Util.iexn -> (Pp.t option Loc.located) option) -> unit diff --git a/vernac/himsg.ml b/vernac/himsg.ml index ce91e1a09f..0e51849058 100644 --- a/vernac/himsg.ml +++ b/vernac/himsg.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -783,7 +783,7 @@ let pr_constraints printenv env sigma evars cstrs = let explain_unsatisfiable_constraints env sigma constr comp = let (_, constraints) = Evd.extract_all_conv_pbs sigma in - let undef = Evd.undefined_map (Evarutil.nf_evar_map_undefined sigma) in + let undef = Evd.undefined_map sigma in (** Only keep evars that are subject to resolution and members of the given component. *) let is_kept evk evi = match comp with @@ -909,6 +909,7 @@ let explain_not_match_error = function quote (Printer.safe_pr_lconstr_env env Evd.empty t2) | IncompatibleConstraints cst -> str " the expected (polymorphic) constraints do not imply " ++ + let cst = Univ.AUContext.instantiate (Univ.AUContext.instance cst) cst in quote (Univ.pr_constraints (Termops.pr_evd_level Evd.empty) cst) let explain_signature_mismatch l spec why = diff --git a/vernac/himsg.mli b/vernac/himsg.mli index 6915ea9214..5b91f9e682 100644 --- a/vernac/himsg.mli +++ b/vernac/himsg.mli @@ -1,12 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -open Pp open Indtypes open Environ open Type_errors @@ -18,28 +17,28 @@ open Logic (** This module provides functions to explain the type errors. *) -val explain_type_error : env -> Evd.evar_map -> type_error -> std_ppcmds +val explain_type_error : env -> Evd.evar_map -> type_error -> Pp.t -val explain_pretype_error : env -> Evd.evar_map -> pretype_error -> std_ppcmds +val explain_pretype_error : env -> Evd.evar_map -> pretype_error -> Pp.t -val explain_inductive_error : inductive_error -> std_ppcmds +val explain_inductive_error : inductive_error -> Pp.t -val explain_typeclass_error : env -> typeclass_error -> Pp.std_ppcmds +val explain_typeclass_error : env -> typeclass_error -> Pp.t -val explain_recursion_scheme_error : recursion_scheme_error -> std_ppcmds +val explain_recursion_scheme_error : recursion_scheme_error -> Pp.t -val explain_refiner_error : refiner_error -> std_ppcmds +val explain_refiner_error : refiner_error -> Pp.t val explain_pattern_matching_error : - env -> Evd.evar_map -> pattern_matching_error -> std_ppcmds + env -> Evd.evar_map -> pattern_matching_error -> Pp.t val explain_reduction_tactic_error : - Tacred.reduction_tactic_error -> std_ppcmds + Tacred.reduction_tactic_error -> Pp.t -val explain_module_error : Modops.module_typing_error -> std_ppcmds +val explain_module_error : Modops.module_typing_error -> Pp.t val explain_module_internalization_error : - Modintern.module_internalization_error -> std_ppcmds + Modintern.module_internalization_error -> Pp.t val map_pguard_error : ('c -> 'd) -> 'c pguard_error -> 'd pguard_error val map_ptype_error : ('c -> 'd) -> ('c, 'c) ptype_error -> ('d, 'd) ptype_error diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml index 44d6f37cc6..6ea8bc7f2c 100644 --- a/vernac/indschemes.ml +++ b/vernac/indschemes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -109,13 +109,17 @@ let _ = let define id internal ctx c t = let f = declare_constant ~internal in + let _, univs = Evd.universe_context ctx in + let univs = + if Flags.is_universe_polymorphism () then Polymorphic_const_entry univs + else Monomorphic_const_entry univs + in let kn = f id (DefinitionEntry { const_entry_body = c; const_entry_secctx = None; const_entry_type = t; - const_entry_polymorphic = Flags.is_universe_polymorphism (); - const_entry_universes = snd (Evd.universe_context ctx); + const_entry_universes = univs; const_entry_opaque = false; const_entry_inline_code = false; const_entry_feedback = None; @@ -383,9 +387,8 @@ let do_mutual_induction_scheme lnamedepindsort = match inst with | None -> let _, ctx = Global.type_of_global_in_context env0 (IndRef ind) in - let ctxs = Univ.ContextSet.of_context ctx in - let evd = Evd.from_ctx (Evd.evar_universe_context_of ctxs) in - let u = Univ.UContext.instance ctx in + let u, ctx = Universes.fresh_instance_from ctx None in + let evd = Evd.from_ctx (Evd.evar_universe_context_of ctx) in evd, (ind,u), Some u | Some ui -> evd, (ind, ui), inst in diff --git a/vernac/indschemes.mli b/vernac/indschemes.mli index 0f559d2bd8..076e4938fd 100644 --- a/vernac/indschemes.mli +++ b/vernac/indschemes.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/lemmas.ml b/vernac/lemmas.ml index 5bf419caf5..645320c603 100644 --- a/vernac/lemmas.ml +++ b/vernac/lemmas.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -44,12 +44,15 @@ let call_hook fix_exn hook l c = (* Support for mutually proved theorems *) -let retrieve_first_recthm = function +let retrieve_first_recthm uctx = function | VarRef id -> (NamedDecl.get_value (Global.lookup_named id),variable_opacity id) | ConstRef cst -> let cb = Global.lookup_constant cst in - (Global.body_of_constant_body cb, is_opaque cb) + let (_, uctx) = UState.universe_context uctx in + let inst = Univ.UContext.instance uctx in + let map (c, ctx) = Vars.subst_instance_constr inst c in + (Option.map map (Global.body_of_constant_body cb), is_opaque cb) | _ -> assert false let adjust_guardness_conditions const = function @@ -412,7 +415,7 @@ let start_proof_with_initialization kind ctx recguard thms snl hook = let other_thms_data = if List.is_empty other_thms then [] else (* there are several theorems defined mutually *) - let body,opaq = retrieve_first_recthm ref in + let body,opaq = retrieve_first_recthm ctx ref in let subst = Evd.evar_universe_context_subst ctx in let norm c = Universes.subst_opt_univs_constr subst c in let ctx = UState.context_set (*FIXME*) ctx in diff --git a/vernac/lemmas.mli b/vernac/lemmas.mli index a9c0d99f30..a8c09c0fed 100644 --- a/vernac/lemmas.mli +++ b/vernac/lemmas.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/locality.ml b/vernac/locality.ml index a25acb0d34..054a451a46 100644 --- a/vernac/locality.ml +++ b/vernac/locality.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/locality.mli b/vernac/locality.mli index 2ec392eefc..c1c45d6b0f 100644 --- a/vernac/locality.mli +++ b/vernac/locality.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml index a114553cdb..c0974d0a7c 100644 --- a/vernac/metasyntax.ml +++ b/vernac/metasyntax.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -615,46 +615,71 @@ let define_keywords = function let distribute a ll = List.map (fun l -> a @ l) ll - (* Expand LIST1(t,sep) into the combination of t and t;sep;LIST1(t,sep) - as many times as expected in [n] argument *) -let rec expand_list_rule typ tkl x n i hds ll = - if Int.equal i n then + (* Expand LIST1(t,sep);sep;t;...;t (with the trailing pattern + occurring p times, possibly p=0) into the combination of + t;sep;t;...;t;sep;t (p+1 times) + t;sep;t;...;t;sep;t;sep;t (p+2 times) + ... + t;sep;t;...;t;sep;t;...;t;sep;t (p+n times) + t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *) + +let expand_list_rule typ tkl x n p ll = + let camlp4_message_name = Some (add_suffix x ("_"^string_of_int n)) in + let main = GramConstrNonTerminal (ETConstr typ, camlp4_message_name) in + let tks = List.map (fun x -> GramConstrTerminal x) tkl in + let rec aux i hds ll = + if i < p then aux (i+1) (main :: tks @ hds) ll + else if Int.equal i (p+n) then let hds = - GramConstrListMark (n,true) :: hds + GramConstrListMark (p+n,true,p) :: hds @ [GramConstrNonTerminal (ETConstrList (typ,tkl), Some x)] in distribute hds ll else - let camlp4_message_name = Some (add_suffix x ("_"^string_of_int n)) in - let main = GramConstrNonTerminal (ETConstr typ, camlp4_message_name) in - let tks = List.map (fun x -> GramConstrTerminal x) tkl in - distribute (GramConstrListMark (i+1,false) :: hds @ [main]) ll @ - expand_list_rule typ tkl x n (i+1) (main :: tks @ hds) ll + distribute (GramConstrListMark (i+1,false,p) :: hds @ [main]) ll @ + aux (i+1) (main :: tks @ hds) ll in + aux 0 [] ll + +let is_constr_typ typ x etyps = + match List.assoc x etyps with + | ETConstr typ' -> typ = typ' + | _ -> false + +let include_possible_similar_trailing_pattern typ etyps sl l = + let rec aux n = function + | Terminal s :: sl, Terminal s'::l' when s = s' -> aux n (sl,l') + | [], NonTerminal x ::l' when is_constr_typ typ x etyps -> try_aux n l' + | _ -> raise Exit + and try_aux n l = + try aux (n+1) (sl,l) + with Exit -> n,l in + try_aux 0 l let make_production etyps symbols = - let prod = - List.fold_right - (fun t ll -> match t with - | NonTerminal m -> - let typ = List.assoc m etyps in - distribute [GramConstrNonTerminal (typ, Some m)] ll - | Terminal s -> - distribute [GramConstrTerminal (CLexer.terminal s)] ll - | Break _ -> - ll - | SProdList (x,sl) -> - let tkl = List.flatten - (List.map (function Terminal s -> [CLexer.terminal s] - | Break _ -> [] - | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in - match List.assoc x etyps with - | ETConstr typ -> expand_list_rule typ tkl x 1 0 [] ll - | ETBinder o -> - distribute - [GramConstrNonTerminal (ETBinderList (o,tkl), Some x)] ll - | _ -> - user_err Pp.(str "Components of recursive patterns in notation must be terms or binders.")) - symbols [[]] in - List.map define_keywords prod + let rec aux = function + | [] -> [[]] + | NonTerminal m :: l -> + let typ = List.assoc m etyps in + distribute [GramConstrNonTerminal (typ, Some m)] (aux l) + | Terminal s :: l -> + distribute [GramConstrTerminal (CLexer.terminal s)] (aux l) + | Break _ :: l -> + aux l + | SProdList (x,sl) :: l -> + let tkl = List.flatten + (List.map (function Terminal s -> [CLexer.terminal s] + | Break _ -> [] + | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in + match List.assoc x etyps with + | ETConstr typ -> + let p,l' = include_possible_similar_trailing_pattern typ etyps sl l in + expand_list_rule typ tkl x 1 p (aux l') + | ETBinder o -> + distribute + [GramConstrNonTerminal (ETBinderList (o,tkl), Some x)] (aux l) + | _ -> + user_err Pp.(str "Components of recursive patterns in notation must be terms or binders.") in + let prods = aux symbols in + List.map define_keywords prods let rec find_symbols c_current c_next c_last = function | [] -> [] @@ -1056,7 +1081,7 @@ module SynData = struct extra : (string * string) list; (* XXX: Callback to printing, must remove *) - msgs : ((std_ppcmds -> unit) * std_ppcmds) list; + msgs : ((Pp.t -> unit) * Pp.t) list; (* Fields for internalization *) recvars : (Id.t * Id.t) list; @@ -1164,11 +1189,11 @@ let open_notation i (_, nobj) = let scope = nobj.notobj_scope in let (ntn, df) = nobj.notobj_notation in let pat = nobj.notobj_interp in - let fresh = not (Notation.exists_notation_in_scope scope ntn pat) in + let onlyprint = nobj.notobj_onlyprint in + let fresh = not (Notation.exists_notation_in_scope scope ntn onlyprint pat) in let active = is_active_compat nobj.notobj_compat in if Int.equal i 1 && fresh && active then begin (* Declare the interpretation *) - let onlyprint = nobj.notobj_onlyprint in let () = Notation.declare_notation_interpretation ntn scope pat df ~onlyprint in (* Declare the uninterpretation *) if not nobj.notobj_onlyparse then diff --git a/vernac/metasyntax.mli b/vernac/metasyntax.mli index 57c1204022..9cd00cbcb4 100644 --- a/vernac/metasyntax.mli +++ b/vernac/metasyntax.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -52,7 +52,7 @@ val add_syntactic_definition : Id.t -> Id.t list * constr_expr -> (** Print the Camlp4 state of a grammar *) -val pr_grammar : string -> Pp.std_ppcmds +val pr_grammar : string -> Pp.t type any_entry = AnyEntry : 'a Pcoq.Gram.entry -> any_entry diff --git a/vernac/mltop.ml b/vernac/mltop.ml index 056ffca5c8..e8a0ba3dda 100644 --- a/vernac/mltop.ml +++ b/vernac/mltop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/mltop.mli b/vernac/mltop.mli index 6633cb9372..324a66d382 100644 --- a/vernac/mltop.mli +++ b/vernac/mltop.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -83,6 +83,6 @@ val declare_ml_modules : Vernacexpr.locality_flag -> string list -> unit (** {5 Utilities} *) -val print_ml_path : unit -> Pp.std_ppcmds -val print_ml_modules : unit -> Pp.std_ppcmds -val print_gc : unit -> Pp.std_ppcmds +val print_ml_path : unit -> Pp.t +val print_ml_modules : unit -> Pp.t +val print_gc : unit -> Pp.t diff --git a/vernac/obligations.ml b/vernac/obligations.ml index c09cc19776..a4fe49020a 100644 --- a/vernac/obligations.ml +++ b/vernac/obligations.ml @@ -285,7 +285,7 @@ type obligation = { obl_name : Id.t; obl_type : types; obl_location : Evar_kinds.t Loc.located; - obl_body : constant obligation_body option; + obl_body : pconstant obligation_body option; obl_status : bool * Evar_kinds.obligation_definition_status; obl_deps : Int.Set.t; obl_tac : unit Proofview.tactic option; @@ -350,7 +350,7 @@ let get_shrink_obligations () = !shrink_obligations let _ = declare_bool_option - { optdepr = true; + { optdepr = true; (* remove in 8.8 *) optname = "Shrinking of Program obligations"; optkey = ["Shrink";"Obligations"]; optread = get_shrink_obligations; @@ -358,18 +358,8 @@ let _ = let evar_of_obligation o = make_evar (Global.named_context_val ()) o.obl_type -let get_body obl = - match obl.obl_body with - | None -> None - | Some (DefinedObl c) -> - let u = Environ.constant_instance (Global.env ()) c in - let pc = (c, u) in - Some (DefinedObl pc) - | Some (TermObl c) -> - Some (TermObl c) - let get_obligation_body expand obl = - match get_body obl with + match obl.obl_body with | None -> None | Some c -> if expand && snd obl.obl_status == Evar_kinds.Expand then @@ -646,12 +636,12 @@ let declare_obligation prg obl body ty uctx = shrink_body body ty else [], body, ty, [||] in let body = ((body,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in + let univs = if poly then Polymorphic_const_entry uctx else Monomorphic_const_entry uctx in let ce = { const_entry_body = Future.from_val ~fix_exn:(fun x -> x) body; const_entry_secctx = None; const_entry_type = ty; - const_entry_polymorphic = poly; - const_entry_universes = uctx; + const_entry_universes = univs; const_entry_opaque = opaque; const_entry_inline_code = false; const_entry_feedback = None; @@ -664,7 +654,7 @@ let declare_obligation prg obl body ty uctx = definition_message obl.obl_name; true, { obl with obl_body = if poly then - Some (DefinedObl constant) + Some (DefinedObl (constant, Univ.UContext.instance uctx)) else Some (TermObl (it_mkLambda_or_LetIn_or_clean (mkApp (mkConst constant, args)) ctx)) } @@ -828,8 +818,7 @@ let solve_by_tac name evi t poly ctx = id ~goal_kind:(goal_kind poly) ctx evi.evar_hyps concl (Tacticals.New.tclCOMPLETE t) in let env = Global.env () in let entry = Safe_typing.inline_private_constants_in_definition_entry env entry in - let body, eff = Future.force entry.const_entry_body in - assert(Safe_typing.empty_private_constants = eff); + let body, () = Future.force entry.const_entry_body in let ctx' = Evd.merge_context_set ~sideff:true Evd.univ_rigid (Evd.from_ctx ctx') (snd body) in Inductiveops.control_only_guard (Global.env ()) (fst body); (fst body), entry.const_entry_type, Evd.evar_universe_context ctx' @@ -846,8 +835,7 @@ let obligation_terminator name num guard hook auto pf = let env = Global.env () in let entry = Safe_typing.inline_private_constants_in_definition_entry env entry in let ty = entry.Entries.const_entry_type in - let (body, cstr), eff = Future.force entry.Entries.const_entry_body in - assert(Safe_typing.empty_private_constants = eff); + let (body, cstr), () = Future.force entry.Entries.const_entry_body in let sigma = Evd.from_ctx (fst uctx) in let sigma = Evd.merge_context_set ~sideff:true Evd.univ_rigid sigma cstr in Inductiveops.control_only_guard (Global.env ()) body; @@ -892,20 +880,22 @@ let obligation_hook prg obl num auto ctx' _ gr = if not transparent then err_not_transp () | _ -> () in - let obl = { obl with obl_body = Some (DefinedObl cst) } in - let () = if transparent then add_hint true prg cst in - let obls = Array.copy obls in - let _ = obls.(num) <- obl in let ctx' = match ctx' with None -> prg.prg_ctx | Some ctx' -> ctx' in - let ctx' = + let inst, ctx' = if not (pi2 prg.prg_kind) (* Not polymorphic *) then (* The universe context was declared globally, we continue from the new global environment. *) let evd = Evd.from_env (Global.env ()) in let ctx' = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx')) in - Evd.evar_universe_context ctx' - else ctx' + Univ.Instance.empty, Evd.evar_universe_context ctx' + else + let (_, uctx) = UState.universe_context ctx' in + Univ.UContext.instance uctx, ctx' in + let obl = { obl with obl_body = Some (DefinedObl (cst, inst)) } in + let () = if transparent then add_hint true prg cst in + let obls = Array.copy obls in + let _ = obls.(num) <- obl in let prg = { prg with prg_ctx = ctx' } in let () = try ignore (update_obls prg obls (pred rem)) @@ -1132,7 +1122,7 @@ let admit_prog prg = (ParameterEntry (None,false,(x.obl_type,ctx),None), IsAssumption Conjectural) in assumption_message x.obl_name; - obls.(i) <- { x with obl_body = Some (DefinedObl kn) } + obls.(i) <- { x with obl_body = Some (DefinedObl (kn, Univ.Instance.empty)) } | Some _ -> ()) obls; ignore(update_obls prg obls 0) diff --git a/vernac/obligations.mli b/vernac/obligations.mli index 9cbbf6082c..5614403ba5 100644 --- a/vernac/obligations.mli +++ b/vernac/obligations.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -10,7 +10,6 @@ open Environ open Term open Evd open Names -open Pp open Globnames (* This is a hack to make it possible for Obligations to craft a Qed @@ -96,12 +95,12 @@ val try_solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> val show_obligations : ?msg:bool -> Names.Id.t option -> unit -val show_term : Names.Id.t option -> std_ppcmds +val show_term : Names.Id.t option -> Pp.t val admit_obligations : Names.Id.t option -> unit exception NoObligations of Names.Id.t option -val explain_no_obligations : Names.Id.t option -> Pp.std_ppcmds +val explain_no_obligations : Names.Id.t option -> Pp.t val set_program_mode : bool -> unit diff --git a/vernac/record.ml b/vernac/record.ml index 7dd70d0133..a2e443e5f7 100644 --- a/vernac/record.ml +++ b/vernac/record.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -124,7 +124,7 @@ let typecheck_params_and_fields finite def id pl t ps nots fs = let s' = EConstr.ESorts.kind !evars s' in (if poly then match Evd.is_sort_variable !evars s' with - | Some l -> evars := Evd.make_flexible_variable !evars true l; + | Some l -> evars := Evd.make_flexible_variable !evars ~algebraic:true l; s, s', true | None -> s, s', false else s, s', false) @@ -265,16 +265,10 @@ let warn_non_primitive_record = let declare_projections indsp ?(kind=StructureComponent) binder_name coers fieldimpls fields = let env = Global.env() in let (mib,mip) = Global.lookup_inductive indsp in - let u = Declareops.inductive_polymorphic_instance mib in - let paramdecls = Inductive.inductive_paramdecls (mib, u) in let poly = Declareops.inductive_is_polymorphic mib in - let ctx = - match mib.mind_universes with - | Monomorphic_ind ctx -> ctx - | Polymorphic_ind auctx -> Univ.instantiate_univ_context auctx - | Cumulative_ind cumi -> - Univ.instantiate_univ_context (Univ.ACumulativityInfo.univ_context cumi) - in + let ctx = Univ.AUContext.repr (Declareops.inductive_polymorphic_context mib) in + let u = Univ.UContext.instance ctx in + let paramdecls = Inductive.inductive_paramdecls (mib, u) in let indu = indsp, u in let r = mkIndU (indsp,u) in let rp = applist (r, Context.Rel.to_extended_list mkRel 0 paramdecls) in @@ -328,14 +322,16 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field let projtyp = it_mkProd_or_LetIn (mkProd (x,rp,ccl)) paramdecls in try + let univs = + if poly then Polymorphic_const_entry ctx + else Monomorphic_const_entry ctx + in let entry = { const_entry_body = Future.from_val (Safe_typing.mk_pure_proof proj); const_entry_secctx = None; const_entry_type = Some projtyp; - const_entry_polymorphic = poly; - const_entry_universes = - if poly then ctx else Univ.UContext.empty; + const_entry_universes = univs; const_entry_opaque = false; const_entry_inline_code = false; const_entry_feedback = None } in @@ -431,6 +427,12 @@ let declare_structure finite univs id idbuild paramimpls params arity template let kn = Command.declare_mutual_inductive_with_eliminations mie [] [(paramimpls,[])] in let rsp = (kn,0) in (* This is ind path of idstruc *) let cstr = (rsp,1) in + let fields = + if poly then + let subst, _ = Univ.abstract_universes ctx in + Context.Rel.map (fun c -> Vars.subst_univs_level_constr subst c) fields + else fields + in let kinds,sp_projs = declare_projections rsp ~kind binder_name coers fieldimpls fields in let build = ConstructRef cstr in let () = if is_coe then Class.try_add_new_coercion build ~local:false poly in @@ -518,8 +520,18 @@ let declare_class finite def cum poly ctx id idbuild paramimpls params arity | None -> None) params, params in + let univs, ctx_context, fields = + if poly then + let usubst, auctx = Univ.abstract_universes ctx in + let map c = Vars.subst_univs_level_constr usubst c in + let fields = Context.Rel.map map fields in + let ctx_context = on_snd (fun d -> Context.Rel.map map d) ctx_context in + auctx, ctx_context, fields + else Univ.AUContext.empty, ctx_context, fields + in let k = - { cl_impl = impl; + { cl_univs = univs; + cl_impl = impl; cl_strict = !typeclasses_strict; cl_unique = !typeclasses_unique; cl_context = ctx_context; @@ -530,10 +542,11 @@ let declare_class finite def cum poly ctx id idbuild paramimpls params arity let add_constant_class cst = - let ty = Universes.unsafe_type_of_global (ConstRef cst) in + let ty, univs = Global.type_of_global_in_context (Global.env ()) (ConstRef cst) in let ctx, arity = decompose_prod_assum ty in let tc = - { cl_impl = ConstRef cst; + { cl_univs = univs; + cl_impl = ConstRef cst; cl_context = (List.map (const None) ctx, ctx); cl_props = [LocalAssum (Anonymous, arity)]; cl_projs = []; @@ -547,12 +560,13 @@ let add_inductive_class ind = let mind, oneind = Global.lookup_inductive ind in let k = let ctx = oneind.mind_arity_ctxt in - let inst = Declareops.inductive_polymorphic_instance mind in - let ty = Inductive.type_of_inductive - (push_rel_context ctx (Global.env ())) - ((mind,oneind),inst) - in - { cl_impl = IndRef ind; + let univs = Declareops.inductive_polymorphic_context mind in + let env = push_context ~strict:false (Univ.AUContext.repr univs) (Global.env ()) in + let env = push_rel_context ctx env in + let inst = Univ.make_abstract_instance univs in + let ty = Inductive.type_of_inductive env ((mind, oneind), inst) in + { cl_univs = univs; + cl_impl = IndRef ind; cl_context = List.map (const None) ctx, ctx; cl_props = [LocalAssum (Anonymous, ty)]; cl_projs = []; diff --git a/vernac/record.mli b/vernac/record.mli index aa530fd61a..9a0c9ef9d1 100644 --- a/vernac/record.mli +++ b/vernac/record.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/search.ml b/vernac/search.ml index 5e56ada8ad..0f56f81e74 100644 --- a/vernac/search.ml +++ b/vernac/search.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -78,14 +78,14 @@ let iter_declarations (fn : global_reference -> env -> constr -> unit) = | "CONSTANT" -> let cst = Global.constant_of_delta_kn kn in let gr = ConstRef cst in - let typ = Global.type_of_global_unsafe gr in + let (typ, _) = Global.type_of_global_in_context (Global.env ()) gr in fn gr env typ | "INDUCTIVE" -> let mind = Global.mind_of_delta_kn kn in let mib = Global.lookup_mind mind in let iter_packet i mip = let ind = (mind, i) in - let u = Declareops.inductive_polymorphic_instance mib in + let u = Univ.make_abstract_instance (Declareops.inductive_polymorphic_context mib) in let i = (ind, u) in let typ = Inductiveops.type_of_inductive env i in let () = fn (IndRef ind) env typ in diff --git a/vernac/search.mli b/vernac/search.mli index e34522d8af..db54d732b6 100644 --- a/vernac/search.mli +++ b/vernac/search.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/topfmt.ml b/vernac/topfmt.ml index bbf2ed4fcf..e7b14309d1 100644 --- a/vernac/topfmt.ml +++ b/vernac/topfmt.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -149,7 +149,7 @@ let gen_logger dbg warn ?pre_hdr level msg = match level with (** Standard loggers *) (* We provide a generic clear_log_backend callback for backends - wanting to do clenaup after the print. + wanting to do cleanup after the print. *) let std_logger_cleanup = ref (fun () -> ()) @@ -207,6 +207,8 @@ let make_style_stack () = italic = Some false; underline = Some false; negative = Some false; + prefix = None; + suffix = None; }) in let style_stack = ref [] in @@ -235,20 +237,49 @@ let make_style_stack () = let clear () = style_stack := [] in push, pop, clear -let init_color_output () = +let make_printing_functions () = + let empty = Terminal.make () in + let print_prefix ft tag = + let style = + try CString.Map.find tag !tag_map + with | Not_found -> empty + in + match style.Terminal.prefix with Some s -> Format.pp_print_string ft s | None -> () + in + let print_suffix ft tag = + let style = + try CString.Map.find tag !tag_map + with | Not_found -> empty + in + match style.Terminal.suffix with Some s -> Format.pp_print_string ft s | None -> () + in + print_prefix, print_suffix + +let init_terminal_output ~color = init_tag_map (default_tag_map ()); let push_tag, pop_tag, clear_tag = make_style_stack () in - std_logger_cleanup := clear_tag; - let tag_handler = { + let print_prefix, print_suffix = make_printing_functions () in + let tag_handler ft = { Format.mark_open_tag = push_tag; Format.mark_close_tag = pop_tag; - Format.print_open_tag = ignore; - Format.print_close_tag = ignore; + Format.print_open_tag = print_prefix ft; + Format.print_close_tag = print_suffix ft; } in - Format.pp_set_mark_tags !std_ft true; - Format.pp_set_mark_tags !err_ft true; - Format.pp_set_formatter_tag_functions !std_ft tag_handler; - Format.pp_set_formatter_tag_functions !err_ft tag_handler + if color then + (* Use 0-length markers *) + begin + std_logger_cleanup := clear_tag; + Format.pp_set_mark_tags !std_ft true; + Format.pp_set_mark_tags !err_ft true + end + else + (* Use textual markers *) + begin + Format.pp_set_print_tags !std_ft true; + Format.pp_set_print_tags !err_ft true + end; + Format.pp_set_formatter_tag_functions !std_ft (tag_handler !std_ft); + Format.pp_set_formatter_tag_functions !err_ft (tag_handler !err_ft) (* Rules for emacs: - Debug/info: emacs_quote_info diff --git a/vernac/topfmt.mli b/vernac/topfmt.mli index 6c8e0ae2fa..afe76f6f87 100644 --- a/vernac/topfmt.mli +++ b/vernac/topfmt.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -37,20 +37,22 @@ val set_margin : int option -> unit val get_margin : unit -> int option (** Console display of feedback, we may add some location information *) -val std_logger : ?pre_hdr:Pp.std_ppcmds -> Feedback.level -> Pp.std_ppcmds -> unit -val emacs_logger : ?pre_hdr:Pp.std_ppcmds -> Feedback.level -> Pp.std_ppcmds -> unit +val std_logger : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit +val emacs_logger : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit (** Color output *) -val init_color_output : unit -> unit val clear_styles : unit -> unit val parse_color_config : string -> unit val dump_tags : unit -> (string * Terminal.style) list +(** Initialization of interpretation of tags *) +val init_terminal_output : color:bool -> unit + (** Error printing *) (* To be deprecated when we can fully move to feedback-based error printing. *) -val pr_loc : Loc.t -> Pp.std_ppcmds -val print_err_exn : ?extra:Pp.std_ppcmds -> exn -> unit +val pr_loc : Loc.t -> Pp.t +val print_err_exn : ?extra:Pp.t -> exn -> unit (** [with_output_to_file file f x] executes [f x] with logging redirected to a file [file] *) diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index acd2185365..4f63ed6f48 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) @@ -65,7 +65,7 @@ let show_top_evars () = let pfts = Proof_global.give_me_the_proof () in let gls = Proof.V82.subgoals pfts in let sigma = gls.Evd.sigma in - Feedback.msg_notice (pr_evars_int sigma 1 (Evarutil.non_instantiated sigma)) + Feedback.msg_notice (pr_evars_int sigma 1 (Evd.undefined_map sigma)) let show_universes () = let pfts = Proof_global.give_me_the_proof () in @@ -257,7 +257,7 @@ let print_namespace ns = in let print_constant k body = (* FIXME: universes *) - let t = Typeops.type_of_constant_type (Global.env ()) body.Declarations.const_type in + let t = body.Declarations.const_type in print_kn k ++ str":" ++ spc() ++ Printer.pr_type t in let matches mp = match match_modulepath ns mp with @@ -522,7 +522,21 @@ let vernac_assumption locality poly (local, kind) l nl = let status = do_assumptions kind nl l in if not status then Feedback.feedback Feedback.AddedAxiom +let should_treat_as_cumulative cum poly = + if poly then + match cum with + | GlobalCumulativity | LocalCumulativity -> true + | GlobalNonCumulativity | LocalNonCumulativity -> false + else + match cum with + | GlobalCumulativity | GlobalNonCumulativity -> false + | LocalCumulativity -> + user_err Pp.(str "The Cumulative prefix can only be used in a polymorphic context.") + | LocalNonCumulativity -> + user_err Pp.(str "The NonCumulative prefix can only be used in a polymorphic context.") + let vernac_record cum k poly finite struc binders sort nameopt cfs = + let is_cumulative = should_treat_as_cumulative cum poly in let const = match nameopt with | None -> add_prefix "Build_" (snd (fst (snd struc))) | Some (_,id as lid) -> @@ -533,13 +547,14 @@ let vernac_record cum k poly finite struc binders sort nameopt cfs = match x with | Vernacexpr.AssumExpr ((loc, Name id), _) -> Dumpglob.dump_definition (loc,id) false "proj" | _ -> ()) cfs); - ignore(Record.definition_structure (k,cum,poly,finite,struc,binders,cfs,const,sort)) + ignore(Record.definition_structure (k,is_cumulative,poly,finite,struc,binders,cfs,const,sort)) (** When [poly] is true the type is declared polymorphic. When [lo] is true, then the type is declared private (as per the [Private] keyword). [finite] indicates whether the type is inductive, co-inductive or neither. *) let vernac_inductive cum poly lo finite indl = + let is_cumulative = should_treat_as_cumulative cum poly in if Dumpglob.dump () then List.iter (fun (((coe,(lid,_)), _, _, _, cstrs), _) -> match cstrs with @@ -576,7 +591,7 @@ let vernac_inductive cum poly lo finite indl = | _ -> user_err Pp.(str "Cannot handle mutually (co)inductive records.") in let indl = List.map unpack indl in - do_mutual_inductive indl cum poly lo finite + do_mutual_inductive indl is_cumulative poly lo finite let vernac_fixpoint locality poly local l = let local = enforce_locality_exp locality local in @@ -986,7 +1001,7 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags let sr = smart_global reference in let inf_names = - let ty = Global.type_of_global_unsafe sr in + let ty, _ = Global.type_of_global_in_context (Global.env ()) sr in Impargs.compute_implicits_names (Global.env ()) ty in let prev_names = @@ -1363,10 +1378,10 @@ let _ = let _ = declare_bool_option { optdepr = false; - optname = "inductive cumulativity"; - optkey = ["Inductive"; "Cumulativity"]; - optread = Flags.is_inductive_cumulativity; - optwrite = Flags.make_inductive_cumulativity } + optname = "Polymorphic inductive cumulativity"; + optkey = ["Polymorphic"; "Inductive"; "Cumulativity"]; + optread = Flags.is_polymorphic_inductive_cumulativity; + optwrite = Flags.make_polymorphic_inductive_cumulativity } let _ = declare_int_option @@ -1811,9 +1826,9 @@ let vernac_end_subproof () = Proof_global.simple_with_current_proof (fun _ p -> Proof.unfocus subproof_kind p ()) -let vernac_bullet (bullet:Proof_global.Bullet.t) = +let vernac_bullet (bullet : Proof_bullet.t) = Proof_global.simple_with_current_proof (fun _ p -> - Proof_global.Bullet.put p bullet) + Proof_bullet.put p bullet) let vernac_show = let open Feedback in function | ShowScript -> assert false (* Only the stm knows the script *) @@ -2120,7 +2135,7 @@ let locate_if_not_already ?loc (e, info) = | Some l -> (e, info) exception HasNotFailed -exception HasFailed of std_ppcmds +exception HasFailed of Pp.t let with_fail b f = if not b then f () diff --git a/vernac/vernacentries.mli b/vernac/vernacentries.mli index f75f7656db..a09011d245 100644 --- a/vernac/vernacentries.mli +++ b/vernac/vernacentries.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/vernacinterp.ml b/vernac/vernacinterp.ml index f26ef460dd..2d9c0fa362 100644 --- a/vernac/vernacinterp.ml +++ b/vernac/vernacinterp.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/vernacinterp.mli b/vernac/vernacinterp.mli index 5149b5416d..f58d070864 100644 --- a/vernac/vernacinterp.mli +++ b/vernac/vernacinterp.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/vernacprop.ml b/vernac/vernacprop.ml index ec78d6012f..fc11bcf4a0 100644 --- a/vernac/vernacprop.ml +++ b/vernac/vernacprop.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) diff --git a/vernac/vernacprop.mli b/vernac/vernacprop.mli index c235ecfb57..fbdba6bacb 100644 --- a/vernac/vernacprop.mli +++ b/vernac/vernacprop.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2016 *) +(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017 *) (* \VV/ **************************************************************) (* // * This file is distributed under the terms of the *) (* * GNU Lesser General Public License Version 2.1 *) |