From 97fefe1fcca363a1317e066e7f4b99b9c1e9987b Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Thu, 12 Jan 2012 16:02:20 +0100 Subject: Imported Upstream version 8.4~beta --- .dir-locals.el | 8 + .gitignore | 138 +- CHANGES | 686 +-- COMPATIBILITY | 50 +- COPYRIGHT | 4 +- CREDITS | 2 +- INSTALL | 48 +- INSTALL.ide | 19 +- INSTALL.macosx | 38 +- Makefile | 231 +- Makefile.build | 656 +-- Makefile.common | 158 +- Makefile.doc | 107 +- Makefile.stage1 | 33 - Makefile.stage2 | 27 - README | 24 +- README.win | 8 +- TODO | 53 + _tags | 53 +- build | 2 + checker/check.ml | 32 +- checker/check_stat.ml | 4 +- checker/check_stat.mli | 2 +- checker/checker.ml | 138 +- checker/closure.ml | 257 +- checker/closure.mli | 32 +- checker/declarations.ml | 713 ++- checker/declarations.mli | 48 +- checker/environ.ml | 17 +- checker/environ.mli | 2 - checker/indtypes.ml | 19 +- checker/indtypes.mli | 4 +- checker/inductive.ml | 352 +- checker/inductive.mli | 11 +- checker/mod_checking.ml | 40 +- checker/mod_checking.mli | 9 + checker/modops.ml | 61 +- checker/modops.mli | 6 +- checker/reduction.ml | 92 +- checker/reduction.mli | 11 +- checker/safe_typing.ml | 153 +- checker/safe_typing.mli | 21 +- checker/subtyping.ml | 57 +- checker/subtyping.mli | 5 +- checker/term.ml | 41 +- checker/term.mli | 20 +- checker/type_errors.ml | 9 +- checker/type_errors.mli | 8 +- checker/typeops.ml | 43 +- checker/typeops.mli | 4 +- checker/validate.ml | 120 +- config/Makefile.template | 11 +- config/coq_config.mli | 11 +- configure | 297 +- coq.itarget | 9 +- dev/Makefile.oug | 74 + dev/README | 6 +- dev/base_include | 19 +- dev/db | 10 +- dev/db_printers.ml | 2 +- dev/doc/about-hints | 454 ++ dev/doc/build-system.dev.txt | 16 + dev/doc/build-system.txt | 48 + dev/doc/changes.txt | 39 + dev/doc/debugging.txt | 6 + dev/doc/perf-analysis | 21 +- dev/doc/unification.txt | 208 + dev/doc/universes.txt | 24 +- dev/include | 23 +- dev/ocamldoc/docintro | 49 + dev/ocamldoc/html/style.css | 220 + dev/ocamlweb-doc/Makefile | 90 - dev/ocamlweb-doc/ast.ml | 47 - dev/ocamlweb-doc/interp.dep.ps | 545 --- dev/ocamlweb-doc/intro.tex | 25 - dev/ocamlweb-doc/kernel.dep.ps | 1431 ------ dev/ocamlweb-doc/lex.mll | 81 - dev/ocamlweb-doc/library.dep.ps | 773 --- dev/ocamlweb-doc/macros.tex | 7 - dev/ocamlweb-doc/parse.ml | 183 - dev/ocamlweb-doc/parsing.dep.ps | 1115 ----- dev/ocamlweb-doc/preamble.tex | 8 - dev/ocamlweb-doc/pretyping.dep.ps | 1259 ----- dev/ocamlweb-doc/proofs.dep.ps | 649 --- dev/ocamlweb-doc/syntax.mly | 224 - dev/ocamlweb-doc/tactics.dep.ps | 991 ---- dev/ocamlweb-doc/toplevel.dep.ps | 971 ---- dev/printers.mllib | 20 +- dev/tools/change-header | 55 + dev/tools/univdot | 49 - dev/top_printers.ml | 56 +- dev/v8-syntax/syntax-v8.tex | 3 - doc/common/macros.tex | 2 - doc/common/styles/html/coqremote/cover.html | 26 +- doc/common/styles/html/coqremote/footer.html | 43 - doc/common/styles/html/coqremote/header.html | 49 - doc/common/styles/html/coqremote/styles.hva | 20 +- doc/common/styles/html/simple/cover.html | 6 +- doc/common/styles/html/simple/footer.html | 2 - doc/common/styles/html/simple/header.html | 13 - doc/common/styles/html/simple/styles.hva | 1 - doc/common/title.tex | 7 +- doc/faq/FAQ.tex | 172 +- doc/faq/fk.bib | 7 +- doc/refman/Classes.tex | 31 +- doc/refman/Extraction.tex | 6 +- doc/refman/Micromega.tex | 140 +- doc/refman/Nsatz.tex | 33 +- doc/refman/Program.tex | 19 +- doc/refman/RefMan-add.tex | 2 - doc/refman/RefMan-cic.tex | 2 - doc/refman/RefMan-coi.tex | 1 - doc/refman/RefMan-com.tex | 58 +- doc/refman/RefMan-ext.tex | 155 +- doc/refman/RefMan-gal.tex | 21 +- doc/refman/RefMan-ide.tex | 51 +- doc/refman/RefMan-ind.tex | 1 - doc/refman/RefMan-int.tex | 2 - doc/refman/RefMan-lib.tex | 7 +- doc/refman/RefMan-ltac.tex | 34 +- doc/refman/RefMan-modr.tex | 2 - doc/refman/RefMan-oth.tex | 50 +- doc/refman/RefMan-pre.tex | 150 +- doc/refman/RefMan-pro.tex | 33 +- doc/refman/RefMan-syn.tex | 56 +- doc/refman/RefMan-tac.tex | 312 +- doc/refman/RefMan-uti.tex | 103 +- doc/refman/Reference-Manual.tex | 1 - doc/refman/Setoid.tex | 1 - doc/refman/biblio.bib | 13 + doc/stdlib/Library.tex | 2 +- doc/stdlib/index-list.html.template | 107 +- doc/stdlib/index-trailer.html | 2 + doc/stdlib/make-library-files | 2 +- doc/stdlib/make-library-index | 2 +- doc/tutorial/Tutorial.tex | 5 +- ide/.coqide-gtk2rc | 49 - ide/FAQ | 24 +- ide/command_windows.ml | 34 +- ide/command_windows.mli | 12 +- ide/config_lexer.mll | 39 +- ide/config_parser.mly | 43 - ide/coq.ml | 863 +--- ide/coq.mli | 100 +- ide/coq_commands.ml | 8 +- ide/coq_lex.mll | 199 +- ide/coq_tactics.ml | 131 - ide/coq_tactics.mli | 12 - ide/coqide-gtk2rc | 49 + ide/coqide.ml | 5121 +++++++++----------- ide/coqide.mli | 38 +- ide/coqide_main.ml4 | 105 + ide/coqide_ui.ml | 151 + ide/gtk_parsing.ml | 18 +- ide/highlight.mll | 215 - ide/ide.mllib | 5 +- ide/ide_mac_stubs.c | 85 + ide/ide_win32_stubs.c | 49 + ide/ideproof.ml | 137 + ide/ideutils.ml | 143 +- ide/ideutils.mli | 19 +- ide/mac_default_accel_map | 372 ++ ide/minilib.ml | 174 + ide/minilib.mli | 44 + ide/preferences.ml | 233 +- ide/preferences.mli | 17 +- ide/project_file.ml4 | 190 + ide/tags.ml | 6 +- ide/typed_notebook.ml | 43 +- ide/uim/coqide-custom.scm | 99 - ide/uim/coqide-rules.scm | 1142 ----- ide/uim/coqide.scm | 277 -- ide/undo.ml | 6 +- ide/undo_lablgtk_ge212.mli | 4 +- ide/undo_lablgtk_ge26.mli | 4 +- ide/undo_lablgtk_lt26.mli | 4 +- ide/utf8_convert.mll | 4 +- ide/utils/config_file.ml | 2 - ide/utils/configwin.ml | 4 +- ide/utils/configwin.mli | 8 +- ide/utils/configwin_ihm.ml | 460 +- ide/utils/configwin_messages.ml | 2 +- ide/utils/configwin_types.ml | 4 +- interp/constrextern.ml | 383 +- interp/constrextern.mli | 33 +- interp/constrintern.ml | 563 ++- interp/constrintern.mli | 107 +- interp/coqlib.ml | 39 +- interp/coqlib.mli | 74 +- interp/doc.tex | 2 +- interp/dumpglob.ml | 50 +- interp/dumpglob.mli | 9 +- interp/genarg.ml | 12 +- interp/genarg.mli | 105 +- interp/implicit_quantifiers.ml | 60 +- interp/implicit_quantifiers.mli | 18 +- interp/interp.mllib | 2 +- interp/modintern.ml | 100 +- interp/modintern.mli | 21 +- interp/notation.ml | 192 +- interp/notation.mli | 95 +- interp/ppextend.ml | 4 +- interp/ppextend.mli | 10 +- interp/reserve.ml | 95 +- interp/reserve.mli | 13 +- interp/smartlocate.ml | 4 +- interp/smartlocate.mli | 16 +- interp/syntax_def.ml | 6 +- interp/syntax_def.mli | 10 +- interp/topconstr.ml | 393 +- interp/topconstr.mli | 108 +- kernel/byterun/coq_interp.c | 21 +- kernel/byterun/coq_memory.c | 6 - kernel/byterun/coq_memory.h | 1 - kernel/byterun/int64_emul.h | 2 - kernel/byterun/int64_native.h | 2 - kernel/cbytecodes.ml | 14 + kernel/cbytecodes.mli | 95 +- kernel/cbytegen.ml | 49 +- kernel/cbytegen.mli | 13 +- kernel/cemitcodes.ml | 21 +- kernel/cemitcodes.mli | 7 +- kernel/closure.ml | 62 +- kernel/closure.mli | 72 +- kernel/conv_oracle.ml | 9 +- kernel/conv_oracle.mli | 16 +- kernel/cooking.ml | 36 +- kernel/cooking.mli | 13 +- kernel/csymtable.ml | 20 +- kernel/csymtable.mli | 10 + kernel/declarations.ml | 199 +- kernel/declarations.mli | 179 +- kernel/entries.ml | 22 +- kernel/entries.mli | 46 +- kernel/environ.ml | 31 +- kernel/environ.mli | 105 +- kernel/esubst.ml | 10 +- kernel/esubst.mli | 61 +- kernel/indtypes.ml | 55 +- kernel/indtypes.mli | 15 +- kernel/inductive.ml | 391 +- kernel/inductive.mli | 51 +- kernel/mod_subst.ml | 804 ++- kernel/mod_subst.mli | 95 +- kernel/mod_typing.ml | 303 +- kernel/mod_typing.mli | 46 +- kernel/modops.ml | 404 +- kernel/modops.mli | 94 +- kernel/names.ml | 277 +- kernel/names.mli | 108 +- kernel/pre_env.ml | 9 +- kernel/pre_env.mli | 16 +- kernel/reduction.ml | 224 +- kernel/reduction.mli | 50 +- kernel/retroknowledge.ml | 9 +- kernel/retroknowledge.mli | 32 +- kernel/safe_typing.ml | 578 ++- kernel/safe_typing.mli | 59 +- kernel/sign.ml | 12 +- kernel/sign.mli | 36 +- kernel/subtyping.ml | 168 +- kernel/subtyping.mli | 6 +- kernel/term.ml | 727 +-- kernel/term.mli | 390 +- kernel/term_typing.ml | 84 +- kernel/term_typing.mli | 14 +- kernel/type_errors.ml | 13 +- kernel/type_errors.mli | 19 +- kernel/typeops.ml | 60 +- kernel/typeops.mli | 42 +- kernel/univ.ml | 570 ++- kernel/univ.mli | 68 +- kernel/vconv.ml | 12 +- kernel/vconv.mli | 8 +- kernel/vm.ml | 64 +- kernel/vm.mli | 43 +- lib/bigint.ml | 4 +- lib/bigint.mli | 10 +- lib/bstack.ml | 75 - lib/bstack.mli | 22 - lib/compat.ml4 | 271 +- lib/dnet.ml | 4 +- lib/dnet.mli | 42 +- lib/dyn.ml | 4 +- lib/dyn.mli | 6 +- lib/edit.ml | 134 - lib/edit.mli | 63 - lib/envars.ml | 75 +- lib/envars.mli | 14 +- lib/errors.ml | 68 + lib/errors.mli | 41 + lib/explore.ml | 4 +- lib/explore.mli | 12 +- lib/flags.ml | 39 +- lib/flags.mli | 39 +- lib/fmap.mli | 2 +- lib/gmap.ml | 3 +- lib/gmap.mli | 8 +- lib/gmapl.ml | 4 +- lib/gmapl.mli | 6 +- lib/gset.ml | 242 - lib/gset.mli | 34 - lib/hashcons.ml | 4 +- lib/hashcons.mli | 8 +- lib/hashtbl_alt.ml | 109 + lib/hashtbl_alt.mli | 41 + lib/heap.ml | 4 +- lib/heap.mli | 28 +- lib/lib.mllib | 14 +- lib/option.ml | 4 +- lib/option.mli | 4 +- lib/pp.ml4 | 13 +- lib/pp.mli | 35 +- lib/pp_control.ml | 34 +- lib/pp_control.mli | 19 +- lib/predicate.ml | 2 - lib/predicate.mli | 38 +- lib/profile.ml | 8 +- lib/profile.mli | 32 +- lib/refutpat.ml4 | 33 - lib/rtree.ml | 4 +- lib/rtree.mli | 37 +- lib/segmenttree.ml | 1 - lib/segmenttree.mli | 2 +- lib/store.ml | 61 + lib/store.mli | 25 + lib/system.ml | 75 +- lib/system.mli | 25 +- lib/tlm.ml | 63 - lib/tlm.mli | 32 - lib/tries.ml | 2 +- lib/tries.mli | 4 +- lib/unionfind.ml | 115 + lib/unionfind.mli | 57 + lib/util.ml | 133 +- lib/util.mli | 146 +- lib/xml_lexer.mli | 44 + lib/xml_lexer.mll | 299 ++ lib/xml_parser.ml | 238 + lib/xml_parser.mli | 104 + lib/xml_utils.ml | 223 + lib/xml_utils.mli | 93 + library/assumptions.ml | 20 +- library/assumptions.mli | 2 +- library/decl_kinds.ml | 14 +- library/decl_kinds.mli | 32 +- library/declare.ml | 70 +- library/declare.mli | 43 +- library/declaremods.ml | 385 +- library/declaremods.mli | 88 +- library/decls.ml | 7 +- library/decls.mli | 12 +- library/dischargedhypsmap.ml | 4 +- library/dischargedhypsmap.mli | 10 +- library/global.ml | 20 +- library/global.mli | 43 +- library/goptions.ml | 77 +- library/goptions.mli | 45 +- library/goptionstyp.mli | 26 + library/heads.ml | 10 +- library/heads.mli | 8 +- library/impargs.ml | 40 +- library/impargs.mli | 69 +- library/lib.ml | 239 +- library/lib.mli | 100 +- library/libnames.ml | 73 +- library/libnames.mli | 68 +- library/libobject.ml | 17 +- library/libobject.mli | 26 +- library/library.ml | 86 +- library/library.mli | 37 +- library/nameops.ml | 6 +- library/nameops.mli | 18 +- library/nametab.ml | 39 +- library/nametab.mli | 113 +- library/states.ml | 9 +- library/states.mli | 13 +- library/summary.ml | 4 +- library/summary.mli | 6 +- man/coqchk.1 | 37 +- man/coqide.1 | 8 +- man/coqmktop.1 | 8 - myocamlbuild.ml | 175 +- parsing/argextend.ml4 | 145 +- parsing/egrammar.ml | 100 +- parsing/egrammar.mli | 23 +- parsing/extend.ml | 45 +- parsing/extend.mli | 44 +- parsing/extrawit.ml | 4 +- parsing/extrawit.mli | 8 +- parsing/g_constr.ml4 | 97 +- parsing/g_decl_mode.ml4 | 252 - parsing/g_intsyntax.mli | 13 - parsing/g_ltac.ml4 | 26 +- parsing/g_natsyntax.mli | 15 - parsing/g_prim.ml4 | 12 +- parsing/g_proofs.ml4 | 55 +- parsing/g_tactic.ml4 | 148 +- parsing/g_vernac.ml4 | 370 +- parsing/g_xml.ml4 | 68 +- parsing/g_zsyntax.mli | 11 - parsing/grammar.mllib | 6 +- parsing/highparsing.mllib | 1 - parsing/lexer.ml4 | 322 +- parsing/lexer.mli | 24 +- parsing/parsing.mllib | 1 - parsing/pcoq.ml4 | 432 +- parsing/pcoq.mli | 263 +- parsing/ppconstr.ml | 157 +- parsing/ppconstr.mli | 15 +- parsing/ppdecl_proof.ml | 190 - parsing/ppdecl_proof.mli | 2 - parsing/pptactic.ml | 113 +- parsing/pptactic.mli | 18 +- parsing/ppvernac.ml | 204 +- parsing/ppvernac.mli | 6 +- parsing/prettyp.ml | 228 +- parsing/prettyp.mli | 19 +- parsing/printer.ml | 317 +- parsing/printer.mli | 74 +- parsing/printmod.ml | 242 +- parsing/printmod.mli | 4 +- parsing/q_constr.ml4 | 52 +- parsing/q_coqast.ml4 | 189 +- parsing/q_util.ml4 | 56 +- parsing/q_util.mli | 8 +- parsing/tacextend.ml4 | 59 +- parsing/tactic_printer.ml | 95 +- parsing/tactic_printer.mli | 9 +- parsing/tok.ml | 90 + parsing/tok.mli | 29 + parsing/vernacextend.ml4 | 60 +- plugins/cc/ccalgo.ml | 98 +- plugins/cc/ccalgo.mli | 13 +- plugins/cc/ccproof.ml | 10 +- plugins/cc/ccproof.mli | 4 +- plugins/cc/cctac.ml | 47 +- plugins/cc/cctac.mli | 4 +- plugins/cc/g_congruence.ml4 | 4 +- plugins/decl_mode/decl_expr.mli | 103 + plugins/decl_mode/decl_interp.ml | 471 ++ plugins/decl_mode/decl_interp.mli | 16 + plugins/decl_mode/decl_mode.ml | 123 + plugins/decl_mode/decl_mode.mli | 78 + plugins/decl_mode/decl_mode_plugin.mllib | 6 + plugins/decl_mode/decl_proof_instr.ml | 1501 ++++++ plugins/decl_mode/decl_proof_instr.mli | 109 + plugins/decl_mode/g_decl_mode.ml4 | 408 ++ plugins/decl_mode/ppdecl_proof.ml | 188 + plugins/decl_mode/ppdecl_proof.mli | 2 + plugins/dp/Dp.v | 2 - plugins/dp/dp.ml | 23 +- plugins/dp/g_dp.ml4 | 4 +- plugins/dp/test2.v | 2 +- plugins/dp/zenon.v | 2 - plugins/extraction/ExtrOcamlBasic.v | 4 +- plugins/extraction/ExtrOcamlBigIntConv.v | 2 +- plugins/extraction/ExtrOcamlIntConv.v | 2 +- plugins/extraction/ExtrOcamlNatBigInt.v | 6 +- plugins/extraction/ExtrOcamlNatInt.v | 8 +- plugins/extraction/ExtrOcamlString.v | 2 +- plugins/extraction/ExtrOcamlZBigInt.v | 70 +- plugins/extraction/ExtrOcamlZInt.v | 66 +- plugins/extraction/big.ml | 2 +- plugins/extraction/common.ml | 37 +- plugins/extraction/common.mli | 15 +- plugins/extraction/extract_env.ml | 128 +- plugins/extraction/extract_env.mli | 10 +- plugins/extraction/extraction.ml | 178 +- plugins/extraction/extraction.mli | 4 +- plugins/extraction/g_extraction.ml4 | 8 +- plugins/extraction/haskell.ml | 158 +- plugins/extraction/haskell.mli | 4 +- plugins/extraction/miniml.mli | 50 +- plugins/extraction/mlutil.ml | 287 +- plugins/extraction/mlutil.mli | 11 +- plugins/extraction/modutil.ml | 91 +- plugins/extraction/modutil.mli | 7 +- plugins/extraction/ocaml.ml | 327 +- plugins/extraction/ocaml.mli | 4 +- plugins/extraction/scheme.ml | 29 +- plugins/extraction/scheme.mli | 4 +- plugins/extraction/table.ml | 219 +- plugins/extraction/table.mli | 38 +- plugins/field/LegacyField.v | 4 +- plugins/field/LegacyField_Compl.v | 4 +- plugins/field/LegacyField_Tactic.v | 4 +- plugins/field/LegacyField_Theory.v | 4 +- plugins/field/field.ml4 | 16 +- plugins/firstorder/formula.ml | 4 +- plugins/firstorder/formula.mli | 4 +- plugins/firstorder/g_ground.ml4 | 7 +- plugins/firstorder/ground.ml | 32 +- plugins/firstorder/ground.mli | 4 +- plugins/firstorder/instances.ml | 18 +- plugins/firstorder/instances.mli | 4 +- plugins/firstorder/rules.ml | 4 +- plugins/firstorder/rules.mli | 4 +- plugins/firstorder/sequent.ml | 71 +- plugins/firstorder/sequent.mli | 4 +- plugins/firstorder/unify.ml | 7 +- plugins/firstorder/unify.mli | 4 +- plugins/fourier/Fourier.v | 4 +- plugins/fourier/Fourier_util.v | 4 +- plugins/fourier/fourier.ml | 4 +- plugins/fourier/fourierR.ml | 40 +- plugins/fourier/g_fourier.ml4 | 4 +- plugins/funind/Recdef.v | 2 +- plugins/funind/functional_principles_proofs.ml | 62 +- plugins/funind/functional_principles_types.ml | 61 +- plugins/funind/functional_principles_types.mli | 6 +- plugins/funind/g_indfun.ml4 | 118 +- plugins/funind/glob_term_to_relation.ml | 1478 ++++++ plugins/funind/glob_term_to_relation.mli | 16 + plugins/funind/glob_termops.ml | 712 +++ plugins/funind/glob_termops.mli | 126 + plugins/funind/indfun.ml | 549 ++- plugins/funind/indfun.mli | 24 + plugins/funind/indfun_common.ml | 63 +- plugins/funind/indfun_common.mli | 15 +- plugins/funind/invfun.ml | 78 +- plugins/funind/merge.ml | 133 +- plugins/funind/rawterm_to_relation.ml | 1480 ------ plugins/funind/rawterm_to_relation.mli | 16 - plugins/funind/rawtermops.ml | 718 --- plugins/funind/rawtermops.mli | 126 - plugins/funind/recdef.ml | 229 +- plugins/funind/recdef_plugin.mllib | 4 +- plugins/micromega/CheckerMaker.v | 5 +- plugins/micromega/Env.v | 16 +- plugins/micromega/EnvRing.v | 24 +- plugins/micromega/MExtraction.v | 19 +- plugins/micromega/OrderedRing.v | 2 +- plugins/micromega/Psatz.v | 20 +- plugins/micromega/QMicromega.v | 14 +- plugins/micromega/RMicromega.v | 480 +- plugins/micromega/Refl.v | 2 +- plugins/micromega/RingMicromega.v | 195 +- plugins/micromega/Tauto.v | 248 +- plugins/micromega/VarMap.v | 225 +- plugins/micromega/ZCoeff.v | 8 +- plugins/micromega/ZMicromega.v | 327 +- plugins/micromega/certificate.ml | 1244 +++-- plugins/micromega/coq_micromega.ml | 646 ++- plugins/micromega/csdpcert.ml | 4 +- plugins/micromega/g_micromega.ml4 | 16 +- plugins/micromega/mfourier.ml | 179 +- plugins/micromega/micromega.ml | 4625 +++++++++++++----- plugins/micromega/micromega.mli | 1080 ++++- plugins/micromega/micromega_plugin.mllib | 1 + plugins/micromega/mutils.ml | 123 +- plugins/micromega/persistent_cache.ml | 79 +- plugins/micromega/polynomial.ml | 739 +++ plugins/micromega/sos.ml | 74 +- plugins/micromega/sos.mli | 2 +- plugins/micromega/sos_types.ml | 2 +- plugins/nsatz/Nsatz.v | 599 +-- plugins/nsatz/ideal.ml | 6 +- plugins/nsatz/nsatz.ml4 | 88 +- plugins/nsatz/polynom.ml | 5 +- plugins/nsatz/polynom.mli | 2 +- plugins/omega/Omega.v | 4 +- plugins/omega/OmegaLemmas.v | 9 +- plugins/omega/OmegaPlugin.v | 4 +- plugins/omega/PreOmega.v | 115 +- plugins/omega/coq_omega.ml | 357 +- plugins/omega/g_omega.ml4 | 4 +- plugins/omega/omega.ml | 4 +- plugins/pluginsbyte.itarget | 1 + plugins/pluginsdyn.itarget | 1 + plugins/pluginsopt.itarget | 1 + plugins/quote/Quote.v | 5 +- plugins/quote/g_quote.ml4 | 6 +- plugins/quote/quote.ml | 28 +- plugins/ring/LegacyArithRing.v | 6 +- plugins/ring/LegacyNArithRing.v | 6 +- plugins/ring/LegacyRing.v | 4 +- plugins/ring/LegacyRing_theory.v | 4 +- plugins/ring/LegacyZArithRing.v | 6 +- plugins/ring/Ring_abstract.v | 6 +- plugins/ring/Ring_normalize.v | 15 +- plugins/ring/Setoid_ring.v | 4 +- plugins/ring/Setoid_ring_normalize.v | 15 +- plugins/ring/Setoid_ring_theory.v | 4 +- plugins/ring/g_ring.ml4 | 4 +- plugins/ring/ring.ml | 57 +- plugins/romega/ReflOmegaCore.v | 46 +- plugins/romega/const_omega.ml | 86 +- plugins/romega/refl_omega.ml | 4 +- plugins/rtauto/Bintree.v | 223 +- plugins/rtauto/Rtauto.v | 48 +- plugins/rtauto/g_rtauto.ml4 | 4 +- plugins/rtauto/proof_search.ml | 5 +- plugins/rtauto/proof_search.mli | 4 +- plugins/rtauto/refl_tauto.ml | 18 +- plugins/rtauto/refl_tauto.mli | 4 +- plugins/setoid_ring/Algebra_syntax.v | 25 + plugins/setoid_ring/ArithRing.v | 6 +- plugins/setoid_ring/BinList.v | 2 +- plugins/setoid_ring/Cring.v | 272 ++ plugins/setoid_ring/Field.v | 2 +- plugins/setoid_ring/Field_tac.v | 2 +- plugins/setoid_ring/Field_theory.v | 132 +- plugins/setoid_ring/InitialRing.v | 122 +- plugins/setoid_ring/Integral_domain.v | 44 + plugins/setoid_ring/NArithRing.v | 4 +- plugins/setoid_ring/Ncring.v | 305 ++ plugins/setoid_ring/Ncring_initial.v | 221 + plugins/setoid_ring/Ncring_polynom.v | 621 +++ plugins/setoid_ring/Ncring_tac.v | 308 ++ plugins/setoid_ring/Ring.v | 2 +- plugins/setoid_ring/Ring_base.v | 2 +- plugins/setoid_ring/Ring_polynom.v | 24 +- plugins/setoid_ring/Ring_theory.v | 19 +- plugins/setoid_ring/Rings_Q.v | 30 + plugins/setoid_ring/Rings_R.v | 34 + plugins/setoid_ring/Rings_Z.v | 14 + plugins/setoid_ring/ZArithRing.v | 8 +- plugins/setoid_ring/newring.ml4 | 69 +- plugins/setoid_ring/vo.itarget | 10 + plugins/subtac/eterm.ml | 19 +- plugins/subtac/eterm.mli | 3 +- plugins/subtac/g_subtac.ml4 | 16 +- plugins/subtac/subtac.ml | 28 +- plugins/subtac/subtac_cases.ml | 51 +- plugins/subtac/subtac_cases.mli | 6 +- plugins/subtac/subtac_classes.ml | 39 +- plugins/subtac/subtac_classes.mli | 6 +- plugins/subtac/subtac_coercion.ml | 21 +- plugins/subtac/subtac_command.ml | 64 +- plugins/subtac/subtac_command.mli | 8 +- plugins/subtac/subtac_obligations.ml | 171 +- plugins/subtac/subtac_obligations.mli | 2 +- plugins/subtac/subtac_pretyping.ml | 19 +- plugins/subtac/subtac_pretyping.mli | 2 +- plugins/subtac/subtac_pretyping_F.ml | 167 +- plugins/subtac/subtac_utils.ml | 44 +- plugins/subtac/subtac_utils.mli | 14 +- plugins/syntax/ascii_syntax.ml | 16 +- plugins/syntax/nat_syntax.ml | 18 +- plugins/syntax/numbers_syntax.ml | 72 +- plugins/syntax/r_syntax.ml | 44 +- plugins/syntax/string_syntax.ml | 16 +- plugins/syntax/z_syntax.ml | 81 +- plugins/xml/acic.ml | 2 +- plugins/xml/acic2Xml.ml4 | 2 +- plugins/xml/cic2acic.ml | 2 +- plugins/xml/doubleTypeInference.ml | 4 +- plugins/xml/doubleTypeInference.mli | 2 +- plugins/xml/dumptree.ml4 | 32 +- plugins/xml/proof2aproof.ml | 108 +- plugins/xml/proofTree2Xml.ml4 | 21 +- plugins/xml/unshare.ml | 2 +- plugins/xml/unshare.mli | 2 +- plugins/xml/xml.ml4 | 2 +- plugins/xml/xml.mli | 4 +- plugins/xml/xmlcommand.ml | 46 +- plugins/xml/xmlcommand.mli | 4 +- plugins/xml/xmlentries.ml4 | 4 +- pretyping/arguments_renaming.ml | 118 + pretyping/arguments_renaming.mli | 22 + pretyping/cases.ml | 1109 +++-- pretyping/cases.mli | 30 +- pretyping/cbv.ml | 17 +- pretyping/cbv.mli | 21 +- pretyping/classops.ml | 37 +- pretyping/classops.mli | 45 +- pretyping/clenv.ml | 482 -- pretyping/clenv.mli | 148 - pretyping/coercion.ml | 46 +- pretyping/coercion.mli | 24 +- pretyping/detyping.ml | 212 +- pretyping/detyping.mli | 60 +- pretyping/evarconv.ml | 614 ++- pretyping/evarconv.mli | 36 +- pretyping/evarutil.ml | 1138 +++-- pretyping/evarutil.mli | 163 +- pretyping/evd.ml | 561 ++- pretyping/evd.mli | 129 +- pretyping/glob_term.ml | 409 ++ pretyping/glob_term.mli | 167 + pretyping/indrec.ml | 68 +- pretyping/indrec.mli | 20 +- pretyping/inductiveops.ml | 19 +- pretyping/inductiveops.mli | 45 +- pretyping/matching.ml | 60 +- pretyping/matching.mli | 37 +- pretyping/namegen.ml | 19 +- pretyping/namegen.mli | 42 +- pretyping/pattern.ml | 205 +- pretyping/pattern.mli | 71 +- pretyping/pretype_errors.ml | 113 +- pretyping/pretype_errors.mli | 74 +- pretyping/pretyping.ml | 300 +- pretyping/pretyping.mli | 76 +- pretyping/pretyping.mllib | 4 +- pretyping/rawterm.ml | 409 -- pretyping/rawterm.mli | 167 - pretyping/recordops.ml | 39 +- pretyping/recordops.mli | 46 +- pretyping/reductionops.ml | 83 +- pretyping/reductionops.mli | 57 +- pretyping/retyping.ml | 15 +- pretyping/retyping.mli | 12 +- pretyping/tacred.ml | 160 +- pretyping/tacred.mli | 57 +- pretyping/term_dnet.ml | 4 +- pretyping/term_dnet.mli | 36 +- pretyping/termops.ml | 298 +- pretyping/termops.mli | 147 +- pretyping/typeclasses.ml | 226 +- pretyping/typeclasses.mli | 63 +- pretyping/typeclasses_errors.ml | 9 +- pretyping/typeclasses_errors.mli | 10 +- pretyping/typing.ml | 108 +- pretyping/typing.mli | 31 +- pretyping/unification.ml | 764 ++- pretyping/unification.mli | 56 +- pretyping/vnorm.ml | 4 +- pretyping/vnorm.mli | 6 +- proofs/clenv.ml | 522 ++ proofs/clenv.mli | 139 + proofs/clenvtac.ml | 38 +- proofs/clenvtac.mli | 12 +- proofs/decl_expr.mli | 105 - proofs/decl_mode.ml | 127 - proofs/decl_mode.mli | 74 - proofs/evar_refiner.ml | 26 +- proofs/evar_refiner.mli | 16 +- proofs/goal.ml | 588 +++ proofs/goal.mli | 243 + proofs/logic.ml | 340 +- proofs/logic.mli | 17 +- proofs/pfedit.ml | 424 +- proofs/pfedit.mli | 140 +- proofs/proof.ml | 458 ++ proofs/proof.mli | 183 + proofs/proof_global.ml | 427 ++ proofs/proof_global.mli | 137 + proofs/proof_trees.ml | 107 - proofs/proof_trees.mli | 48 - proofs/proof_type.ml | 22 +- proofs/proof_type.mli | 55 +- proofs/proofs.mllib | 9 +- proofs/proofview.ml | 507 ++ proofs/proofview.mli | 213 + proofs/redexpr.ml | 26 +- proofs/redexpr.mli | 19 +- proofs/refiner.ml | 696 +-- proofs/refiner.mli | 148 +- proofs/tacexpr.ml | 35 +- proofs/tacmach.ml | 61 +- proofs/tacmach.mli | 58 +- proofs/tactic_debug.ml | 21 +- proofs/tactic_debug.mli | 36 +- proofs/tmp-src | 56 - scripts/coqc.ml | 15 +- scripts/coqmktop.ml | 113 +- states/MakeInitial.v | 2 +- tactics/auto.ml | 694 ++- tactics/auto.mli | 170 +- tactics/autorewrite.ml | 22 +- tactics/autorewrite.mli | 14 +- tactics/btermdn.ml | 4 +- tactics/btermdn.mli | 8 +- tactics/class_tactics.ml4 | 810 ++-- tactics/contradiction.ml | 6 +- tactics/contradiction.mli | 8 +- tactics/decl_interp.ml | 472 -- tactics/decl_interp.mli | 18 - tactics/decl_proof_instr.ml | 1518 ------ tactics/decl_proof_instr.mli | 119 - tactics/dhyp.ml | 10 +- tactics/dhyp.mli | 10 +- tactics/dn.mli | 5 +- tactics/eauto.ml4 | 123 +- tactics/eauto.mli | 13 +- tactics/elim.ml | 12 +- tactics/elim.mli | 12 +- tactics/elimschemes.ml | 4 +- tactics/elimschemes.mli | 8 +- tactics/eqdecide.ml4 | 11 +- tactics/eqschemes.ml | 35 +- tactics/eqschemes.mli | 13 +- tactics/equality.ml | 286 +- tactics/equality.mli | 24 +- tactics/evar_tactics.ml | 9 +- tactics/evar_tactics.mli | 10 +- tactics/extraargs.ml4 | 56 +- tactics/extraargs.mli | 36 +- tactics/extratactics.ml4 | 158 +- tactics/extratactics.mli | 4 +- tactics/hiddentac.ml | 25 +- tactics/hiddentac.mli | 35 +- tactics/hipattern.ml4 | 13 +- tactics/hipattern.mli | 53 +- tactics/inv.ml | 10 +- tactics/inv.mli | 8 +- tactics/leminv.ml | 78 +- tactics/leminv.mli | 4 +- tactics/nbtermdn.ml | 4 +- tactics/nbtermdn.mli | 8 +- tactics/refine.ml | 10 +- tactics/refine.mli | 4 +- tactics/rewrite.ml4 | 1143 +++-- tactics/tacinterp.ml | 530 +- tactics/tacinterp.mli | 71 +- tactics/tactic_option.ml | 6 +- tactics/tactic_option.mli | 4 +- tactics/tacticals.ml | 17 +- tactics/tacticals.mli | 61 +- tactics/tactics.ml | 787 +-- tactics/tactics.mli | 111 +- tactics/tactics.mllib | 2 - tactics/tauto.ml4 | 13 +- tactics/termdn.ml | 6 +- tactics/termdn.mli | 22 +- test-suite/Makefile | 60 +- test-suite/bench/lists-100.v | 2 +- test-suite/bench/lists_100.v | 2 +- test-suite/bugs/closed/2105.v | 2 + test-suite/bugs/closed/shouldfail/2406.v | 3 + test-suite/bugs/closed/shouldfail/2586.v | 5 + test-suite/bugs/closed/shouldsucceed/1416.v | 7 +- test-suite/bugs/closed/shouldsucceed/1507.v | 1 - test-suite/bugs/closed/shouldsucceed/1834.v | 174 + test-suite/bugs/closed/shouldsucceed/1912.v | 6 + test-suite/bugs/closed/shouldsucceed/1962.v | 55 + test-suite/bugs/closed/shouldsucceed/2127.v | 3 - test-suite/bugs/closed/shouldsucceed/2141.v | 14 + test-suite/bugs/closed/shouldsucceed/2181.v | 3 + test-suite/bugs/closed/shouldsucceed/2304.v | 4 + test-suite/bugs/closed/shouldsucceed/2307.v | 3 + test-suite/bugs/closed/shouldsucceed/2320.v | 14 + test-suite/bugs/closed/shouldsucceed/2342.v | 8 + test-suite/bugs/closed/shouldsucceed/2362.v | 38 + test-suite/bugs/closed/shouldsucceed/2378.v | 608 +++ test-suite/bugs/closed/shouldsucceed/2388.v | 6 + test-suite/bugs/closed/shouldsucceed/2393.v | 13 + test-suite/bugs/closed/shouldsucceed/2404.v | 46 + test-suite/bugs/closed/shouldsucceed/2456.v | 53 + test-suite/bugs/closed/shouldsucceed/2473.v | 39 + test-suite/bugs/closed/shouldsucceed/2603.v | 18 + test-suite/bugs/closed/shouldsucceed/2613.v | 17 + test-suite/bugs/closed/shouldsucceed/2615.v | 14 + test-suite/bugs/closed/shouldsucceed/2616.v | 7 + test-suite/bugs/closed/shouldsucceed/2640.v | 17 + test-suite/bugs/opened/shouldnotfail/2310.v | 17 + test-suite/complexity/Notations.v | 10 + test-suite/complexity/evar_instance.v | 78 + test-suite/complexity/guard.v | 30 + test-suite/complexity/patternmatching.v | 8 + test-suite/complexity/ring2.v | 4 +- test-suite/csdp.cache | Bin 44878 -> 76555 bytes test-suite/failure/Tauto.v | 2 +- test-suite/failure/clash_cons.v | 2 +- test-suite/failure/fixpoint1.v | 2 +- test-suite/failure/guard.v | 2 +- test-suite/failure/illtype1.v | 2 +- test-suite/failure/inductive4.v | 15 + test-suite/failure/positivity.v | 2 +- test-suite/failure/redef.v | 2 +- test-suite/failure/search.v | 2 +- test-suite/failure/universes2.v | 4 - test-suite/ide/undo.v | 5 +- test-suite/ide/undo001.fake | 10 + test-suite/ide/undo002.fake | 10 + test-suite/ide/undo003.fake | 8 + test-suite/ide/undo004.fake | 14 + test-suite/ide/undo005.fake | 15 + test-suite/ide/undo006.fake | 14 + test-suite/ide/undo007.fake | 17 + test-suite/ide/undo008.fake | 18 + test-suite/ide/undo009.fake | 20 + test-suite/ide/undo010.fake | 28 + test-suite/ide/undo011.fake | 32 + test-suite/ide/undo012.fake | 26 + test-suite/ide/undo013.fake | 31 + test-suite/ide/undo014.fake | 26 + test-suite/ide/undo015.fake | 29 + test-suite/ide/undo016.fake | 34 + test-suite/ide/undo017.fake | 13 + test-suite/ide/undo018.fake | 13 + test-suite/ide/undo019.fake | 14 + test-suite/ideal-features/Apply.v | 2 +- test-suite/ideal-features/Case8.v | 36 - test-suite/micromega/csdp.cache | Bin 44878 -> 0 bytes test-suite/misc/berardi_test.v | 4 +- test-suite/misc/deps/deps.out | 2 +- test-suite/misc/universes/universes.v | 2 + test-suite/modules/errors.v | 70 + test-suite/output/Arguments.out | 93 + test-suite/output/Arguments.v | 40 + test-suite/output/ArgumentsScope.out | 5 + test-suite/output/Arguments_renaming.out | 108 + test-suite/output/Arguments_renaming.v | 54 + test-suite/output/Errors.out | 2 + test-suite/output/Errors.v | 9 + test-suite/output/Existentials.out | 4 +- test-suite/output/Fixpoint.out | 15 +- test-suite/output/Fixpoint.v | 8 +- test-suite/output/Implicit.out | 2 + test-suite/output/Implicit.v | 17 +- test-suite/output/InitSyntax.out | 2 +- test-suite/output/Notations.out | 16 +- test-suite/output/Notations.v | 8 + test-suite/output/Notations2.out | 25 +- test-suite/output/Notations2.v | 26 +- test-suite/output/NumbersSyntax.out | 14 +- test-suite/output/PrintInfos.out | 129 + test-suite/output/PrintInfos.v | 41 + test-suite/output/Record.out | 16 + test-suite/output/Record.v | 21 + test-suite/output/Search.out | 6 + test-suite/output/SearchPattern.out | 8 +- test-suite/output/Tactics.out | 10 +- test-suite/output/Tactics.v | 13 +- test-suite/output/ZSyntax.out | 8 +- test-suite/output/ZSyntax.v | 8 +- test-suite/output/inference.out | 6 + test-suite/output/inference.v | 14 + test-suite/output/rewrite-2172.out | 2 + test-suite/output/rewrite-2172.v | 21 + test-suite/success/AdvancedCanonicalStructure.v | 18 +- test-suite/success/CaseAlias.v | 70 + test-suite/success/Cases.v | 83 +- test-suite/success/CasesDep.v | 54 + test-suite/success/Check.v | 2 +- test-suite/success/Discriminate.v | 6 + test-suite/success/Field.v | 4 +- test-suite/success/Hints.v | 2 +- test-suite/success/Inductive.v | 29 + test-suite/success/Inversion.v | 15 +- test-suite/success/LegacyField.v | 4 +- test-suite/success/Notations.v | 27 + test-suite/success/Nsatz.v | 574 ++- test-suite/success/PCase.v | 66 + test-suite/success/PrintSortedUniverses.v | 2 + test-suite/success/ProgramWf.v | 6 + test-suite/success/RecTutorial.v | 98 +- test-suite/success/Scheme.v | 4 + test-suite/success/Tauto.v | 4 +- test-suite/success/TestRefine.v | 2 +- test-suite/success/apply.v | 34 +- test-suite/success/auto.v | 26 + test-suite/success/autorewrite.v | 29 + test-suite/success/autorewritein.v | 23 - test-suite/success/bullet.v | 5 + test-suite/success/change.v | 8 + test-suite/success/coercions.v | 8 + test-suite/success/conv_pbs.v | 5 + test-suite/success/destruct.v | 19 + test-suite/success/eauto.v | 2 +- test-suite/success/eqdecide.v | 9 +- test-suite/success/eta.v | 19 + test-suite/success/evars.v | 71 + test-suite/success/extraction.v | 4 +- test-suite/success/fix.v | 5 +- test-suite/success/implicit.v | 17 + test-suite/success/inds_type_sec.v | 2 +- test-suite/success/induct.v | 25 +- test-suite/success/ltac.v | 27 + test-suite/success/mutual_ind.v | 2 +- test-suite/success/polymorphism.v | 2 +- test-suite/success/proof_using.v | 61 + test-suite/success/remember.v | 8 + test-suite/success/rewrite.v | 21 + test-suite/success/searchabout.v | 60 + test-suite/success/setoid_test.v | 35 + test-suite/success/simpl_tuning.v | 149 + test-suite/success/telescope_canonical.v | 12 + test-suite/success/unfold.v | 2 +- test-suite/success/unification.v | 50 +- test-suite/success/universes-coercion.v | 22 + test-suite/typeclasses/NewSetoid.v | 4 +- theories/Arith/Arith.v | 4 +- theories/Arith/Arith_base.v | 4 +- theories/Arith/Between.v | 4 +- theories/Arith/Bool_nat.v | 6 +- theories/Arith/Compare.v | 6 +- theories/Arith/Compare_dec.v | 18 +- theories/Arith/Div2.v | 4 +- theories/Arith/EqNat.v | 4 +- theories/Arith/Euclid.v | 13 +- theories/Arith/Even.v | 4 +- theories/Arith/Factorial.v | 8 +- theories/Arith/Gt.v | 4 +- theories/Arith/Le.v | 11 +- theories/Arith/Lt.v | 11 +- theories/Arith/Max.v | 58 +- theories/Arith/Min.v | 52 +- theories/Arith/MinMax.v | 113 - theories/Arith/Minus.v | 4 +- theories/Arith/Mult.v | 19 +- theories/Arith/NatOrderedType.v | 64 - theories/Arith/Peano_dec.v | 26 +- theories/Arith/Plus.v | 31 +- theories/Arith/Wf_nat.v | 23 +- theories/Arith/vo.itarget | 2 - theories/Bool/Bool.v | 33 +- theories/Bool/BoolEq.v | 3 +- theories/Bool/Bvector.v | 197 +- theories/Bool/DecBool.v | 4 +- theories/Bool/IfProp.v | 6 +- theories/Bool/Sumbool.v | 6 +- theories/Bool/Zerob.v | 6 +- theories/Classes/EquivDec.v | 4 +- theories/Classes/Equivalence.v | 4 +- theories/Classes/Init.v | 6 +- theories/Classes/Morphisms.v | 125 +- theories/Classes/Morphisms_Prop.v | 32 +- theories/Classes/Morphisms_Relations.v | 10 +- theories/Classes/RelationClasses.v | 85 +- theories/Classes/RelationPairs.v | 34 +- theories/Classes/SetoidClass.v | 6 +- theories/Classes/SetoidDec.v | 19 +- theories/Classes/SetoidTactics.v | 4 +- theories/FSets/FMapAVL.v | 13 +- theories/FSets/FMapFacts.v | 55 +- theories/FSets/FMapFullAVL.v | 2 - theories/FSets/FMapInterface.v | 3 +- theories/FSets/FMapList.v | 2 - theories/FSets/FMapPositive.v | 12 +- theories/FSets/FMapWeakList.v | 2 - theories/FSets/FMaps.v | 2 - theories/FSets/FSetAVL.v | 2 - theories/FSets/FSetBridge.v | 2 - theories/FSets/FSetCompat.v | 2 +- theories/FSets/FSetDecide.v | 2 - theories/FSets/FSetEqProperties.v | 2 - theories/FSets/FSetFacts.v | 2 - theories/FSets/FSetInterface.v | 3 +- theories/FSets/FSetList.v | 2 - theories/FSets/FSetProperties.v | 29 +- theories/FSets/FSetToFiniteSet.v | 2 - theories/FSets/FSetWeakList.v | 2 - theories/FSets/FSets.v | 2 - theories/Init/Datatypes.v | 182 +- theories/Init/Logic.v | 118 +- theories/Init/Logic_Type.v | 4 +- theories/Init/Notations.v | 4 +- theories/Init/Peano.v | 96 +- theories/Init/Prelude.v | 7 +- theories/Init/Specif.v | 36 +- theories/Init/Tactics.v | 12 +- theories/Init/Wf.v | 4 +- theories/Lists/List.v | 27 +- theories/Lists/ListSet.v | 4 +- theories/Lists/ListTactics.v | 4 +- theories/Lists/SetoidList.v | 11 +- theories/Lists/StreamMemo.v | 2 +- theories/Lists/Streams.v | 4 +- theories/Lists/TheoryList.v | 423 -- theories/Lists/intro.tex | 4 - theories/Lists/vo.itarget | 1 - theories/Logic/Berardi.v | 4 +- theories/Logic/ChoiceFacts.v | 4 +- theories/Logic/Classical.v | 4 +- theories/Logic/ClassicalChoice.v | 4 +- theories/Logic/ClassicalDescription.v | 10 +- theories/Logic/ClassicalEpsilon.v | 4 +- theories/Logic/ClassicalFacts.v | 4 +- theories/Logic/ClassicalUniqueChoice.v | 4 +- theories/Logic/Classical_Pred_Set.v | 5 +- theories/Logic/Classical_Pred_Type.v | 5 +- theories/Logic/Classical_Prop.v | 6 +- theories/Logic/Classical_Type.v | 4 +- theories/Logic/ConstructiveEpsilon.v | 92 +- theories/Logic/Decidable.v | 4 +- theories/Logic/Description.v | 4 +- theories/Logic/Diaconescu.v | 8 +- theories/Logic/Epsilon.v | 4 +- theories/Logic/Eqdep.v | 6 +- theories/Logic/EqdepFacts.v | 124 +- theories/Logic/Eqdep_dec.v | 5 +- theories/Logic/ExtensionalityFacts.v | 136 + theories/Logic/FunctionalExtensionality.v | 4 +- theories/Logic/Hurkens.v | 2 +- theories/Logic/IndefiniteDescription.v | 4 +- theories/Logic/JMeq.v | 9 +- theories/Logic/ProofIrrelevance.v | 2 +- theories/Logic/ProofIrrelevanceFacts.v | 2 +- theories/Logic/RelationalChoice.v | 4 +- theories/Logic/SetIsType.v | 4 +- theories/MSets/MSetAVL.v | 15 +- theories/MSets/MSetDecide.v | 2 - theories/MSets/MSetEqProperties.v | 2 - theories/MSets/MSetFacts.v | 2 - theories/MSets/MSetInterface.v | 219 +- theories/MSets/MSetList.v | 5 +- theories/MSets/MSetProperties.v | 27 +- theories/MSets/MSetToFiniteSet.v | 2 - theories/MSets/MSetWeakList.v | 4 +- theories/MSets/MSets.v | 2 - theories/NArith/BinNat.v | 1235 +++-- theories/NArith/BinNatDef.v | 381 ++ theories/NArith/BinPos.v | 1172 ----- theories/NArith/NArith.v | 23 +- theories/NArith/NOrderedType.v | 60 - theories/NArith/Ndec.v | 12 +- theories/NArith/Ndigits.v | 517 +- theories/NArith/Ndist.v | 8 +- theories/NArith/Ndiv_def.v | 31 + theories/NArith/Ngcd_def.v | 22 + theories/NArith/Nminmax.v | 126 - theories/NArith/Nnat.v | 450 +- theories/NArith/Nsqrt_def.v | 18 + theories/NArith/POrderedType.v | 60 - theories/NArith/Pminmax.v | 126 - theories/NArith/Pnat.v | 462 -- theories/NArith/intro.tex | 2 +- theories/NArith/vo.itarget | 10 +- theories/Numbers/BigNumPrelude.v | 10 +- theories/Numbers/BinNums.v | 61 + theories/Numbers/Cyclic/Abstract/CyclicAxioms.v | 486 +- theories/Numbers/Cyclic/Abstract/NZCyclic.v | 141 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleAdd.v | 4 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleBase.v | 80 +- .../Numbers/Cyclic/DoubleCyclic/DoubleCyclic.v | 425 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleDiv.v | 122 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleDivn1.v | 130 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleLift.v | 38 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleMul.v | 23 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleSqrt.v | 29 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleSub.v | 4 +- theories/Numbers/Cyclic/DoubleCyclic/DoubleType.v | 6 +- theories/Numbers/Cyclic/Int31/Cyclic31.v | 326 +- theories/Numbers/Cyclic/Int31/Int31.v | 26 +- theories/Numbers/Cyclic/Int31/Ring31.v | 11 +- theories/Numbers/Cyclic/ZModulo/ZModulo.v | 483 +- theories/Numbers/Integer/Abstract/ZAdd.v | 48 +- theories/Numbers/Integer/Abstract/ZAddOrder.v | 123 +- theories/Numbers/Integer/Abstract/ZAxioms.v | 102 +- theories/Numbers/Integer/Abstract/ZBase.v | 19 +- theories/Numbers/Integer/Abstract/ZBits.v | 1947 ++++++++ theories/Numbers/Integer/Abstract/ZDivEucl.v | 103 +- theories/Numbers/Integer/Abstract/ZDivFloor.v | 123 +- theories/Numbers/Integer/Abstract/ZDivTrunc.v | 596 ++- theories/Numbers/Integer/Abstract/ZGcd.v | 274 ++ theories/Numbers/Integer/Abstract/ZLcm.v | 471 ++ theories/Numbers/Integer/Abstract/ZLt.v | 24 +- theories/Numbers/Integer/Abstract/ZMaxMin.v | 179 + theories/Numbers/Integer/Abstract/ZMul.v | 17 +- theories/Numbers/Integer/Abstract/ZMulOrder.v | 91 +- theories/Numbers/Integer/Abstract/ZParity.v | 52 + theories/Numbers/Integer/Abstract/ZPow.v | 124 + theories/Numbers/Integer/Abstract/ZProperties.v | 25 +- theories/Numbers/Integer/Abstract/ZSgnAbs.v | 88 +- theories/Numbers/Integer/BigZ/BigZ.v | 114 +- theories/Numbers/Integer/BigZ/ZMake.v | 375 +- theories/Numbers/Integer/Binary/ZBinary.v | 121 +- theories/Numbers/Integer/NatPairs/ZNatPairs.v | 58 +- theories/Numbers/Integer/SpecViaZ/ZSig.v | 74 +- theories/Numbers/Integer/SpecViaZ/ZSigZAxioms.v | 334 +- theories/Numbers/NaryFunctions.v | 4 +- theories/Numbers/NatInt/NZAdd.v | 34 +- theories/Numbers/NatInt/NZAddOrder.v | 35 +- theories/Numbers/NatInt/NZAxioms.v | 42 +- theories/Numbers/NatInt/NZBase.v | 19 +- theories/Numbers/NatInt/NZBits.v | 64 + theories/Numbers/NatInt/NZDiv.v | 112 +- theories/Numbers/NatInt/NZDomain.v | 121 +- theories/Numbers/NatInt/NZGcd.v | 307 ++ theories/Numbers/NatInt/NZLog.v | 889 ++++ theories/Numbers/NatInt/NZMul.v | 37 +- theories/Numbers/NatInt/NZMulOrder.v | 221 +- theories/Numbers/NatInt/NZOrder.v | 129 +- theories/Numbers/NatInt/NZParity.v | 263 + theories/Numbers/NatInt/NZPow.v | 411 ++ theories/Numbers/NatInt/NZProperties.v | 8 +- theories/Numbers/NatInt/NZSqrt.v | 734 +++ theories/Numbers/Natural/Abstract/NAdd.v | 22 +- theories/Numbers/Natural/Abstract/NAddOrder.v | 10 +- theories/Numbers/Natural/Abstract/NAxioms.v | 58 +- theories/Numbers/Natural/Abstract/NBase.v | 59 +- theories/Numbers/Natural/Abstract/NBits.v | 1463 ++++++ theories/Numbers/Natural/Abstract/NDefOps.v | 177 +- theories/Numbers/Natural/Abstract/NDiv.v | 50 +- theories/Numbers/Natural/Abstract/NGcd.v | 213 + theories/Numbers/Natural/Abstract/NIso.v | 21 +- theories/Numbers/Natural/Abstract/NLcm.v | 290 ++ theories/Numbers/Natural/Abstract/NLog.v | 23 + theories/Numbers/Natural/Abstract/NMaxMin.v | 135 + theories/Numbers/Natural/Abstract/NMulOrder.v | 22 +- theories/Numbers/Natural/Abstract/NOrder.v | 43 +- theories/Numbers/Natural/Abstract/NParity.v | 63 + theories/Numbers/Natural/Abstract/NPow.v | 160 + theories/Numbers/Natural/Abstract/NProperties.v | 21 +- theories/Numbers/Natural/Abstract/NSqrt.v | 75 + theories/Numbers/Natural/Abstract/NStrongRec.v | 44 +- theories/Numbers/Natural/Abstract/NSub.v | 44 +- theories/Numbers/Natural/BigN/BigN.v | 107 +- theories/Numbers/Natural/BigN/NMake.v | 1448 +++++- theories/Numbers/Natural/BigN/NMake_gen.ml | 3511 ++++---------- theories/Numbers/Natural/BigN/Nbasic.v | 223 +- theories/Numbers/Natural/Binary/NBinary.v | 141 +- theories/Numbers/Natural/Peano/NPeano.v | 806 ++- theories/Numbers/Natural/SpecViaZ/NSig.v | 76 +- theories/Numbers/Natural/SpecViaZ/NSigNAxioms.v | 375 +- theories/Numbers/NumPrelude.v | 125 +- theories/Numbers/Rational/BigQ/BigQ.v | 66 +- theories/Numbers/Rational/BigQ/QMake.v | 127 +- theories/Numbers/Rational/SpecViaQ/QSig.v | 12 +- theories/Numbers/vo.itarget | 23 +- theories/PArith/BinPos.v | 2132 ++++++++ theories/PArith/BinPosDef.v | 565 +++ theories/PArith/PArith.v | 11 + theories/PArith/POrderedType.v | 36 + theories/PArith/Pnat.v | 483 ++ theories/PArith/intro.tex | 4 + theories/PArith/vo.itarget | 5 + theories/Program/Basics.v | 10 +- theories/Program/Combinators.v | 4 +- theories/Program/Equality.v | 108 +- theories/Program/Program.v | 6 +- theories/Program/Subset.v | 4 +- theories/Program/Syntax.v | 47 +- theories/Program/Tactics.v | 26 +- theories/Program/Utils.v | 4 +- theories/Program/Wf.v | 4 +- theories/QArith/QArith.v | 4 +- theories/QArith/QArith_base.v | 169 +- theories/QArith/QOrderedType.v | 2 +- theories/QArith/Qabs.v | 37 +- theories/QArith/Qcanon.v | 16 +- theories/QArith/Qfield.v | 4 +- theories/QArith/Qminmax.v | 4 +- theories/QArith/Qpower.v | 6 +- theories/QArith/Qreals.v | 6 +- theories/QArith/Qreduction.v | 52 +- theories/QArith/Qring.v | 4 +- theories/QArith/Qround.v | 15 +- theories/Reals/Alembert.v | 8 +- theories/Reals/AltSeries.v | 4 +- theories/Reals/ArithProp.v | 4 +- theories/Reals/Binomial.v | 4 +- theories/Reals/Cauchy_prod.v | 4 +- theories/Reals/Cos_plus.v | 4 +- theories/Reals/Cos_rel.v | 4 +- theories/Reals/DiscrR.v | 4 +- theories/Reals/Exp_prop.v | 6 +- theories/Reals/Integration.v | 6 +- theories/Reals/LegacyRfield.v | 4 +- theories/Reals/MVT.v | 4 +- theories/Reals/NewtonInt.v | 4 +- theories/Reals/PSeries_reg.v | 4 +- theories/Reals/PartSum.v | 4 +- theories/Reals/RIneq.v | 46 +- theories/Reals/RList.v | 4 +- theories/Reals/ROrderedType.v | 4 +- theories/Reals/R_Ifp.v | 4 +- theories/Reals/R_sqr.v | 6 +- theories/Reals/R_sqrt.v | 4 +- theories/Reals/Ranalysis.v | 4 +- theories/Reals/Ranalysis1.v | 38 +- theories/Reals/Ranalysis2.v | 4 +- theories/Reals/Ranalysis3.v | 4 +- theories/Reals/Ranalysis4.v | 4 +- theories/Reals/Raxioms.v | 10 +- theories/Reals/Rbase.v | 4 +- theories/Reals/Rbasic_fun.v | 4 +- theories/Reals/Rcomplete.v | 4 +- theories/Reals/Rdefinitions.v | 4 +- theories/Reals/Rderiv.v | 14 +- theories/Reals/Reals.v | 6 +- theories/Reals/Rfunctions.v | 257 +- theories/Reals/Rgeom.v | 4 +- theories/Reals/RiemannInt.v | 6 +- theories/Reals/RiemannInt_SF.v | 6 +- theories/Reals/Rlimit.v | 5 +- theories/Reals/Rlogic.v | 9 +- theories/Reals/Rminmax.v | 2 +- theories/Reals/Rpow_def.v | 4 +- theories/Reals/Rpower.v | 3 +- theories/Reals/Rprod.v | 6 +- theories/Reals/Rseries.v | 207 +- theories/Reals/Rsigma.v | 4 +- theories/Reals/Rsqrt_def.v | 12 +- theories/Reals/Rtopology.v | 4 +- theories/Reals/Rtrigo.v | 11 +- theories/Reals/Rtrigo_alt.v | 4 +- theories/Reals/Rtrigo_calc.v | 8 +- theories/Reals/Rtrigo_def.v | 10 +- theories/Reals/Rtrigo_fun.v | 4 +- theories/Reals/Rtrigo_reg.v | 4 +- theories/Reals/SeqProp.v | 317 +- theories/Reals/SeqSeries.v | 4 +- theories/Reals/SplitAbsolu.v | 4 +- theories/Reals/SplitRmult.v | 4 +- theories/Reals/Sqrt_reg.v | 4 +- theories/Relations/Operators_Properties.v | 26 +- theories/Relations/Relation_Definitions.v | 4 +- theories/Relations/Relation_Operators.v | 14 +- theories/Relations/Relations.v | 4 +- theories/Setoids/Setoid.v | 4 +- theories/Sets/Classical_sets.v | 4 +- theories/Sets/Constructive_sets.v | 4 +- theories/Sets/Cpo.v | 6 +- theories/Sets/Ensembles.v | 4 +- theories/Sets/Finite_sets.v | 4 +- theories/Sets/Finite_sets_facts.v | 8 +- theories/Sets/Image.v | 6 +- theories/Sets/Infinite_sets.v | 4 +- theories/Sets/Integers.v | 4 +- theories/Sets/Multiset.v | 4 +- theories/Sets/Partial_Order.v | 6 +- theories/Sets/Permut.v | 6 +- theories/Sets/Powerset.v | 6 +- theories/Sets/Powerset_Classical_facts.v | 4 +- theories/Sets/Powerset_facts.v | 4 +- theories/Sets/Relations_1.v | 6 +- theories/Sets/Relations_1_facts.v | 6 +- theories/Sets/Relations_2.v | 6 +- theories/Sets/Relations_2_facts.v | 6 +- theories/Sets/Relations_3.v | 4 +- theories/Sets/Relations_3_facts.v | 6 +- theories/Sets/Uniset.v | 6 +- theories/Sorting/Heap.v | 4 +- theories/Sorting/Mergesort.v | 4 +- theories/Sorting/PermutEq.v | 4 +- theories/Sorting/PermutSetoid.v | 17 +- theories/Sorting/Permutation.v | 86 +- theories/Sorting/Sorted.v | 6 +- theories/Sorting/Sorting.v | 4 +- theories/Strings/Ascii.v | 4 +- theories/Strings/String.v | 12 +- theories/Structures/DecidableType.v | 2 - theories/Structures/DecidableTypeEx.v | 2 - theories/Structures/Equalities.v | 77 +- theories/Structures/EqualitiesFacts.v | 23 +- theories/Structures/GenericMinMax.v | 16 +- theories/Structures/OrderedType.v | 19 +- theories/Structures/OrderedTypeAlt.v | 2 - theories/Structures/OrderedTypeEx.v | 24 +- theories/Structures/Orders.v | 109 +- theories/Structures/OrdersAlt.v | 2 - theories/Structures/OrdersEx.v | 12 +- theories/Structures/OrdersFacts.v | 324 +- theories/Structures/OrdersLists.v | 6 +- theories/Unicode/Utf8.v | 44 +- theories/Unicode/Utf8_core.v | 4 +- theories/Vectors/Fin.v | 176 + theories/Vectors/Vector.v | 22 + theories/Vectors/VectorDef.v | 317 ++ theories/Vectors/VectorSpec.v | 113 + theories/Vectors/vo.itarget | 4 + theories/Wellfounded/Disjoint_Union.v | 4 +- theories/Wellfounded/Inclusion.v | 4 +- theories/Wellfounded/Inverse_Image.v | 4 +- .../Wellfounded/Lexicographic_Exponentiation.v | 4 +- theories/Wellfounded/Lexicographic_Product.v | 4 +- theories/Wellfounded/Transitive_Closure.v | 4 +- theories/Wellfounded/Union.v | 4 +- theories/Wellfounded/Well_Ordering.v | 4 +- theories/Wellfounded/Wellfounded.v | 4 +- theories/ZArith/BinInt.v | 2011 +++++--- theories/ZArith/BinIntDef.v | 610 +++ theories/ZArith/Int.v | 12 +- theories/ZArith/Wf_Z.v | 197 +- theories/ZArith/ZArith.v | 9 +- theories/ZArith/ZArith_base.v | 11 +- theories/ZArith/ZArith_dec.v | 13 +- theories/ZArith/ZOdiv.v | 947 ---- theories/ZArith/ZOdiv_def.v | 136 - theories/ZArith/ZOrderedType.v | 60 - theories/ZArith/Zabs.v | 224 +- theories/ZArith/Zbool.v | 183 +- theories/ZArith/Zcompare.v | 457 +- theories/ZArith/Zcomplements.v | 143 +- theories/ZArith/Zdigits.v | 14 +- theories/ZArith/Zdiv.v | 897 +--- theories/ZArith/Zeuclid.v | 52 + theories/ZArith/Zeven.v | 371 +- theories/ZArith/Zgcd_alt.v | 8 +- theories/ZArith/Zhints.v | 441 +- theories/ZArith/Zlogarithm.v | 48 +- theories/ZArith/Zmax.v | 109 +- theories/ZArith/Zmin.v | 89 +- theories/ZArith/Zminmax.v | 188 +- theories/ZArith/Zmisc.v | 71 +- theories/ZArith/Znat.v | 1063 +++- theories/ZArith/Znumtheory.v | 810 +--- theories/ZArith/Zorder.v | 893 +--- theories/ZArith/Zpow_alt.v | 83 + theories/ZArith/Zpow_def.v | 42 +- theories/ZArith/Zpow_facts.v | 510 +- theories/ZArith/Zpower.v | 427 +- theories/ZArith/Zquot.v | 536 ++ theories/ZArith/Zsqrt.v | 215 - theories/ZArith/Zsqrt_compat.v | 233 + theories/ZArith/Zwf.v | 4 +- theories/ZArith/auxiliary.v | 87 +- theories/ZArith/vo.itarget | 9 +- theories/theories.itarget | 2 + tools/beautify-archive | 0 tools/compat5.ml | 13 + tools/compat5.mlp | 23 + tools/compat5b.ml | 13 + tools/compat5b.mlp | 23 + tools/coq-syntax.el | 3 + tools/coq_makefile.ml | 714 +++ tools/coq_makefile.ml4 | 614 --- tools/coq_tex.ml4 | 4 +- tools/coqdep.ml | 11 +- tools/coqdep_boot.ml | 6 +- tools/coqdep_common.ml | 110 +- tools/coqdep_common.mli | 49 + tools/coqdep_lexer.mli | 27 + tools/coqdep_lexer.mll | 228 +- tools/coqdoc/alpha.ml | 4 +- tools/coqdoc/alpha.mli | 4 +- tools/coqdoc/cdglobals.ml | 46 +- tools/coqdoc/coqdoc.css | 46 +- tools/coqdoc/cpretty.mli | 4 +- tools/coqdoc/cpretty.mll | 156 +- tools/coqdoc/index.ml | 56 +- tools/coqdoc/index.mli | 6 +- tools/coqdoc/main.ml | 49 +- tools/coqdoc/output.ml | 100 +- tools/coqdoc/output.mli | 21 +- tools/coqdoc/tokens.ml | 2 +- tools/coqdoc/tokens.mli | 2 +- tools/coqwc.mll | 4 +- tools/fake_ide.ml | 84 + tools/gallina.ml | 4 +- tools/gallina_lexer.mll | 4 +- toplevel/auto_ind_decl.ml | 92 +- toplevel/auto_ind_decl.mli | 13 +- toplevel/autoinstance.ml | 21 +- toplevel/autoinstance.mli | 16 +- toplevel/cerrors.ml | 152 +- toplevel/cerrors.mli | 19 +- toplevel/class.ml | 22 +- toplevel/class.mli | 18 +- toplevel/classes.ml | 131 +- toplevel/classes.mli | 46 +- toplevel/command.ml | 90 +- toplevel/command.mli | 78 +- toplevel/coqinit.ml | 63 +- toplevel/coqinit.mli | 7 +- toplevel/coqtop.ml | 114 +- toplevel/coqtop.mli | 15 +- toplevel/discharge.ml | 4 +- toplevel/discharge.mli | 4 +- toplevel/himsg.ml | 285 +- toplevel/himsg.mli | 17 +- toplevel/ide_intf.ml | 434 ++ toplevel/ide_intf.mli | 87 + toplevel/ide_slave.ml | 579 +++ toplevel/ide_slave.mli | 17 + toplevel/ind_tables.ml | 29 +- toplevel/ind_tables.mli | 16 +- toplevel/indschemes.ml | 27 +- toplevel/indschemes.mli | 26 +- toplevel/interface.mli | 87 + toplevel/lemmas.ml | 57 +- toplevel/lemmas.mli | 23 +- toplevel/libtypes.ml | 4 +- toplevel/libtypes.mli | 20 +- toplevel/metasyntax.ml | 132 +- toplevel/metasyntax.mli | 22 +- toplevel/mltop.ml4 | 41 +- toplevel/mltop.mli | 34 +- toplevel/record.ml | 110 +- toplevel/record.mli | 24 +- toplevel/search.ml | 45 +- toplevel/search.mli | 10 +- toplevel/toplevel.ml | 70 +- toplevel/toplevel.mli | 28 +- toplevel/toplevel.mllib | 2 + toplevel/usage.ml | 141 +- toplevel/usage.mli | 14 +- toplevel/vernac.ml | 78 +- toplevel/vernac.mli | 27 +- toplevel/vernacentries.ml | 578 ++- toplevel/vernacentries.mli | 31 +- toplevel/vernacexpr.ml | 90 +- toplevel/vernacinterp.ml | 8 +- toplevel/vernacinterp.mli | 8 +- toplevel/whelp.ml4 | 52 +- toplevel/whelp.mli | 6 +- 1481 files changed, 88042 insertions(+), 68424 deletions(-) create mode 100644 .dir-locals.el delete mode 100644 Makefile.stage1 delete mode 100644 Makefile.stage2 create mode 100644 TODO create mode 100644 checker/mod_checking.mli create mode 100644 dev/Makefile.oug create mode 100644 dev/doc/about-hints create mode 100644 dev/doc/unification.txt create mode 100644 dev/ocamldoc/docintro create mode 100644 dev/ocamldoc/html/style.css delete mode 100644 dev/ocamlweb-doc/Makefile delete mode 100644 dev/ocamlweb-doc/ast.ml delete mode 100644 dev/ocamlweb-doc/interp.dep.ps delete mode 100644 dev/ocamlweb-doc/intro.tex delete mode 100644 dev/ocamlweb-doc/kernel.dep.ps delete mode 100644 dev/ocamlweb-doc/lex.mll delete mode 100644 dev/ocamlweb-doc/library.dep.ps delete mode 100644 dev/ocamlweb-doc/macros.tex delete mode 100644 dev/ocamlweb-doc/parse.ml delete mode 100644 dev/ocamlweb-doc/parsing.dep.ps delete mode 100644 dev/ocamlweb-doc/preamble.tex delete mode 100644 dev/ocamlweb-doc/pretyping.dep.ps delete mode 100644 dev/ocamlweb-doc/proofs.dep.ps delete mode 100644 dev/ocamlweb-doc/syntax.mly delete mode 100644 dev/ocamlweb-doc/tactics.dep.ps delete mode 100644 dev/ocamlweb-doc/toplevel.dep.ps create mode 100755 dev/tools/change-header delete mode 100755 dev/tools/univdot delete mode 100644 doc/common/styles/html/coqremote/footer.html delete mode 100644 doc/common/styles/html/coqremote/header.html delete mode 100644 doc/common/styles/html/simple/footer.html delete mode 100644 doc/common/styles/html/simple/header.html create mode 100644 doc/stdlib/index-trailer.html delete mode 100644 ide/.coqide-gtk2rc delete mode 100644 ide/config_parser.mly delete mode 100644 ide/coq_tactics.ml delete mode 100644 ide/coq_tactics.mli create mode 100644 ide/coqide-gtk2rc create mode 100644 ide/coqide_main.ml4 create mode 100644 ide/coqide_ui.ml delete mode 100644 ide/highlight.mll create mode 100644 ide/ide_mac_stubs.c create mode 100644 ide/ide_win32_stubs.c create mode 100644 ide/ideproof.ml create mode 100644 ide/mac_default_accel_map create mode 100644 ide/minilib.ml create mode 100644 ide/minilib.mli create mode 100644 ide/project_file.ml4 delete mode 100644 ide/uim/coqide-custom.scm delete mode 100644 ide/uim/coqide-rules.scm delete mode 100644 ide/uim/coqide.scm delete mode 100644 lib/bstack.ml delete mode 100644 lib/bstack.mli delete mode 100644 lib/edit.ml delete mode 100644 lib/edit.mli create mode 100644 lib/errors.ml create mode 100644 lib/errors.mli delete mode 100644 lib/gset.ml delete mode 100644 lib/gset.mli create mode 100644 lib/hashtbl_alt.ml create mode 100644 lib/hashtbl_alt.mli delete mode 100644 lib/refutpat.ml4 create mode 100644 lib/store.ml create mode 100644 lib/store.mli delete mode 100644 lib/tlm.ml delete mode 100644 lib/tlm.mli create mode 100644 lib/unionfind.ml create mode 100644 lib/unionfind.mli create mode 100644 lib/xml_lexer.mli create mode 100644 lib/xml_lexer.mll create mode 100644 lib/xml_parser.ml create mode 100644 lib/xml_parser.mli create mode 100644 lib/xml_utils.ml create mode 100644 lib/xml_utils.mli create mode 100644 library/goptionstyp.mli delete mode 100644 parsing/g_decl_mode.ml4 delete mode 100644 parsing/g_intsyntax.mli delete mode 100644 parsing/g_natsyntax.mli delete mode 100644 parsing/g_zsyntax.mli delete mode 100644 parsing/ppdecl_proof.ml delete mode 100644 parsing/ppdecl_proof.mli create mode 100644 parsing/tok.ml create mode 100644 parsing/tok.mli create mode 100644 plugins/decl_mode/decl_expr.mli create mode 100644 plugins/decl_mode/decl_interp.ml create mode 100644 plugins/decl_mode/decl_interp.mli create mode 100644 plugins/decl_mode/decl_mode.ml create mode 100644 plugins/decl_mode/decl_mode.mli create mode 100644 plugins/decl_mode/decl_mode_plugin.mllib create mode 100644 plugins/decl_mode/decl_proof_instr.ml create mode 100644 plugins/decl_mode/decl_proof_instr.mli create mode 100644 plugins/decl_mode/g_decl_mode.ml4 create mode 100644 plugins/decl_mode/ppdecl_proof.ml create mode 100644 plugins/decl_mode/ppdecl_proof.mli create mode 100644 plugins/funind/glob_term_to_relation.ml create mode 100644 plugins/funind/glob_term_to_relation.mli create mode 100644 plugins/funind/glob_termops.ml create mode 100644 plugins/funind/glob_termops.mli create mode 100644 plugins/funind/indfun.mli delete mode 100644 plugins/funind/rawterm_to_relation.ml delete mode 100644 plugins/funind/rawterm_to_relation.mli delete mode 100644 plugins/funind/rawtermops.ml delete mode 100644 plugins/funind/rawtermops.mli create mode 100644 plugins/micromega/polynomial.ml create mode 100644 plugins/setoid_ring/Algebra_syntax.v create mode 100644 plugins/setoid_ring/Cring.v create mode 100644 plugins/setoid_ring/Integral_domain.v create mode 100644 plugins/setoid_ring/Ncring.v create mode 100644 plugins/setoid_ring/Ncring_initial.v create mode 100644 plugins/setoid_ring/Ncring_polynom.v create mode 100644 plugins/setoid_ring/Ncring_tac.v create mode 100644 plugins/setoid_ring/Rings_Q.v create mode 100644 plugins/setoid_ring/Rings_R.v create mode 100644 plugins/setoid_ring/Rings_Z.v create mode 100644 pretyping/arguments_renaming.ml create mode 100644 pretyping/arguments_renaming.mli delete mode 100644 pretyping/clenv.ml delete mode 100644 pretyping/clenv.mli create mode 100644 pretyping/glob_term.ml create mode 100644 pretyping/glob_term.mli delete mode 100644 pretyping/rawterm.ml delete mode 100644 pretyping/rawterm.mli create mode 100644 proofs/clenv.ml create mode 100644 proofs/clenv.mli delete mode 100644 proofs/decl_expr.mli delete mode 100644 proofs/decl_mode.ml delete mode 100644 proofs/decl_mode.mli create mode 100644 proofs/goal.ml create mode 100644 proofs/goal.mli create mode 100644 proofs/proof.ml create mode 100644 proofs/proof.mli create mode 100644 proofs/proof_global.ml create mode 100644 proofs/proof_global.mli delete mode 100644 proofs/proof_trees.ml delete mode 100644 proofs/proof_trees.mli create mode 100644 proofs/proofview.ml create mode 100644 proofs/proofview.mli delete mode 100644 proofs/tmp-src delete mode 100644 tactics/decl_interp.ml delete mode 100644 tactics/decl_interp.mli delete mode 100644 tactics/decl_proof_instr.ml delete mode 100644 tactics/decl_proof_instr.mli create mode 100644 test-suite/bugs/closed/2105.v create mode 100644 test-suite/bugs/closed/shouldfail/2406.v create mode 100644 test-suite/bugs/closed/shouldfail/2586.v create mode 100644 test-suite/bugs/closed/shouldsucceed/1834.v create mode 100644 test-suite/bugs/closed/shouldsucceed/1912.v create mode 100644 test-suite/bugs/closed/shouldsucceed/1962.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2141.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2181.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2304.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2307.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2320.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2342.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2362.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2378.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2393.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2404.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2456.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2473.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2603.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2613.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2615.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2616.v create mode 100644 test-suite/bugs/closed/shouldsucceed/2640.v create mode 100644 test-suite/bugs/opened/shouldnotfail/2310.v create mode 100644 test-suite/complexity/Notations.v create mode 100644 test-suite/complexity/evar_instance.v create mode 100644 test-suite/complexity/guard.v create mode 100644 test-suite/complexity/patternmatching.v create mode 100644 test-suite/failure/inductive4.v delete mode 100644 test-suite/failure/universes2.v create mode 100644 test-suite/ide/undo001.fake create mode 100644 test-suite/ide/undo002.fake create mode 100644 test-suite/ide/undo003.fake create mode 100644 test-suite/ide/undo004.fake create mode 100644 test-suite/ide/undo005.fake create mode 100644 test-suite/ide/undo006.fake create mode 100644 test-suite/ide/undo007.fake create mode 100644 test-suite/ide/undo008.fake create mode 100644 test-suite/ide/undo009.fake create mode 100644 test-suite/ide/undo010.fake create mode 100644 test-suite/ide/undo011.fake create mode 100644 test-suite/ide/undo012.fake create mode 100644 test-suite/ide/undo013.fake create mode 100644 test-suite/ide/undo014.fake create mode 100644 test-suite/ide/undo015.fake create mode 100644 test-suite/ide/undo016.fake create mode 100644 test-suite/ide/undo017.fake create mode 100644 test-suite/ide/undo018.fake create mode 100644 test-suite/ide/undo019.fake delete mode 100644 test-suite/ideal-features/Case8.v delete mode 100644 test-suite/micromega/csdp.cache create mode 100644 test-suite/misc/universes/universes.v create mode 100644 test-suite/modules/errors.v create mode 100644 test-suite/output/Arguments.out create mode 100644 test-suite/output/Arguments.v create mode 100644 test-suite/output/Arguments_renaming.out create mode 100644 test-suite/output/Arguments_renaming.v create mode 100644 test-suite/output/Errors.out create mode 100644 test-suite/output/Errors.v create mode 100644 test-suite/output/PrintInfos.out create mode 100644 test-suite/output/PrintInfos.v create mode 100644 test-suite/output/Record.out create mode 100644 test-suite/output/Record.v create mode 100644 test-suite/output/inference.out create mode 100644 test-suite/output/inference.v create mode 100644 test-suite/output/rewrite-2172.out create mode 100644 test-suite/output/rewrite-2172.v create mode 100644 test-suite/success/PCase.v create mode 100644 test-suite/success/PrintSortedUniverses.v create mode 100644 test-suite/success/Scheme.v create mode 100644 test-suite/success/auto.v create mode 100644 test-suite/success/autorewrite.v delete mode 100644 test-suite/success/autorewritein.v create mode 100644 test-suite/success/bullet.v create mode 100644 test-suite/success/eta.v create mode 100644 test-suite/success/proof_using.v create mode 100644 test-suite/success/remember.v create mode 100644 test-suite/success/searchabout.v create mode 100644 test-suite/success/simpl_tuning.v create mode 100644 test-suite/success/telescope_canonical.v create mode 100644 test-suite/success/universes-coercion.v delete mode 100644 theories/Arith/MinMax.v delete mode 100644 theories/Arith/NatOrderedType.v delete mode 100644 theories/Lists/TheoryList.v create mode 100644 theories/Logic/ExtensionalityFacts.v create mode 100644 theories/NArith/BinNatDef.v delete mode 100644 theories/NArith/BinPos.v delete mode 100644 theories/NArith/NOrderedType.v create mode 100644 theories/NArith/Ndiv_def.v create mode 100644 theories/NArith/Ngcd_def.v delete mode 100644 theories/NArith/Nminmax.v create mode 100644 theories/NArith/Nsqrt_def.v delete mode 100644 theories/NArith/POrderedType.v delete mode 100644 theories/NArith/Pminmax.v delete mode 100644 theories/NArith/Pnat.v create mode 100644 theories/Numbers/BinNums.v create mode 100644 theories/Numbers/Integer/Abstract/ZBits.v create mode 100644 theories/Numbers/Integer/Abstract/ZGcd.v create mode 100644 theories/Numbers/Integer/Abstract/ZLcm.v create mode 100644 theories/Numbers/Integer/Abstract/ZMaxMin.v create mode 100644 theories/Numbers/Integer/Abstract/ZParity.v create mode 100644 theories/Numbers/Integer/Abstract/ZPow.v create mode 100644 theories/Numbers/NatInt/NZBits.v create mode 100644 theories/Numbers/NatInt/NZGcd.v create mode 100644 theories/Numbers/NatInt/NZLog.v create mode 100644 theories/Numbers/NatInt/NZParity.v create mode 100644 theories/Numbers/NatInt/NZPow.v create mode 100644 theories/Numbers/NatInt/NZSqrt.v create mode 100644 theories/Numbers/Natural/Abstract/NBits.v create mode 100644 theories/Numbers/Natural/Abstract/NGcd.v create mode 100644 theories/Numbers/Natural/Abstract/NLcm.v create mode 100644 theories/Numbers/Natural/Abstract/NLog.v create mode 100644 theories/Numbers/Natural/Abstract/NMaxMin.v create mode 100644 theories/Numbers/Natural/Abstract/NParity.v create mode 100644 theories/Numbers/Natural/Abstract/NPow.v create mode 100644 theories/Numbers/Natural/Abstract/NSqrt.v create mode 100644 theories/PArith/BinPos.v create mode 100644 theories/PArith/BinPosDef.v create mode 100644 theories/PArith/PArith.v create mode 100644 theories/PArith/POrderedType.v create mode 100644 theories/PArith/Pnat.v create mode 100644 theories/PArith/intro.tex create mode 100644 theories/PArith/vo.itarget create mode 100644 theories/Vectors/Fin.v create mode 100644 theories/Vectors/Vector.v create mode 100644 theories/Vectors/VectorDef.v create mode 100644 theories/Vectors/VectorSpec.v create mode 100644 theories/Vectors/vo.itarget create mode 100644 theories/ZArith/BinIntDef.v delete mode 100644 theories/ZArith/ZOdiv.v delete mode 100644 theories/ZArith/ZOdiv_def.v delete mode 100644 theories/ZArith/ZOrderedType.v create mode 100644 theories/ZArith/Zeuclid.v create mode 100644 theories/ZArith/Zpow_alt.v create mode 100644 theories/ZArith/Zquot.v delete mode 100644 theories/ZArith/Zsqrt.v create mode 100644 theories/ZArith/Zsqrt_compat.v mode change 100644 => 100755 tools/beautify-archive create mode 100644 tools/compat5.ml create mode 100644 tools/compat5.mlp create mode 100644 tools/compat5b.ml create mode 100644 tools/compat5b.mlp create mode 100644 tools/coq_makefile.ml delete mode 100644 tools/coq_makefile.ml4 create mode 100644 tools/coqdep_common.mli create mode 100644 tools/coqdep_lexer.mli create mode 100644 tools/fake_ide.ml create mode 100644 toplevel/ide_intf.ml create mode 100644 toplevel/ide_intf.mli create mode 100644 toplevel/ide_slave.ml create mode 100644 toplevel/ide_slave.mli create mode 100644 toplevel/interface.mli diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 00000000..1de1655d --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,8 @@ +((nil . ((eval . (setq default-directory (locate-dominating-file + buffer-file-name + ".dir-locals.el") + tags-file-name (concat default-directory + "TAGS") + camldebug-command-name (concat + default-directory "dev/ocamldebug-coq") +))))) \ No newline at end of file diff --git a/.gitignore b/.gitignore index 031b06b5..7fcd2580 100644 --- a/.gitignore +++ b/.gitignore @@ -29,49 +29,35 @@ *.htoc *.ind *.lof -*.stamp *.tacidx *.tacind *.v.tex *.v.pdf *.v.ps *.v.html +*.stamp revision TAGS +.DS_Store +.pc bin/ +_build +plugins/*/*_mod.ml +myocamlbuild_config.ml config/Makefile config/coq_config.ml -plugins/dp/dp_zenon.ml dev/ocamldebug-coq -dev/ocamlweb-doc/lex.ml -dev/ocamlweb-doc/syntax.ml -dev/ocamlweb-doc/syntax.mli -ide/config_lexer.ml -ide/config_parser.ml -ide/config_parser.mli -ide/coq_lex.ml -ide/extract_index.ml -ide/find_phrase.ml -ide/highlight.ml -ide/undo.mli -ide/utf8_convert.ml -kernel/byterun/coq_jumptbl.h +plugins/micromega/csdpcert kernel/byterun/dllcoqrun.so -kernel/copcodes.ml -scripts/tolink.ml states/initial.coq +coqdoc.sty test-suite/lia.cache test-suite/trace -theories/Numbers/Natural/BigN/NMake_gen.v -tools/coqdep_lexer.ml -tools/coqdoc/cpretty.ml -tools/coqwc.ml -tools/gallina_lexer.ml -toplevel/mltop.optml -plugins/micromega/csdpcert -toplevel/mltop.byteml -coqdoc.sty -ide/index_urls.txt +test-suite/misc/universes/all_stdlib.v +test-suite/misc/universes/universes.txt + +# documentation + doc/faq/html/ doc/refman/csdp.cache doc/refman/trace @@ -100,8 +86,96 @@ doc/RecTutorial/RecTutorial.html doc/RecTutorial/RecTutorial.pdf doc/RecTutorial/RecTutorial.ps dev/doc/naming-conventions.pdf -_build -plugins/*/*_mod.ml -myocamlbuild_config.ml -.DS_Store -.pc + +# .mll files + +dev/ocamlweb-doc/lex.ml +ide/coq_lex.ml +ide/config_lexer.ml +ide/utf8_convert.ml +ide/highlight.ml +plugins/dp/dp_zenon.ml +tools/gallina_lexer.ml +tools/coqwc.ml +tools/coqdep_lexer.ml +tools/coqdoc/cpretty.ml +lib/xml_lexer.ml + +# .mly files + +ide/config_parser.ml +ide/config_parser.mli + +# .ml4 files + +ide/project_file.ml +lib/pp.ml +lib/compat.ml +parsing/g_xml.ml +parsing/g_prim.ml +parsing/q_util.ml +parsing/tacextend.ml +parsing/q_constr.ml +parsing/g_vernac.ml +parsing/pcoq.ml +parsing/g_constr.ml +parsing/g_ltac.ml +parsing/vernacextend.ml +parsing/g_tactic.ml +parsing/argextend.ml +parsing/g_decl_mode.ml +parsing/q_coqast.ml +parsing/g_proofs.ml +parsing/lexer.ml +plugins/xml/proofTree2Xml.ml +plugins/xml/acic2Xml.ml +plugins/xml/xml.ml +plugins/xml/dumptree.ml +plugins/xml/xmlentries.ml +plugins/extraction/g_extraction.ml +plugins/rtauto/g_rtauto.ml +plugins/romega/g_romega.ml +plugins/setoid_ring/newring.ml +plugins/firstorder/g_ground.ml +plugins/dp/g_dp.ml +plugins/cc/g_congruence.ml +plugins/ring/g_ring.ml +plugins/field/field.ml +plugins/funind/g_indfun.ml +plugins/omega/g_omega.ml +plugins/quote/g_quote.ml +plugins/nsatz/nsatz.ml +plugins/micromega/g_micromega.ml +plugins/subtac/g_subtac.ml +plugins/fourier/g_fourier.ml +plugins/decl_mode/g_decl_mode.ml +tactics/tauto.ml +tactics/eauto.ml +tactics/hipattern.ml +tactics/class_tactics.ml +tactics/rewrite.ml +tactics/eqdecide.ml +tactics/extratactics.ml +tactics/extraargs.ml +tools/coq_tex.ml +toplevel/mltop.ml +toplevel/whelp.ml +ide/coqide_main.ml +ide/coqide_main_opt.ml + +# other auto-generated files + +ide/undo.mli +toplevel/mltop.optml +toplevel/mltop.byteml +kernel/byterun/coq_jumptbl.h +kernel/copcodes.ml +scripts/tolink.ml +theories/Numbers/Natural/BigN/NMake_gen.v +ide/index_urls.txt + +# mlis documentation + +dev/ocamldoc/html/ +dev/ocamldoc/coq.* +dev/ocamldoc/ocamldoc.sty diff --git a/CHANGES b/CHANGES index b8a5f9ea..74aefe49 100644 --- a/CHANGES +++ b/CHANGES @@ -1,134 +1,237 @@ -Changes from V8.3pl2 to V8.3pl3 -=============================== - -General - -- #2411 (Axiom / Hypothesis / Variable allowed again during proofs) -- #2603 (verify that all names of an inductive block aren't already used) +Changes from V8.3 to V8.4 +========================= -Modules +Logic -- #2608 (better handling of inlining and aliases, avoiding a Not_found) -- #2168 (Print Assumption now support opaque modules) -- #2609 (avoid adding twice a module in the environment in coqchk) +- Standard eta-conversion now supported (dependent product only). (DOC TO DO) +- Guard condition improvement: subterm property is propagated through beta-redex + blocked by pattern-matching, as in "(match v with C .. => fun x => u end) x"; + this allows for instance to use "rewrite ... in ..." without breaking + the guard condition. + +Specification language and notations + +- Maximal implicit arguments can now be set locally by { }. The registration + traverses fixpoints and lambdas. Because there is conversion in types, + maximal implicit arguments are not taken into account in partial + applications (use eta expanded form with explicit { } instead). +- Added support for recursive notations with binders (allows for instance + to write "exists x y z, P"). +- Structure/Record printing can be disable by "Unset Printing Records". + In addition, it can be controlled on type by type basis using + "Add Printing Record" or "Add Printing Constructor". +- In a pattern containing a "match", a final "| _ => _" branch could be used + now instead of enumerating all remaining constructors. Moreover, the pattern + "match _ with _ => _ end" now allows to match any "match". A "in" annotation + can also be added to restrict to a precise inductive type. +- Pattern-matching compilation algorithm: in "match x, y with ... end", + possible dependencies of x (or of the indices of its type) in the type + of y are now taken into account. Tactics -- #2467, #2464 (fixes for fsetdec) -- Document the "appcontext" variant of "context" that better handles - partial applications. - -Coqide - -- #2363 (fix the command separator for external commands) -- #2499 (fix remove_current_view_page) -- #2357 (allow the use of Abort) +- New proof engine. +- Scripts can now be structured thanks to bullets - * + and to subgoal + delimitation via { }. Note: for use with ProofGeneral, a cvs version of + ProofGeneral no older than mid-July 2011 is currently required. DOC TODO. +- Support for tactical "info" is suspended. +- Support for command "Show Script" is suspended. +- New tactics constr_eq, is_evar and has_evar. +- Removed the two-argument variant of "decide equality". +- New experimental tactical "timeout ". Since is a time + in second for the moment, this feature should rather be avoided + in scripts meant to be machine-independent. +- Fix in "destruct": removal of unexpected local definitions in context might + result in some rare incompatibilities (solvable by adapting name hypotheses). +- Introduction pattern "_" made more robust. +- Tactic (and Eval command) vm_compute can now be interrupted via Ctrl-C. +- Unification in "apply" supports unification of patterns of the form + ?f x y = g(x,y) (compatibility ensured by using + "Unset Tactic Pattern Unification"). It also supports (full) betaiota. +- Tactic autorewrite does no longer instantiate pre-existing + existential variables (theoretical source of possible incompatibility). +- Tactic "dependent rewrite" now supports equality in "sig". +- Tactic omega now understands Zpred (wish #1912) and can prove any goal + from a context containing an arithmetical contradiction (wish #2236). +- Using "auto with nocore" disables the use of the "core" database (wish #2188). + This pseudo-database "nocore" can also be used with trivial and eauto. +- Tactics "set", "destruct" and "induction" accepts incomplete terms and + use the goal to complete the pattern assuming it is no ambiguous. +- When used on arguments with a dependent type, tactics such as + "destruct", "induction", "case", "elim", etc. now try to abstract + automatically the dependencies over the arguments of the types + (based on initial ideas from Chung-Kil Hur, extension to nested + dependencies suggested by Dan Grayson) +- Tactic "injection" now failing on an equality showing no constructors while + it was formerly generalizing again the goal over the given equality. +- In Ltac, the "context [...]" syntax has now a variant "appcontext [...]" + allowing to match partial applications in larger applications. +- When applying destruct or inversion on a fixpoint hiding an inductive + type, recursive calls to the fixpoint now remain folded by default (rare + source of incompatibility generally solvable by adding a call to simpl). -Extraction - -- #2540 (global references should be indexed on their user parts) -- #2556 (support of records with anonymous fields) -- #2565 (typo in the documentation) -- #2570 (avoid internal eta-reduction) -- #2552 (For Haskell, type signature for __ and unsafeCoerce) -- For Haskell, avoid some sources of useless unsafeCoerce -- Forbid Prop-universe-polymorphism of inductive when extracting - to ocaml, otherwise things may fail badly (report by S. Glondu). - -Changes from V8.3pl1 to V8.3pl2 -=============================== - -Coqdoc and documentation bugs +Vernacular commands -- #2470 (use "membership" instead of "appartness") -- #2475 (documentation of the "f binders := t" notation for record fields) -- Documentation of module String on coq.inria.fr/stdlib +- It is now mandatory to have a space (or tabulation or newline or end-of-file) + after a "." ending a sentence. +- In SearchAbout, the [ ] delimiters are now optional. +- New command "Add/Remove Search Blacklist ..." : + a Search or SearchAbout or similar query will never mention lemmas + whose qualified names contain any of the declared substrings. + The default blacklisted substrings are "_admitted" "_subproof" "Private_". DOC TODO +- When the output file of "Print Universes" ends in ".dot" or ".gv", + the universe graph is printed in the DOT language, and can be + processed by Graphviz tools. +- New command "Print Sorted Universes". +- The undocumented and obsolete option "Set/Unset Boxed Definitions" has + been removed, as well as syntaxes like "Boxed Fixpoint foo". +- A new option "Set Default Timeout n / Unset Default Timeout". +- Qed now uses information from the reduction tactics used in proof script + to avoid conversion at Qed time to go into a very long computation. +- New command "Show Goal ident" to display the statement of a goal, even + a closed one (available from Proof General). + +Module System + +- During subtyping checks, an opaque constant in a module type could now + be implemented by anything of the right type, even if bodies differ. + Said otherwise, with respect to subtyping, an opaque constant behaves + just as a parameter. Coqchk was already implementing this, but not coqtop. +- The inlining done during application of functors can now be controlled + more precisely, by the annotations (no inline) or (inline at level XX). + With the latter annotation, only functor parameters whose levels + are lower or equal than XX will be inlined. + The level of a parameter can be fixed by "Parameter Inline(30) foo". + When levels aren't given, the default value is 100. One can also use + the flag "Set Inline Level ..." to set a level. TODO: DOC! +- Print Assumptions should now handle correctly opaque modules (#2168) +- Print Module (Type) now tries to print more details, such as types and + bodies of the module elements. Note that Print Module Type could be + used on a module to display only its interface. The option + "Set Short Module Printing" could be used to switch back to the earlier + behavior were only field names were displayed. -Tactics +Libraries -- #2493 (dependent pairs injection failing because of Type cumulativity missing) -- Reduction "simpl" sometimes failing in presence of names redefined in modules +- Extension of the abstract part of Numbers, which now provide axiomatizations + and results about many more integer functions, such as pow, gcd, lcm, sqrt, log2 + and bitwise functions. These functions are implemented for nat N BigN Z BigZ. + See in particular file NPeano for new functions about nat. +- The definition of types positive, N, Z is now in file BinNums.v +- Major reorganization of ZArith. The initial file ZArith/BinInt.v now contains + an internal module Z implementing the Numbers interface for integers. + This module Z regroups: + * all functions over type Z : Z.add, Z.mul, ... + * the minimal proofs of specifications for these functions : Z.add_0_l, ... + * an instantation of all derived properties proved generically in Numbers : + Z.add_comm, Z.add_assoc, ... + A large part of ZArith is now simply compatibility notations, for instance + Zplus_comm is an alias for Z.add_comm. The direct use of module Z is now + recommended instead of relying on these compatibility notations. +- Similar major reorganization of NArith, via a module N in NArith/BinNat.v +- Concerning the positive datatype, BinPos.v is now in a specific directory + PArith, and contains an internal submodule Pos. We regroup there functions + such as Pos.add Pos.mul etc as well as many results about them. These results + are here proved directly (no Number interface for strictly positive numbers). +- Note that in spite of the compatibility layers, all these reorganizations + may induce some marginal incompatibilies in scripts. In particular: + * the "?=" notation for positive now refers to a binary function Pos.compare, + instead of the infamous ternary Pcompare (now Pos.compare_cont). + * some hypothesis names generated by the system may changed (typically for + a "destruct Z_le_gt_dec") since naming is done after the short name of + the head predicate (here now "le" in module Z instead of "Zle", etc). + * the internals of Z.add has changed, now relying of Z.pos_sub. +- Also note these new notations: + * "= 3.09.3 restored +- Opaque proofs are now loaded lazily by default. This allows to be almost as + fast as -dont-load-proofs, while being safer (no creation of axioms) and + avoiding feature restrictions (Print and Print Assumptions work ok). +- Revised hash-consing code allowing more sharing of memory +- Experimental support added for camlp4 (the one provided alongside ocaml), + simply pass option -usecamlp4 to ./configure. By default camlp5 is used. +- Revised build system: no more stages in Makefile thanks to some recursive + aspect of recent gnu make, use of vo.itarget files containing .v to compile + for both make and ocamlbuild, etc. +- Support of cross-compilation via mingw from unix toward Windows, + contact P. Letouzey for more informations. +- new Makefile rules mli-doc to make html of mli in dev/doc/html and + full-stdlib to get a HUGE pdf with all the stdlib. Extraction -- #2413 (prevent type-unsafe optimisations of pattern matching) -- Identifiers of a development aimed to be extracted should - avoid containing "__", since the extraction make various use of - this sub-string, leading to potential name clashes. This was - already so in V8.3, but not announced, as mentionned by #2421. - -Miscellaneous bug fixes +- By default, opaque terms are now truly considered opaque by extraction: + instead of accessing their body, they are now considered as axioms. + The previous behaviour can be reactivated via the option + "Set Extraction AccessOpaque". +- The pretty-printer for Haskell now produces layout-independant code +- A new command "Separate Extraction cst1 cst2 ..." that mixes a + minimal extracted environment a la "Recursive Extraction" and the + production of several files (one per coq source) a la "Extraction Library". + DOC TODO. +- New option "Set/Unset Extraction KeepSingleton" for preventing the + extraction to optimize singleton container types. DOC TODO +- The extraction now identifies and properly rejects a particular case of + universe polymorphism it cannot handle yet (the pair (I,I) being Prop). +- Support of anonymous fields in record (#2555). -- #2412 (anomaly Ploc.Exc when using Ltac Debug) -- #2419 (redundant opp_compare removed) -- #2427 (Module Functor claims Signature does not match) -- #2431 (compliance of CoqIDE use of mutexes with FreeBSD) -- #2434 (anomaly DuringSyntaxChecking with Local/Global prefixes) -- a few improvements in efficiency +CoqIDE +- Coqide now runs coqtop as separated process, making it more robust: + coqtop subprocess can be interrupted, or even killed and relaunched + (cf button "Restart Coq", ex-"Go to Start"). For allowing such + interrupts, the Windows version of coqide now requires Windows >= XP + SP1. +- The communication between CoqIDE and Coqtop is now done via a dialect + of XML (DOC TODO). +- The backtrack engine of CoqIDE has been reworked, it now used the + "Backtrack" command similarly to ProofGeneral. +- The Coqide parsing of sentences has be reworked and now supports + tactic delimitation via { }. +- Coqide now accepts the Abort command (wish #2357). +- Coqide can read coq_makefile files as "project file" and use it to + set automatically options to send to coqtop. +- Preference files have moved to $XDG_CONFIG_HOME/coq and accelerators + are not stored as a list anymore. -Extraction +Tools -- The pretty-printer for Haskell now produces layout-independant code +- Coq now searches directories specified in COQPATH, $XDG_DATA_HOME/coq, + $XDG_DATA_DIRS/coq, and user-contribs before the standard library. +- Coq rc file has moved to $XDG_CONFIG_HOME/coq. +- coq_makefile major cleanup. + * mli/mlpack/mllib taken into account, ml not preproccessed anymore, ml4 work + * mlihtml generates doc of mli, install-doc install the html doc in DOCDIR + with the same policy as vo in COQLIB + * More variables are given by coqtop -config, others are defined only if the + users doesn't have defined them elsewhere. Consequently, generated makefile + should work directly on any architecture. + * Packagers can take advantage of $(DSTROOT) introduction. Installation can + be made in $XDG_DATA_HOME/coq. + * -arg option allows to send option as argument to coqc. Changes from V8.2 to V8.3 ========================= @@ -159,7 +262,8 @@ Automation tactics - Tactic "intuition" now preserves inner "iff" and "not" (exceptional source of incompatibilities solvable by redefining "intuition" as - "unfold iff, not in *; intuition", or by using "Set Intuition Iff Unfolding".) + "unfold iff, not in *; intuition", or, for iff only, by using + "Set Intuition Iff Unfolding".) - Tactic "tauto" now proves classical tautologies as soon as classical logic (i.e. library Classical_Prop or Classical) is loaded. - Tactic "gappa" has been removed from the Dp plugin. @@ -169,7 +273,7 @@ Automation tactics hints (wish #2104). - An inductive type as argument of the "using" option of "auto/eauto/firstorder" is interpreted as using the collection of its constructors. -- New decision tactic "nsatz" to prove polynomial equations +- New decision tactic "nsatz" to prove polynomial equations by computation of Groebner bases. Other tactics @@ -181,9 +285,9 @@ Other tactics - Tactic "quote" now supports quotation of arbitrary terms (not just the goal). - Tactic "idtac" now displays its "list" arguments. -- New introduction patterns "*" for introducing the next block of dependent +- New introduction patterns "*" for introducing the next block of dependent variables and "**" for introducing all quantified variables and hypotheses. -- Pattern Unification for existential variables activated in tactics and +- Pattern Unification for existential variables activated in tactics and new option "Unset Tactic Evars Pattern Unification" to deactivate it. - Resolution of canonical structure is now part of the tactic's unification algorithm. @@ -282,7 +386,7 @@ Extraction is flattened, module abbreviations and functor applications are expanded, module types and unapplied functors are discarded. - Less unsupported situations when extracting modules to Ocaml. In particular - module parameters might be alpha-renamed if a name clash is detected. + module parameters might be alpha-renamed if a name clash is detected. - Extract Inductive is now possible toward non-inductive types (e.g. nat => int) - Extraction Implicit: this new experimental command allows to mark some arguments of a function or constructor for removed during @@ -300,11 +404,11 @@ Program that they can work on any subset of the arguments directly (uses currying). - Try to automatically clear structural fixpoint prototypes in obligations to avoid issues with opacity. -- Use return type clause inference in pattern-matching as in the standard +- Use return type clause inference in pattern-matching as in the standard typing algorithm. - Support [Local Obligation Tactic] and [Next Obligation with tactic]. - Use [Show Obligation Tactic] to print the current default tactic. -- [fst] and [snd] have maximal implicit arguments in Program now (possible +- [fst] and [snd] have maximal implicit arguments in Program now (possible source of incompatibility). Type classes @@ -315,7 +419,7 @@ Type classes - Use [Existing Class foo] to declare foo as a class a posteriori. [foo] can be an inductive type or a constant definition. No projections or instances are defined. -- Various bug fixes and improvements: support for defined fields, +- Various bug fixes and improvements: support for defined fields, anonymous instances, declarations giving terms, better handling of sections and [Context]. @@ -367,7 +471,7 @@ Library of incompatibilities solvable by qualifying names accordingly). - In ListSet, set_map has been fixed (source of incompatibilities if used). - Sorting library: - - new mergesort of worst-case complexity O(n*ln(n)) made available in + - new mergesort of worst-case complexity O(n*ln(n)) made available in Mergesort.v; - former notion of permutation up to setoid from Permutation.v is deprecated and moved to PermutSetoid.v; @@ -462,22 +566,22 @@ Changes from V8.1 to V8.2 Language -- If a fixpoint is not written with an explicit { struct ... }, then - all arguments are tried successively (from left to right) until one is +- If a fixpoint is not written with an explicit { struct ... }, then + all arguments are tried successively (from left to right) until one is found that satisfies the structural decreasing condition. -- New experimental typeclass system giving ad-hoc polymorphism and +- New experimental typeclass system giving ad-hoc polymorphism and overloading based on dependent records and implicit arguments. - New syntax "let 'pat := b in c" for let-binding using irrefutable patterns. -- New syntax "forall {A}, T" for specifying maximally inserted implicit +- New syntax "forall {A}, T" for specifying maximally inserted implicit arguments in terms. - Sort of Record/Structure, Inductive and CoInductive defaults to Type if omitted. -- (Co)Inductive types can be defined as records +- (Co)Inductive types can be defined as records (e.g. "CoInductive stream := { hd : nat; tl : stream }.") - New syntax "Theorem id1:t1 ... with idn:tn" for proving mutually dependent statements. - Support for sort-polymorphism on constants denoting inductive types. -- Several evolutions of the module system (handling of module aliases, +- Several evolutions of the module system (handling of module aliases, functorial module types, an Include feature, etc). - Prop now a subtype of Set (predicative and impredicative forms). - Recursive inductive types in Prop with a single constructor of which @@ -495,18 +599,18 @@ Vernacular commands - Modification of the Scheme command so you can ask for the name to be automatically computed (e.g. Scheme Induction for nat Sort Set). - New command "Combined Scheme" to build combined mutual induction - principles from existing mutual induction principles. -- New command "Scheme Equality" to build a decidable (boolean) equality + principles from existing mutual induction principles. +- New command "Scheme Equality" to build a decidable (boolean) equality for simple inductive datatypes and a decision property over this equality (e.g. Scheme Equality for nat). -- Added option "Set Equality Scheme" to make automatic the declaration +- Added option "Set Equality Scheme" to make automatic the declaration of the boolean equality when possible. -- Source of universe inconsistencies now printed when option +- Source of universe inconsistencies now printed when option "Set Printing Universes" is activated. - New option "Set Printing Existential Instances" for making the display of existential variable instances explicit. -- Support for option "[id1 ... idn]", and "-[id1 ... idn]", for the - "compute"/"cbv" reduction strategy, respectively meaning reduce only, or +- Support for option "[id1 ... idn]", and "-[id1 ... idn]", for the + "compute"/"cbv" reduction strategy, respectively meaning reduce only, or everything but, the constants id1 ... idn. "lazy" alone or followed by "[id1 ... idn]", and "-[id1 ... idn]" also supported, meaning apply all of beta-iota-zeta-delta, possibly restricting delta. @@ -533,46 +637,46 @@ Libraries SetoidList, ListSet, Sorting, Zmisc. This may induce a few incompatibilities. In case of trouble while fixing existing development, it may help to simply declare Set as an alias for Type (see file - SetIsType). -- New arithmetical library in theories/Numbers. It contains: - * an abstract modular development of natural and integer arithmetics + SetIsType). +- New arithmetical library in theories/Numbers. It contains: + * an abstract modular development of natural and integer arithmetics in Numbers/Natural/Abstract and Numbers/Integer/Abstract - * an implementation of efficient computational bounded and unbounded + * an implementation of efficient computational bounded and unbounded integers that can be mapped to processor native arithmetics. - See Numbers/Cyclic/Int31 for 31-bit integers and Numbers/Natural/BigN + See Numbers/Cyclic/Int31 for 31-bit integers and Numbers/Natural/BigN for unbounded natural numbers and Numbers/Integer/BigZ for unbounded - integers. + integers. * some proofs that both older libraries Arith, ZArith and NArith and newer BigN and BigZ implement the abstract modular development. - This allows in particular BigN and BigZ to already come with a + This allows in particular BigN and BigZ to already come with a large database of basic lemmas and some generic tactics (ring), This library has still an experimental status, as well as the processor-acceleration mechanism, but both its abstract and its concrete parts are already quite usable and could challenge the use - of nat, N and Z in actual developments. Moreover, an extension of + of nat, N and Z in actual developments. Moreover, an extension of this framework to rational numbers is ongoing, and an efficient - Q structure is already provided (see Numbers/Rational/BigQ), but - this part is currently incomplete (no abstract layer and generic + Q structure is already provided (see Numbers/Rational/BigQ), but + this part is currently incomplete (no abstract layer and generic lemmas). - Many changes in FSets/FMaps. In practice, compatibility with earlier version should be fairly good, but some adaptations may be required. * Interfaces of unordered ("weak") and ordered sets have been factorized thanks to new features of Coq modules (in particular Include), see FSetInterface. Same for maps. Hints in these interfaces have been - reworked (they are now placed in a "set" database). + reworked (they are now placed in a "set" database). * To allow full subtyping between weak and ordered sets, a field "eq_dec" has been added to OrderedType. The old version of OrderedType - is now called MiniOrderedType and functor MOT_to_OT allow to + is now called MiniOrderedType and functor MOT_to_OT allow to convert to the new version. The interfaces and implementations of sets now contain also such a "eq_dec" field. * FSetDecide, contributed by Aaron Bohannon, contains a decision - procedure allowing to solve basic set-related goals (for instance, + procedure allowing to solve basic set-related goals (for instance, is a point in a particular set ?). See FSetProperties for examples. * Functors of properties have been improved, especially the ones about - maps, that now propose some induction principles. Some properties - of fold need less hypothesis. + maps, that now propose some induction principles. Some properties + of fold need less hypothesis. * More uniformity in implementations of sets and maps: they all use - implicit arguments, and no longer export unnecessary scopes (see + implicit arguments, and no longer export unnecessary scopes (see bug #1347) * Internal parts of the implementations based on AVL have evolved a lot. The main files FSetAVL and FMapAVL are now much more @@ -586,31 +690,31 @@ Libraries structural yet efficient. The appendix files also contains alternative versions of these few functions, much closer to the initial Ocaml code and written via the Function framework. -- Library IntMap, subsumed by FSets/FMaps, has been removed from +- Library IntMap, subsumed by FSets/FMaps, has been removed from Coq Standard Library and moved into a user contribution Cachan/IntMap -- Better computational behavior of some constants (eq_nat_dec and - le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare +- Better computational behavior of some constants (eq_nat_dec and + le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare transparent, ...) (exceptional source of incompatibilities). - Boolean operators moved from module Bool to module Datatypes (may need to rename qualified references in script and force notations || and && to be at levels 50 and 40 respectively). -- The constructors xI and xO of type positive now have postfix notations - "~1" and "~0", allowing to write numbers in binary form easily, for instance +- The constructors xI and xO of type positive now have postfix notations + "~1" and "~0", allowing to write numbers in binary form easily, for instance 6 is 1~1~0 and 4*p is p~0~0 (see BinPos.v). -- Improvements to NArith (Nminus, Nmin, Nmax), and to QArith (in particular +- Improvements to NArith (Nminus, Nmin, Nmax), and to QArith (in particular a better power function). -- Changes in ZArith: several additional lemmas (used in theories/Numbers), +- Changes in ZArith: several additional lemmas (used in theories/Numbers), especially in Zdiv, Znumtheory, Zpower. Moreover, many results in Zdiv have been generalized: the divisor may simply be non-null instead of strictly positive (see lemmas with name ending by "_full"). An alternative file ZOdiv proposes a different behavior (the one of Ocaml) when dividing by negative numbers. -- Changes in Arith: EqNat and Wf_nat now exported from Arith, some +- Changes in Arith: EqNat and Wf_nat now exported from Arith, some constructions on nat that were outside Arith are now in (e.g. iter_nat). -- In SetoidList, eqlistA now expresses that two lists have similar elements - at the same position, while the predicate previously called eqlistA - is now equivlistA (this one only states that the lists contain the same - elements, nothing more). +- In SetoidList, eqlistA now expresses that two lists have similar elements + at the same position, while the predicate previously called eqlistA + is now equivlistA (this one only states that the lists contain the same + elements, nothing more). - Changes in Reals: * Most statement in "sigT" (including the completeness axiom) are now in "sig" (in case of incompatibility, @@ -627,7 +731,7 @@ Libraries - Definition of pred and minus made compatible with the structural decreasing criterion for use in fixpoints. - Files Relations/Rstar.v and Relations/Newman.v moved out to the user - contribution repository (contribution CoC_History). New lemmas about + contribution repository (contribution CoC_History). New lemmas about transitive closure added and some bound variables renamed (exceptional risk of incompatibilities). - Syntax for binders in terms (e.g. for "exists") supports anonymous names. @@ -695,7 +799,7 @@ Tactics - New tactics "ediscriminate", "einjection", "esimplify_eq". - Tactics "discriminate", "injection", "simplify_eq" now support any term as argument. Clause "with" is also supported. -- Unfoldable references can be given by notation's string rather than by name +- Unfoldable references can be given by notation's string rather than by name in unfold. - The "with" arguments are now typed using informations from the current goal: allows support for coercions and more inference of implicit arguments. @@ -708,8 +812,8 @@ Tactics (possible source of parsing incompatibilities when destruct or induction is part of a let-in expression in Ltac; extra parentheses are then required). - New support for "as" clause in tactics "apply in" and "eapply in". -- Some new intro patterns: - * intro pattern "?A" genererates a fresh name based on A. +- Some new intro patterns: + * intro pattern "?A" genererates a fresh name based on A. Caveat about a slight loss of compatibility: Some intro patterns don't need space between them. In particular intros ?a?b used to be legal and equivalent to intros ? a ? b. Now it @@ -718,31 +822,31 @@ Tactics for right-associative constructs like /\ or exists. - Several syntax extensions concerning "rewrite": * "rewrite A,B,C" can be used to rewrite A, then B, then C. These rewrites - occur only on the first subgoal: in particular, side-conditions of the + occur only on the first subgoal: in particular, side-conditions of the "rewrite A" are not concerned by the "rewrite B,C". - * "rewrite A by tac" allows to apply tac on all side-conditions generated by + * "rewrite A by tac" allows to apply tac on all side-conditions generated by the "rewrite A". - * "rewrite A at n" allows to select occurrences to rewrite: rewrite only + * "rewrite A at n" allows to select occurrences to rewrite: rewrite only happen at the n-th exact occurrence of the first successful matching of - A in the goal. + A in the goal. * "rewrite 3 A" or "rewrite 3!A" is equivalent to "rewrite A,A,A". * "rewrite !A" means rewriting A as long as possible (and at least once). * "rewrite 3?A" means rewriting A at most three times. * "rewrite ?A" means rewriting A as long as possible (possibly never). - * many of the above extensions can be combined with each other. + * many of the above extensions can be combined with each other. - Introduction patterns better respect the structure of context in presence of - missing or extra names in nested disjunction-conjunction patterns [possible + missing or extra names in nested disjunction-conjunction patterns [possible source of rare incompatibilities]. - New syntax "rename a into b, c into d" for "rename a into b; rename c into d" - New tactics "dependent induction/destruction H [ generalizing id_1 .. id_n ]" - to do induction-inversion on instantiated inductive families à la BasicElim. -- Tactics "apply" and "apply in" now able to reason modulo unfolding of - constants (possible source of incompatibility in situations where apply + to do induction-inversion on instantiated inductive families à la BasicElim. +- Tactics "apply" and "apply in" now able to reason modulo unfolding of + constants (possible source of incompatibility in situations where apply may fail, e.g. as argument of a try or a repeat and in a ltac function); - versions that do not unfold are renamed into "simple apply" and + versions that do not unfold are renamed into "simple apply" and "simple apply in" (usable for compatibility or for automation). -- Tactics "apply" and "apply in" now able to traverse conjunctions and to - select the first matching lemma among the components of the conjunction; +- Tactics "apply" and "apply in" now able to traverse conjunctions and to + select the first matching lemma among the components of the conjunction; tactic "apply" also able to apply lemmas of conclusion an empty type. - Tactic "apply" now supports application of several lemmas in a row. - Tactics "set" and "pose" can set functions using notation "(f x1..xn := c)". @@ -752,69 +856,69 @@ Tactics - Tactic "generalize" now supports "at" options to specify occurrences and "as" options to name the quantified hypotheses. - New tactic "specialize H with a" or "specialize (H a)" allows to transform - in-place a universally-quantified hypothesis (H : forall x, T x) into its + in-place a universally-quantified hypothesis (H : forall x, T x) into its instantiated form (H : T a). Nota: "specialize" was in fact there in earlier versions of Coq, but was undocumented, and had a slightly different behavior. - New tactic "contradict H" can be used to solve any kind of goal as long as the user can provide afterwards a proof of the negation of the hypothesis H. If H is already a negation, say ~T, then a proof of T is asked. If the current goal is a negation, say ~U, then U is saved in H afterwards, - hence this new tactic "contradict" extends earlier tactic "swap", which is + hence this new tactic "contradict" extends earlier tactic "swap", which is now obsolete. -- Tactics f_equal is now done in ML instead of Ltac: it now works on any +- Tactics f_equal is now done in ML instead of Ltac: it now works on any equality of functions, regardless of the arity of the function. - New options "before id", "at top", "at bottom" for tactics "move"/"intro". -- Some more debug of reflexive omega (romega), and internal clarifications. +- Some more debug of reflexive omega (romega), and internal clarifications. Moreover, romega now has a variant "romega with *" that can be also used on non-Z goals (nat, N, positive) via a call to a translation tactic named zify (its purpose is to Z-ify your goal...). This zify may also be used - independantly of romega. -- Tactic "remember" now supports an "in" clause to remember only selected + independantly of romega. +- Tactic "remember" now supports an "in" clause to remember only selected occurrences of a term. - Tactic "pose proof" supports name overwriting in case of specialization of an hypothesis. -- Semi-decision tactic "jp" for first-order intuitionistic logic moved to user +- Semi-decision tactic "jp" for first-order intuitionistic logic moved to user contributions (subsumed by "firstorder"). Program - Moved useful tactics in theories/Program and documented them. -- Add Program.Basics which contains standard definitions for functional +- Add Program.Basics which contains standard definitions for functional programming (id, apply, flip...) - More robust obligation handling, dependent pattern-matching and well-founded definitions. - New syntax " dest term as pat in term " for destructing objects using - an irrefutable pattern while keeping equalities (use this instead of + an irrefutable pattern while keeping equalities (use this instead of "let" in Programs). -- Program CoFixpoint is accepted, Program Fixpoint uses the new way to infer +- Program CoFixpoint is accepted, Program Fixpoint uses the new way to infer which argument decreases structurally. -- Program Lemma, Axiom etc... now permit to have obligations in the statement +- Program Lemma, Axiom etc... now permit to have obligations in the statement iff they can be automatically solved by the default tactic. - Renamed "Obligations Tactic" command to "Obligation Tactic". - New command "Preterm [ of id ]" to see the actual term fed to Coq for debugging purposes. -- New option "Transparent Obligations" to control the declaration of - obligations as transparent or opaque. All obligations are now transparent +- New option "Transparent Obligations" to control the declaration of + obligations as transparent or opaque. All obligations are now transparent by default, otherwise the system declares them opaque if possible. -- Changed the notations "left" and "right" to "in_left" and "in_right" to hide - the proofs in standard disjunctions, to avoid breaking existing scripts when +- Changed the notations "left" and "right" to "in_left" and "in_right" to hide + the proofs in standard disjunctions, to avoid breaking existing scripts when importing Program. Also, put them in program_scope. Type Classes - New "Class", "Instance" and "Program Instance" commands to define - classes and instances documented in the reference manual. -- New binding construct " [ Class_1 param_1 .. param_n, Class_2 ... ] " - for binding type classes, usable everywhere. + classes and instances documented in the reference manual. +- New binding construct " [ Class_1 param_1 .. param_n, Class_2 ... ] " + for binding type classes, usable everywhere. - New command " Print Classes " and " Print Instances some_class " to - print tables for typeclasses. + print tables for typeclasses. - New default eauto hint database "typeclass_instances" used by the default - typeclass instance search tactic. -- New theories directory "theories/Classes" for standard typeclasses - declarations. Module Classes.RelationClasses is a typeclass port of - Relation_Definitions plus a generic development of algebra on + typeclass instance search tactic. +- New theories directory "theories/Classes" for standard typeclasses + declarations. Module Classes.RelationClasses is a typeclass port of + Relation_Definitions plus a generic development of algebra on n-ary heterogeneous predicates. - + Setoid rewriting - Complete (and still experimental) rewrite of the tactic @@ -826,19 +930,19 @@ Setoid rewriting - "-->", "++>" and "==>" are now right associative notations declared at level 55 in scope signature_scope. - Their introduction may break existing scripts that defined + Their introduction may break existing scripts that defined them as notations with different levels. - + - One needs to use [Typeclasses unfold [cst]] if [cst] is used as an abbreviation hiding products in types of morphisms, - e.g. if ones redefines [relation] and declares morphisms + e.g. if ones redefines [relation] and declares morphisms whose type mentions [relation]. - The [setoid_rewrite]'s semantics change when rewriting with a lemma: it can rewrite two different instantiations of the lemma at once. Use [setoid_rewrite H at 1] for (almost) the usual semantics. [setoid_rewrite] will also try to rewrite under binders now, and can - succeed on different terms than before. In particular, it will unify under + succeed on different terms than before. In particular, it will unify under let-bound variables. When called through [rewrite], the semantics are unchanged though. @@ -853,7 +957,7 @@ Setoid rewriting - Setoid_Theory is now an alias to Equivalence, scripts building objects of type Setoid_Theory need to unfold (or "red") the definitions - of Reflexive, Symmetric and Transitive in order to get the same goals + of Reflexive, Symmetric and Transitive in order to get the same goals as before. Scripts which introduced variables explicitely will not break. - The order of subgoals when doing [setoid_rewrite] with side-conditions @@ -861,7 +965,7 @@ Setoid rewriting - New standard library modules Classes.Morphisms declares standard morphisms on refl/sym/trans relations. - Classes.Morphisms_Prop declares morphisms on propositional + Classes.Morphisms_Prop declares morphisms on propositional connectives and Classes.Morphisms_Relations on generalized predicate connectives. Classes.Equivalence declares notations and tactics related to equivalences and Classes.SetoidTactics defines the @@ -873,30 +977,30 @@ Setoid rewriting and rewriting under binders. The tactic is also extensible entirely in Ltac. The documentation has been updated to cover these features. -- [setoid_rewrite] and [rewrite] now support the [at] modifier to select +- [setoid_rewrite] and [rewrite] now support the [at] modifier to select occurrences to rewrite, and both use the [setoid_rewrite] code, even when rewriting with leibniz equality if occurrences are specified. Extraction -- Improved behavior of the Caml extraction of modules: name clashes should - not happen anymore. +- Improved behavior of the Caml extraction of modules: name clashes should + not happen anymore. - The command Extract Inductive has now a syntax for infix notations. This - allows in particular to map Coq lists and pairs onto Caml ones: + allows in particular to map Coq lists and pairs onto Caml ones: Extract Inductive list => list [ "[]" "(::)" ]. Extract Inductive prod => "(*)" [ "(,)" ]. -- In pattern matchings, a default pattern "| _ -> ..." is now used whenever +- In pattern matchings, a default pattern "| _ -> ..." is now used whenever possible if several branches are identical. For instance, functions - corresponding to decidability of equalities are now linear instead of + corresponding to decidability of equalities are now linear instead of quadratic. - A new instruction Extraction Blacklist id1 .. idn allows to prevent filename conflits with existing code, for instance when extracting module List - to Ocaml. + to Ocaml. CoqIDE - CoqIDE font defaults to monospace so as indentation to be meaningful. -- CoqIDE supports nested goals and any other kind of declaration in the middle +- CoqIDE supports nested goals and any other kind of declaration in the middle of a proof. - Undoing non-tactic commands in CoqIDE works faster. - New CoqIDE menu for activating display of various implicit informations. @@ -910,8 +1014,8 @@ Tools - Extended -I coqtop/coqc option to specify a logical dir: "-I dir -as coqdir". - New coqtop/coqc option -exclude-dir to exclude subdirs for option -R. - The binary "parser" has been renamed to "coq-parser". -- Improved coqdoc and dump of globalization information to give more - meta-information on identifiers. All categories of Coq definitions are +- Improved coqdoc and dump of globalization information to give more + meta-information on identifiers. All categories of Coq definitions are supported, which makes typesetting trivial in the generated documentation. Support for hyperlinking and indexing developments in the tex output has been implemented as well. @@ -947,8 +1051,8 @@ Tactics field on R manage power (may lead to incompatibilities with V8.1gamma). - Tactic field_simplify now applicable in hypotheses. - New field_simplify_eq for simplifying field equations into ring equations. -- Tactics ring, ring_simplify, field, field_simplify and field_simplify_eq - all able to apply user-given equations to rewrite monoms on the fly +- Tactics ring, ring_simplify, field, field_simplify and field_simplify_eq + all able to apply user-given equations to rewrite monoms on the fly (see documentation). Libraries @@ -987,7 +1091,7 @@ Tactics - Support for argument lists of arbitrary length in Tactic Notation. - [rewrite ... in H] now fails if [H] is used either in an hypothesis or in the goal. -- The semantics of [rewrite ... in *] has been slightly modified (see doc). +- The semantics of [rewrite ... in *] has been slightly modified (see doc). - Support for "as" clause in tactic injection. - New forward-reasoning tactic "apply in". - Ltac fresh operator now builds names from a concatenation of its arguments. @@ -1012,7 +1116,7 @@ Logic Syntax - No more support for version 7 syntax and for translation to version 8 syntax. -- In fixpoints, the { struct ... } annotation is not mandatory any more when +- In fixpoints, the { struct ... } annotation is not mandatory any more when only one of the arguments has an inductive type - Added disjunctive patterns in match-with patterns - Support for primitive interpretation of string literals @@ -1037,7 +1141,7 @@ Ltac and tactic syntactic extensions - New semantics for "match t with": if a clause returns a tactic, it is now applied to the current goal. If it fails, the next clause or next matching subterm is tried (i.e. it behaves as "match - goal with" does). The keyword "lazymatch" can be used to delay the + goal with" does). The keyword "lazymatch" can be used to delay the evaluation of tactics occurring in matching clauses. - Hint base names can be parametric in auto and trivial. - Occurrence values can be parametric in unfold, pattern, etc. @@ -1054,14 +1158,14 @@ Tactics - New implementation (still experimental) of the ring tactic with a built-in notion of coefficients and a better usage of setoids. - New conversion tactic "vm_compute": evaluates the goal (or an hypothesis) - with a call-by-value strategy, using the compiled version of terms. -- When rewriting H where H is not directly a Coq equality, search first H for + with a call-by-value strategy, using the compiled version of terms. +- When rewriting H where H is not directly a Coq equality, search first H for a registered setoid equality before starting to reduce in H. This is unlikely - to break any script. Should this happen nonetheless, one can insert manually + to break any script. Should this happen nonetheless, one can insert manually some "unfold ... in H" before rewriting. - Fixed various bugs about (setoid) rewrite ... in ... (in particular #1101) -- "rewrite ... in" now accepts a clause as place where to rewrite instead of - juste a simple hypothesis name. For instance: +- "rewrite ... in" now accepts a clause as place where to rewrite instead of + juste a simple hypothesis name. For instance: rewrite H in H1,H2 |- * means rewrite H in H1; rewrite H in H2; rewrite H rewrite H in * |- will do try rewrite H in Hi for all hypothesis Hi <> H. - Added "dependent rewrite term" and "dependent rewrite term in hyp". @@ -1072,19 +1176,19 @@ Tactics (it used to be a reference). - Omega now handles arbitrary precision integers. - Several bug fixes in Reflexive Omega (romega). -- Idtac can now be left implicit in a [...|...] construct: for instance, +- Idtac can now be left implicit in a [...|...] construct: for instance, [ foo | | bar ] stands for [ foo | idtac | bar ]. - Fixed a "fold" bug (non critical but possible source of incompatibilities). -- Added classical_left and classical_right which transforms |- A \/ B into +- Added classical_left and classical_right which transforms |- A \/ B into ~B |- A and ~A |- B respectively. - Added command "Declare Implicit Tactic" to set up a default tactic to be used to solve unresolved subterms of term arguments of tactics. -- Better support for coercions to Sortclass in tactics expecting type +- Better support for coercions to Sortclass in tactics expecting type arguments. - Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses. - New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns. - New introduction pattern "?" for letting Coq choose a name. -- Introduction patterns now support side hypotheses (e.g. intros [|] on +- Introduction patterns now support side hypotheses (e.g. intros [|] on "(nat -> nat) -> nat" works). - New introduction patterns "->" and "<-" for immediate rewriting of introduced hypotheses. @@ -1105,20 +1209,20 @@ Tactics - Generalization of induction "induction x1...xn using scheme" where scheme is an induction principle with complex predicates (like the ones generated by function induction). -- Some small Ltac tactics has been added to the standard library +- Some small Ltac tactics has been added to the standard library (file Tactics.v): * f_equal : instead of using the different f_equalX lemmas - * case_eq : a "case" without loss of information. An equality + * case_eq : a "case" without loss of information. An equality stating the current situation is generated in every sub-cases. - * swap : for a negated goal ~B and a negated hypothesis H:~A, - swap H asks you to prove A from hypothesis B + * swap : for a negated goal ~B and a negated hypothesis H:~A, + swap H asks you to prove A from hypothesis B * revert : revert H is generalize H; clear H. Extraction - -- All type parts should now disappear instead of sometimes producing _ + +- All type parts should now disappear instead of sometimes producing _ (for instance in Map.empty). -- Haskell extraction: types of functions are now printed, better +- Haskell extraction: types of functions are now printed, better unsafeCoerce mechanism, both for hugs and ghc. - Scheme extraction improved, see http://www.pps.jussieu.fr/~letouzey/scheme. - Many bug fixes. @@ -1159,7 +1263,7 @@ Libraries digit 0; weaken premises in Z_lt_induction). - Restructuration of Eqdep_dec.v and Eqdep.v: more lemmas in Type. - Znumtheory now contains a gcd function that can compute within Coq. -- More lemmas stated on Type in Wf.v, removal of redundant Acc_iter and +- More lemmas stated on Type in Wf.v, removal of redundant Acc_iter and Acc_iter2. - Change of the internal names of lemmas in OmegaLemmas. - Acc in Wf.v and clos_refl_trans in Relation_Operators.v now rely on @@ -1171,17 +1275,17 @@ Libraries proof scripts, set it locally opaque for compatibility). - More on permutations of lists in List.v and Permutation.v. - List.v has been much expanded. -- New file SetoidList.v now contains results about lists seen with +- New file SetoidList.v now contains results about lists seen with respect to a setoid equality. -- Library NArith has been expanded, mostly with results coming from - Intmap (for instance a bitwise xor), plus also a bridge between N and +- Library NArith has been expanded, mostly with results coming from + Intmap (for instance a bitwise xor), plus also a bridge between N and Bitvector. -- Intmap has been reorganized. In particular its address type "addr" is - now N. User contributions known to use Intmap have been adapted - accordingly. If you're using this library please contact us. - A wrapper FMapIntMap now presents Intmap as a particular implementation - of FMaps. New developments are strongly encouraged to use either this - wrapper or any other implementations of FMap instead of using directly +- Intmap has been reorganized. In particular its address type "addr" is + now N. User contributions known to use Intmap have been adapted + accordingly. If you're using this library please contact us. + A wrapper FMapIntMap now presents Intmap as a particular implementation + of FMaps. New developments are strongly encouraged to use either this + wrapper or any other implementations of FMap instead of using directly this obsolete Intmap. Tools @@ -1212,7 +1316,7 @@ Vernacular commands New syntax -- Semantics change of the if-then-else construction in new syntax: +- Semantics change of the if-then-else construction in new syntax: "if c then t1 else t2" now stands for "match c with c1 _ ... _ => t1 | c2 _ ... _ => t2 end" with no dependency of t1 and t2 in the arguments of the constructors; @@ -1234,7 +1338,7 @@ Executables and tools - Added option -top to change the name of the toplevel module "Top" - Coqdoc updated to new syntax and now part of Coq sources -- XML exportation tool now exports the structure of vernacular files +- XML exportation tool now exports the structure of vernacular files (cf chapter 13 in the reference manual) User contributions @@ -1251,7 +1355,7 @@ Changes from V8.0beta old syntax to V8.0beta New concrete syntax - A completely new syntax for terms -- A more uniform syntax for tactics and the tactic language +- A more uniform syntax for tactics and the tactic language - A few syntactic changes for vernacular commands - A smart automatic translator translating V8.0 files in old syntax to files valid for V8.0 @@ -1271,7 +1375,7 @@ Syntax extensions Revision of the standard library -- Many lemmas and definitions names have been made more uniform mostly +- Many lemmas and definitions names have been made more uniform mostly in Arith, NArith, ZArith and Reals (e.g : "times" -> "Pmult", "times_sym" -> "Pmult_comm", "Zle_Zmult_pos_right" -> "Zmult_le_compat_r", "SUPERIEUR" -> "Gt", "ZERO" -> "Z0") @@ -1319,7 +1423,7 @@ Known problems of the automatic translation new scheme for syntactic extensions (see translator documentation) - Unsafe for annotation Cases when constructors coercions are used or when annotations are eta-reduced predicates - + Changes from V7.4 to V8.0beta old syntax ======================================== @@ -1387,7 +1491,7 @@ Grammar extensions Library - New file about the factorial function in Arith -- An additional elimination Acc_iter for Acc, simplier than Acc_rect. +- An additional elimination Acc_iter for Acc, simplier than Acc_rect. This new elimination principle is used for definition well_founded_induction. - New library NArith on binary natural numbers - R is now of type Set @@ -1399,7 +1503,7 @@ Library - Several lemmas moved from auxiliary.v and zarith_aux.v to fast_integer.v (theoretical source of incompatibilities) - Variables names of iff_trans changed (source of incompatibilities) - - ZArith lemmas named OMEGA something or fast_ something, and lemma new_var + - ZArith lemmas named OMEGA something or fast_ something, and lemma new_var are now out of ZArith (except OMEGA2) - Redundant ZArith lemmas have been renamed: for the following pairs, use the second name (Zle_Zmult_right2, Zle_mult_simpl), (OMEGA2, @@ -1454,10 +1558,10 @@ Tactics Extraction (See details in plugins/extraction/CHANGES) - The old commands: (Recursive) Extraction Module M. - are now: (Recursive) Extraction Library M. - To use these commands, M should come from a library M.v -- The other syntax Extraction & Recursive Extraction now accept - module names as arguments. + are now: (Recursive) Extraction Library M. + To use these commands, M should come from a library M.v +- The other syntax Extraction & Recursive Extraction now accept + module names as arguments. Bugs @@ -1483,7 +1587,7 @@ Incompatibilities cause "Apply/Rewrite with" to fail if using the first name of a pair of redundant lemmas (this is solved by renaming the variables bound by "with"; 3 incompatibilities in Coq user contribs) -- ML programs referring to constants from fast_integer.v must use +- ML programs referring to constants from fast_integer.v must use "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead Changes from V7.3.1 to V7.4 @@ -1498,14 +1602,14 @@ Symbolic notations - Declarations with only implicit arguments now handled (e.g. the argument of nil can be set implicit; use !nil to refer to nil without arguments) -- "Print Scope sc" and "Locate ntn" allows to know to what expression a +- "Print Scope sc" and "Locate ntn" allows to know to what expression a notation is bound - New defensive strategy for printing or not implicit arguments to ensure re-type-checkability of the printed term - In Grammar command, the only predefined non-terminal entries are ident, global, constr and pattern (e.g. nvar, numarg disappears); the only allowed grammar types are constr and pattern; ast and ast list are no - longer supported; some incompatibilities in Grammar: when a syntax is a + longer supported; some incompatibilities in Grammar: when a syntax is a initial segment of an other one, Grammar does not work, use Notation Library @@ -1583,7 +1687,7 @@ Tactics it can also recognize 'False' in the hypothesis and use it to solve the goal. - Coercions now handled in "with" bindings -- "Subst x" replaces all ocurrences of x by t in the goal and hypotheses +- "Subst x" replaces all ocurrences of x by t in the goal and hypotheses when an hypothesis x=t or x:=t or t=x exists - Fresh names for Assert and Pose now based on collision-avoiding Intro naming strategy (exceptional source of incompatibilities) @@ -1594,7 +1698,7 @@ Tactics Extraction (See details in plugins/extraction/CHANGES and README): - An experimental Scheme extraction is provided. -- Concerning Ocaml, extracted code is now ensured to always type-check, +- Concerning Ocaml, extracted code is now ensured to always type-check, thanks to automatic inserting of Obj.magic. - Experimental extraction of Coq new modules to Ocaml modules. @@ -1624,7 +1728,7 @@ Incompatibilities longer supported, use TACTIC EXTEND and VERNAC COMMAND EXTEND on the ML-side instead - Transparency of le_lt_dec and co (leads to some simplification in - proofs; in some cases, incompatibilites is solved by declaring locally + proofs; in some cases, incompatibilites is solved by declaring locally opaque the relevant constant) - Opaque Local do not now survive section closing (rename them into Remark/Lemma/... to get them still surviving the sections; this @@ -1663,7 +1767,7 @@ Bug fixes Misc - Ocaml version >= 3.06 is needed to compile Coq from sources - - Simplification of fresh names creation strategy for Assert, Pose and + - Simplification of fresh names creation strategy for Assert, Pose and LetTac (PR#192) Changes from V7.2 to V7.3 @@ -1693,7 +1797,7 @@ Tactics - Intuition does no longer unfold constants except "<->" and "~". It can be parameterized by a tactic. It also can introduce dependent product if needed (source of incompatibilities) -- "Match Context" now matching more recent hypotheses first and failing only +- "Match Context" now matching more recent hypotheses first and failing only on user errors and Fail tactic (possible source of incompatibilities) - Tactic Definition's without arguments now allowed in Coq states - Better simplification and discrimination made by Inversion (source @@ -1709,7 +1813,7 @@ Bugs Extraction (details in plugins/extraction/CHANGES or documentation) - Signatures of extracted terms are now mostly expunged from dummy arguments. -- Haskell extraction is now operational (tested & debugged). +- Haskell extraction is now operational (tested & debugged). Standard library @@ -1721,8 +1825,8 @@ Standard library Tools -- new option -dump-glob to coqtop to dump globalizations (to be used by the - new documentation tool coqdoc; see http://www.lri.fr/~filliatr/coqdoc) +- new option -dump-glob to coqtop to dump globalizations (to be used by the + new documentation tool coqdoc; see http://www.lri.fr/~filliatr/coqdoc) User Contributions @@ -1731,7 +1835,7 @@ User Contributions - MapleMode (an interface to embed Maple simplification procedures over rational fractions in Coq) [David Delahaye, Micaela Mayero, Chalmers University] -- Presburger: A formalization of Presburger's algorithm +- Presburger: A formalization of Presburger's algorithm [Laurent Thery, INRIA Sophia Antipolis] - Chinese has been rewritten using Z from ZArith as datatype ZChinese is the new version, Chinese the obsolete one @@ -1767,7 +1871,7 @@ Language let-in style) - Coercions allowed in Cases patterns - New declaration "Canonical Structure id = t : I" to help resolution of - equations of the form (proj ?)=a; if proj(e)=a then a is canonically + equations of the form (proj ?)=a; if proj(e)=a then a is canonically equipped with the remaining fields in e, i.e. ? is instantiated by e Tactics @@ -1779,14 +1883,14 @@ Tactics Extraction (details in plugins/extraction/CHANGES or documentation) -- Syntax changes: there are no more options inside the extraction commands. - New commands for customization and options have been introduced instead. -- More optimizations on extracted code. -- Extraction tests are now embedded in 14 user contributions. +- Syntax changes: there are no more options inside the extraction commands. + New commands for customization and options have been introduced instead. +- More optimizations on extracted code. +- Extraction tests are now embedded in 14 user contributions. Standard library -- In [Relations], Rstar.v and Newman.v now axiom-free. +- In [Relations], Rstar.v and Newman.v now axiom-free. - In [Sets], Integers.v now based on nat - In [Arith], more lemmas in Min.v, new file Max.v, tail-recursive plus and mult added to Plus.v and Mult.v respectively @@ -1862,7 +1966,7 @@ Language: new "let-in" construction - New construction for local definitions (let-in) with syntax [x:=u]t (*)(+) -- Local definitions allowed in Record (a.k.a. record à la Randy Pollack) +- Local definitions allowed in Record (a.k.a. record à la Randy Pollack) Language: long names @@ -1948,7 +2052,7 @@ New tactics restrictions in the reference manual) - New tactic ROmega: an experimental alternative (based on reflexion) to Omega - [by P. Crégut] + [by P. Crégut] - New tactic language Ltac (see reference manual) (+) @@ -1991,7 +2095,7 @@ Changes in existing tactics an elimination schema, use "Elim using " (*)(+) -- Simpl no longer unfolds the recursive calls of a mutually defined +- Simpl no longer unfolds the recursive calls of a mutually defined fixpoint (*)(+) - Intro now fails if the hypothesis name already exists (*)(+) @@ -2041,7 +2145,7 @@ Concrete syntax of constructions Parsing and grammar extension ----------------------------- -- More constraints when writing ast +- More constraints when writing ast - "{...}" and the macros $LIST, $VAR, etc. now expect a metavariable (an identifier starting with $) (*) @@ -2097,7 +2201,7 @@ Changes in existing commands ---------------------------- - Generalization of the usage of qualified identifiers in tactics - and commands about globals, e.g. Decompose, Eval Delta; + and commands about globals, e.g. Decompose, Eval Delta; Hints Unfold, Transparent, Require - Require synchronous with Reset; Require's scope stops at Section ending (*) @@ -2157,7 +2261,7 @@ Extraction ---------- - New algorithm for extraction able to deal with "Type" (+) - (by J.-C. Filliâtre and P. Letouzey) + (by J.-C. Filliâtre and P. Letouzey) Standard library @@ -2184,7 +2288,7 @@ New user contributions - Basic notions of graph theory [GRAPHS-BASICS] (Jean Duprat, Lyon) -- A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, +- A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, Sophia-Antipolis) - Formalisation of CTL and TCTL temporal logic [CtlTctl] (Carlos @@ -2196,15 +2300,15 @@ New user contributions - P-automaton and the ABR algorithm [PAutomata] (Christine Paulin, Emmanuel Freund, Orsay) -- Semantics of a subset of the C language [MiniC] - (Eduardo Giménez, Emmanuel Ledinot, Suresnes) +- Semantics of a subset of the C language [MiniC] + (Eduardo Giménez, Emmanuel Ledinot, Suresnes) - Correctness proofs of the following imperative algorithms: - Bresenham line drawing algorithm [Bresenham], Marché's minimal edition - distance algorithm [Diff] (Jean-Christophe Filliâtre, Orsay) + Bresenham line drawing algorithm [Bresenham], Marché's minimal edition + distance algorithm [Diff] (Jean-Christophe Filliâtre, Orsay) - Correctness proofs of Buchberger's algorithm [Buchberger] and RSA - cryptographic algorithm [Rsa] (Laurent Théry, Sophia-Antipolis) + cryptographic algorithm [Rsa] (Laurent Théry, Sophia-Antipolis) - Correctness proof of Stalmarck tautology checker algorithm - [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) + [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) diff --git a/COMPATIBILITY b/COMPATIBILITY index 4cc8b589..0849b64f 100644 --- a/COMPATIBILITY +++ b/COMPATIBILITY @@ -1,52 +1,6 @@ -Potential sources of incompatibilities between Coq V8.2 and V8.3 +Potential sources of incompatibilities between Coq V8.3 and V8.4 ---------------------------------------------------------------- (see also file CHANGES) -The main incompatibilities between 8.2 and 8.3 are the following - -- When defining objects using tactics as in "Definition f binders : - type.", the binders are automatically introduced in the context. The - former behavior can be restored by using "Unset Automatic - Introduction" (for local modification) or "Global Unset Automatic - Introduction" (for inheritance through Require). - -- For setoid rewriting, Morphism has been renamed into Proper. - -In general, most sources of incompatibilities can be avoided by -calling coqtop or coqc with option "-compat 8.2". The sources of -incompatibilities listed below must however be treated manually. - -Syntax - -- The word "by" is now a keyword and can no longer be used as an identifier. - -Type inference - -- Many changes in using classes. - -Library - -- New identifiers of the library can hide identifiers. This can be - solved by changing the order of Require or by qualifying the - identifier with the name of its module. - -- Reorganisation of library (esp. FSets, Sorting, Numbers) may have - changed or removed names around. - -- Infix notation "++" has now to be set at level 60. [LinAlg] - -- When using the Programs library or any feature that uses it, - (lemmas about measure have a different form, ...). - -Tactics - -- The synchronization of introduction names and quantified hypotheses - names may exceptionally lead to different names in "induction" - (usually a name with lower index is required). - -- More checks in some commands (e.g. in Hint) may lead to forbid some - meaningless part of them. - -- When rewriting using setoid equality, the default equality found - might be different. +TO BE DONE diff --git a/COPYRIGHT b/COPYRIGHT index 4609c167..8d81d8c4 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -1,12 +1,12 @@ The Coq proof assistant -Copyright 1999-2011 The Coq development team, INRIA, CNRS, University +Copyright 1999-2010 The Coq development team, INRIA, CNRS, University Paris Sud, University Paris 7, Ecole Polytechnique. This product includes also software developed by Pierre Crégut, France Telecom R & D (plugins/omega and plugins/romega) Pierre Courtieu and Julien Forest, CNAM (plugins/funind) - Claudio Sacerdoti Coen, HELM, University of Bologna (plugins/xml) + Claudio Sacerdoti Coen, HELM, University of Bologna, (plugins/xml) Pierre Corbineau, Radbout University, Nijmegen (declarative mode) John Harrison, University of Cambridge (csdp wrapper) diff --git a/CREDITS b/CREDITS index d20fbce2..53bd9e93 100644 --- a/CREDITS +++ b/CREDITS @@ -16,7 +16,7 @@ All files of the "Coq proof assistant" in directories or sub-directories of scripts states tactics test-suite theories tools toplevel are distributed under the terms of the GNU Lesser General Public License -Version 2.1 (see file LICENSE). These files are COPYRIGHT 1999-2011, +Version 2.1 (see file LICENSE). These files are COPYRIGHT 1999-2010, The Coq development team, CNRS, INRIA and Université Paris Sud. Files from the directory doc are distributed as indicated in file doc/LICENCE. diff --git a/INSTALL b/INSTALL index b1cc3af1..e88dc319 100644 --- a/INSTALL +++ b/INSTALL @@ -15,8 +15,8 @@ WHAT DO YOU NEED ? ppc) and FreeBSD. Automated tests are run under many, many different architectures under GNU/Linux. - Naturally, Coq will run faster on an architecture where Objective Caml - can compile to native code, rather than only bytecode. At time of + Naturally, Coq will run faster on an architecture where OCaml can + compile to native code, rather than only bytecode. At time of writing, that is IA32, PowerPC, AMD64, Alpha, Sparc, Mips, IA64, HPPA and StrongArm. See http://caml.inria.fr/ocaml/portability.en.html for details. @@ -39,16 +39,12 @@ WHAT DO YOU NEED ? urpmi coq - Should you need or prefer to compile Coq V8.3 yourself, you need: + Should you need or prefer to compile Coq V8.2 yourself, you need: - - Objective Caml version 3.10.2 or later + - Objective Caml version 3.10.0 or later (available at http://caml.inria.fr/) - For Objective Caml version >= 3.10.0, you also need to install - camlp5 (use "transitional" mode and choose a version compatible - with the corresponding version of Objective Caml, however - avoiding version 5.00) - + - Camlp5 (version <= 4.08, or 5.* transitional) - GNU Make version 3.81 or later ( @@ -75,6 +71,9 @@ WHAT DO YOU NEED ? - for Coqide, the Lablgtk development files, and the GTK libraries, see INSTALL.ide for more details + By FTP, Coq comes as a single compressed tar-file. You have + probably already decompressed it if you are reading this document. + QUICK INSTALLATION PROCEDURE. ============================= @@ -88,7 +87,7 @@ QUICK INSTALLATION PROCEDURE. INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS). ================================================= -1- Check that you have the Objective Caml compiler version 3.10.2 (or later) +1- Check that you have the Objective Caml compiler version 3.10.0 (or later) installed on your computer and that "ocamlmktop" and "ocamlc" (or its native code version "ocamlc.opt") lie in a directory which is present in your $PATH environment variable. @@ -98,16 +97,23 @@ INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS). bigger), you will also need the "ocamlopt" (or its native code version "ocamlopt.opt") command. -2- If using Ocaml >= 3.10, check that you have Camlp5 installed on your - computer and that the command "camlp5" lies in a directory which +2- Check that you have Camlp4 installed on your + computer and that the command "camlp4" lies in a directory which is present in your $PATH environment variable path. - (You need Camlp5 in transitional mode and in both bytecode and - native versions if your platform supports it). + (You need Camlp4 in both bytecode and native versions if + your platform supports it). + + Note: in the latest ocaml distributions, camlp4 comes with ocaml so + you do not have to check this point anymore. -2- You will need about 400Mo free on your disk to compile Coq in full - with its standard library and documentation. +3- The uncompression and un-tarring of the distribution file gave birth + to a directory named "coq-8.xx". You can rename this directory and put + it wherever you want. Just keep in mind that you will need some spare + space during the compilation (reckon on about 50 Mb of disk space + for the whole system in native-code compilation). Once installed, the + binaries take about 14 Mb, and the library about 9 Mb. -3- First you need to configure the system. It is done automatically with +4- First you need to configure the system. It is done automatically with the command: ./configure @@ -201,7 +207,7 @@ INSTALLATION PROCEDURE FOR ADVANCED USERS. binaries will reside in the subdirectory bin/. If you want to compile the sources for debugging (i.e. with the option - -g of the ocaml compiler) then add the -debug option at configuration + -g of the Caml compiler) then add the -debug option at configuration step : ./configure -debug @@ -316,7 +322,7 @@ MOVING BINARIES OR LIBRARY. DYNAMICALLY LOADED LIBRARIES FOR BYTECODE EXECUTABLES. ====================================================== - Some bytecode executables of Coq use the ocaml runtime, which dynamically + Some bytecode executables of Coq use the OCaml runtime, which dynamically loads a shared library (.so or .dll). When it is not installed properly, you can get an error message of this kind: @@ -329,12 +335,12 @@ DYNAMICALLY LOADED LIBRARIES FOR BYTECODE EXECUTABLES. the command a limited number of times in a controlled environment (e.g. during compilation of binary packages); - install dllcoqrun.so in a location listed in the file ld.conf that is in - the directory of the standard library of Objective Caml; + the directory of the standard library of OCaml; - recompile your bytecode executables after reconfiguring the location of of the shared library: ./configure -coqrunbyteflags "-dllib -lcoqrun -dllpath " ... where is the directory where the dllcoqrun.so is installed; - - (not recommended) compile bytecode executables with a custom ocaml + - (not recommended) compile bytecode executables with a custom OCaml runtime by using: ./configure -custom ... be aware that stripping executables generated this way, or performing diff --git a/INSTALL.ide b/INSTALL.ide index e99002f0..300d17b1 100644 --- a/INSTALL.ide +++ b/INSTALL.ide @@ -23,7 +23,7 @@ On Gentoo GNU/Linux, do: Else, read the rest of this document to compile your own CoqIde. REQUIREMENT: - - OCaml >= 3.10.2 with native threads support. + - OCaml >= 3.11 with native threads support. - make world must succeed. - The graphical toolkit GTK+ 2.x. See http://www.gtk.org. The official supported version is at least 2.10.x. @@ -42,7 +42,7 @@ REQUIREMENT: - The OCaml bindings for GTK+ 2.x, lablgtk2. - You need at least version 2.10.0. + You need at least version 2.12.0. Your distribution may contain precompiled packages. For example, for Debian, run @@ -104,17 +104,14 @@ INSTALLATION NOTES -There are three configuration files located in your $(HOME) dir. +There are three configuration files located in your $(XDG_CONFIG_HOME)/coq dir. You may need to set HOME to some sensible value under Windows. -- .coqiderc is generated by coqide itself. It may be edited by hand or +- coqiderc is generated by coqide itself. It may be edited by hand or by using the Preference menu from coqide. It will be generated the first time you save your the preferences in Coqide. -- .coqide-gtk2rc is a standard Gtk2 configuration file. A sample file can be - found in the coq lib "ide" subdir. - -- .coqide.keys is a standard Gtk2 accelerator dump. You may edit this file +- coqide.keys is a standard Gtk2 accelerator dump. You may edit this file to change the default shortcuts for the menus. Read ide/FAQ for more informations. @@ -127,8 +124,8 @@ TROUBLESHOOTING Some users may experiment problems with unwanted automatic templates while using Coqide. This is due to a change in the modifiers keys available through GTK. The straightest way to get - rid of the problem is to edit by hand your .coqiderc (either - /home//.coqiderc under Linux, or - C:\Documents and Settings\\.coqiderc under Windows) + rid of the problem is to edit by hand your coqiderc (either + /home//.config/coq/coqiderc under Linux, or + C:\Documents and Settings\\.config\coq\coqiderc under Windows) and replace any occurence of MOD4 by MOD1. diff --git a/INSTALL.macosx b/INSTALL.macosx index 43390616..cc1317b1 100644 --- a/INSTALL.macosx +++ b/INSTALL.macosx @@ -1,30 +1,20 @@ -INSTALLATION PROCEDURE FOR THE PRECOMPILED VERSION OF COQ SYSTEM UNDER MACOS X ------------------------------------------------------------------------------- +INSTALLATION PROCEDURE FOR THE PRECOMPILED COQ V8.1 SYSTEM UNDER MACOS X +------------------------------------------------------------------------ -Here comes an bundle version of CoqIdE that you can save anywhere you want on -your disk. +You can also use fink, or the MacOS X package prepared by the Coq +team. To use the MacOS X package,: -Its main limitation is that double clicking and drap&drop on the application -icon of a .v file won't open the file ! You must use Menu/Ctrl-o to open a -file. (GTK-OSX handles it but lablgtk don't as far as I know.) +1) Download archive coq-8.1-macosx-ppc.dmg (for PowerPC-base computer) + or coq-8.1-macosx-i386.dmg (for Pentium-based computer). -An other limitation is that Sortcut aren't MacOS like ! (The question is again -how to make "" throw CaML.) +2) Double-click on its icon; it mounts a disk volume named "Coq V8.1". -Notice that "Compile" and "File"/"Export to" menu items should work (modulo -(pdf)latex finding). +3) Open volume "Coq 8.1" and double-click on coq-8.1.pkg to launch the + installer (you'll need administrator permissions). -if you want to use coqide from your terminal add - -alias coqide /YOUR_INSTALL_DIRECTORY/CoqIdEv8.3.app/Contents/MacOS/startcoqide +4) Coq installs in /usr/local/bin, which should be in your PATH, and + can be used from a Terminal window: the interactive toplevel is + named coqtop and the compiler is coqc. -at your ~/.profile. ("YOUR_INSTALL_DIRECTORY" is often "Applications"). Options -such as -I/-R should work on this setting. - -You could also add -/YOUR_INSTALL_DIRECTORY/CoqIdEv8.3.app/Contents/Resources/bin/ at your path to -use coqtop/coq-tex/coq... from any terminal but CAUTION coqide of that directory -won't work. - - -See up-to-date informations on http://coq.inria.fr/download. +If you have any trouble with this installation, please contact: +coq-bugs@pauillac.inria.fr. diff --git a/Makefile b/Makefile index 97afdfd6..876ac583 100644 --- a/Makefile +++ b/Makefile @@ -6,65 +6,38 @@ # # GNU Lesser General Public License Version 2.1 # ####################################################################### -# $Id: Makefile 14090 2011-05-03 13:34:16Z pboutill $ - # Makefile for Coq # -# To be used with GNU Make. +# To be used with GNU Make >= 3.81. # -# This is the only Makefile. You won't find Makefiles in sub-directories -# and this is done on purpose. If you are not yet convinced of the advantages -# of a single Makefile, please read +# This Makefile is now separated into Makefile.{common,build,doc}. +# You won't find Makefiles in sub-directories and this is done on purpose. +# If you are not yet convinced of the advantages of a single Makefile, please +# 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. -########################################################################### - - -# Specific command-line options to this Makefile # -# make GOTO_STAGE=N # perform only stage N (with N=1,2) +# Specific command-line options to this Makefile: +# # make VERBOSE=1 # restore the raw echoing of commands # make NO_RECALC_DEPS=1 # avoid recomputing dependencies # make NO_RECOMPILE_LIB=1 # a coqtop rebuild does not trigger a stdlib rebuild # # Nota: the 1 above can be replaced by any non-empty value -# More details in dev/doc/build-system*.txt +# +# ---------------------------------------------------------------------- +# See dev/doc/build-system*.txt for more details/FAQ about this Makefile +# ---------------------------------------------------------------------- -# FAQ: special features used in this Makefile -# -# * Order-only dependencies: | -# -# Dependencies placed after a bar (|) should be built before -# the current rule, but having one of them is out-of-date do not -# trigger a rebuild of the current rule. -# See http://www.gnu.org/software/make/manual/make.html#Prerequisite-Types -# -# * Annotation before commands: +/-/@ -# -# a command starting by - is always successful (errors are ignored) -# a command starting by + is runned even if option -n is given to make -# a command starting by @ is not echoed before being runned -# -# * Custom functions -# -# Definition via "define foo" followed by commands (arg is $(1) etc) -# Call via "$(call foo,arg1)" -# -# * Useful builtin functions -# -# $(subst ...), $(patsubst ...), $(shell ...), $(foreach ...) -# -# * Behavior of -include -# -# If the file given to -include doesn't exist, make tries to build it, -# but doesn't care if this build fails. This can be quite surprising, -# see in particular the -include in Makefile.stage* +########################################################################### +# File lists +########################################################################### # !! Before using FIND_VCS_CLAUSE, please read how you should in the !! # !! FIND_VCS_CLAUSE section of dev/doc/build-system.dev.txt !! @@ -78,41 +51,63 @@ export FIND_VCS_CLAUSE:='(' \ -name "$${GIT_DIR}" -o \ -name '_build' \ ')' -prune -o -export PRUNE_CHECKER := -wholename ./checker/\* -prune -o -FIND_PRINTF_P:=-print | sed 's|^\./||' +define find + $(shell find . $(FIND_VCS_CLAUSE) '(' -name $(1) ')' -print | sed 's|^\./||') +endef + +## Files in the source tree + +export YACCFILES:=$(call find, '*.mly') +export LEXFILES := $(call find, '*.mll') +export MLLIBFILES := $(call find, '*.mllib') +export ML4FILES := $(call find, '*.ml4') +export CFILES := $(call find, '*.c') + +# NB: The lists of currently existing .ml and .mli files will change +# before and after a build or a make clean. Hence we do not export +# these variables, but cleaned-up versions (see below MLFILES and co) + +EXISTINGML := $(call find, '*.ml') +EXISTINGMLI := $(call find, '*.mli') + +## Files that will be generated -export YACCFILES:=$(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.mly' ')' $(FIND_PRINTF_P)) -export LEXFILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.mll' ')' $(FIND_PRINTF_P)) export GENMLFILES:=$(LEXFILES:.mll=.ml) $(YACCFILES:.mly=.ml) \ scripts/tolink.ml kernel/copcodes.ml export GENMLIFILES:=$(YACCFILES:.mly=.mli) export GENHFILES:=kernel/byterun/coq_jumptbl.h export GENVFILES:=theories/Numbers/Natural/BigN/NMake_gen.v -export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) $(GENVFILES) -export MLFILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.ml' ')' $(FIND_PRINTF_P) | \ - while read f; do if ! [ -e "$${f}4" ]; then echo "$$f"; fi; done) \ - $(GENMLFILES) -export MLIFILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.mli' ')' $(FIND_PRINTF_P)) \ - $(GENMLIFILES) -export MLLIBFILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.mllib' ')' $(FIND_PRINTF_P)) -export ML4FILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.ml4' ')' $(FIND_PRINTF_P)) -#export VFILES := $(shell find . $(FIND_VCS_CLAUSE) '(' -name '*.v' ')' $(FIND_PRINTF_P)) \ -# $(GENVFILES) -export CFILES := $(shell find kernel/byterun $(FIND_VCS_CLAUSE) '(' -name '*.c' ')' -print) - -export ML4FILESML:= $(ML4FILES:.ml4=.ml) - -# Nota: do not use the name $(MAKEFLAGS), it has a particular behavior -MAKEFLGS:=--warn-undefined-variable --no-builtin-rules +export GENPLUGINSMOD:=$(filter plugins/%,$(MLLIBFILES:%.mllib=%_mod.ml)) +export GENML4FILES:= $(ML4FILES:.ml4=.ml) +export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES) $(GENVFILES) $(GENPLUGINSMOD) + +# NB: all files in $(GENFILES) can be created initially, while +# .ml files in $(GENML4FILES) might need some intermediate building. +# That's why we keep $(GENML4FILES) out of $(GENFILES) + +## More complex file lists + +define diff + $(strip $(foreach f, $(1), $(if $(filter $(f),$(2)),,$f))) +endef + +export MLSTATICFILES := \ + $(call diff, $(EXISTINGML), $(GENMLFILES) $(GENML4FILES) $(GENPLUGINSMOD)) +export MLFILES := \ + $(sort $(EXISTINGML) $(GENMLFILES) $(GENML4FILES) $(GENPLUGINSMOD)) +export MLIFILES := $(sort $(GENMLIFILES) $(EXISTINGMLI)) +export MLWITHOUTMLI := $(call diff, $(MLFILES), $(MLIFILES:.mli=.ml)) include Makefile.common -NOARG: world +########################################################################### +# Starting rules +########################################################################### -.PHONY: NOARG help always tags otags +NOARG: world -always: ; +.PHONY: NOARG help always help: @echo "Please use either" @@ -124,76 +119,44 @@ help: @echo @echo "For make to be verbose, add VERBOSE=1" -ifdef COQ_CONFIGURED -define stage-template - @echo '*****************************************************' - @echo '*****************************************************' - @echo '****************** Entering stage$(1) ******************' - @echo '*****************************************************' - @echo '*****************************************************' - +$(MAKE) $(MAKEFLGS) -f Makefile.stage$(1) "$@" -endef -else -define stage-template - @echo "Please run ./configure first" >&2; exit 1 -endef -endif - -UNSAVED_FILES:=$(shell find . -name '.\#*v' -o -name '.\#*.ml' -o -name '.\#*.mli' -o -name '.\#*.ml4') +UNSAVED_FILES:=$(shell find . -name '.\#*v' -o -name '.\#*.ml' -o -name '.\#*.ml?') ifdef UNSAVED_FILES -$(error You have unsaved changes in your editor (emacs?) [$(UNSAVED_FILES)]; cancel them or save before proceeding. \ -Or your editor crashed. Then, you may want to consider whether you want to restore the autosaves) +$(error You have unsaved changes in your editor (emacs?) [$(UNSAVED_FILES)]; \ +cancel them or save before proceeding. Or your editor crashed. \ +Then, you may want to consider whether you want to restore the autosaves) #If you try to simply remove this explicit test, the compilation may #fail later. In particular, if a .#*.v file exists, coqdep fails to #run. endif -ifdef GOTO_STAGE -config/Makefile Makefile.common Makefile.build Makefile: ; +# 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 -%: always - $(call stage-template,$(GOTO_STAGE)) +ifdef COQ_CONFIGURED +%:: always + $(MAKE) --warn-undefined-variable --no-builtin-rules -f Makefile.build "$@" else - -.PHONY: stage1 stage2 world revision - -stage1 $(STAGE1_TARGETS) : always - $(call stage-template,1) - -ifneq (,$(STAGE1_IMPLICITS)) -$(STAGE1_IMPLICITS) : always - $(call stage-template,1) -endif - -stage2 $(STAGE2_TARGETS) : stage1 - $(call stage-template,2) - -ifneq (,$(STAGE2_IMPLICITS)) -$(STAGE2_IMPLICITS) : stage1 - $(call stage-template,2) +%:: always + @echo "Please run ./configure first" >&2; exit 1 endif -# Nota: -# - world is one of the targets in $(STAGE2_TARGETS), hence launching -# "make" or "make world" leads to recursion into stage1 then stage2 -# - the aim of stage1 is to build grammar.cma and q_constr.cmo -# More details in dev/doc/build-system*.txt - +always : ; -# This is to remove the built-in rule "%: %.o" : -%: %.o -# Otherwise, "make foo" recurses into stage1, trying to build foo.o . +# To speed-up things a bit, let's dissuade make to attempt rebuilding makefiles -endif #GOTO_STAGE +Makefile Makefile.build Makefile.common config/Makefile : ; ########################################################################### # Cleaning ########################################################################### -.PHONY: clean objclean cruftclean indepclean archclean ml4clean clean-ide ml4depclean depclean distclean cleanconfig cleantheories docclean devdocclean +.PHONY: clean cleankeepvo objclean cruftclean indepclean doclean archclean optclean clean-ide ml4clean ml4depclean depclean cleanconfig distclean voclean devdocclean clean: objclean cruftclean depclean docclean devdocclean +cleankeepvo: indepclean clean-ide optclean cruftclean depclean docclean devdocclean + objclean: archclean indepclean cruftclean: ml4clean @@ -202,10 +165,8 @@ cruftclean: ml4clean indepclean: rm -f $(GENFILES) - rm -f $(COQTOPBYTE) $(COQMKTOPBYTE) $(COQCBYTE) $(CHICKENBYTE) + rm -f $(COQTOPBYTE) $(COQMKTOPBYTE) $(COQCBYTE) $(CHICKENBYTE) bin/fake_ide find . -name '*~' -o -name '*.cm[ioa]' | xargs rm -f - find . -name '*_mod.ml' | xargs rm -f - find plugins test-suite -name '*.vo' -o -name '*.glob' | xargs rm -f rm -f */*.pp[iox] plugins/*/*.pp[iox] rm -rf $(SOURCEDOCDIR) rm -f toplevel/mltop.byteml toplevel/mltop.optml @@ -221,33 +182,34 @@ docclean: doc/*/*.hatoc doc/*/*.haux doc/*/*.hcomind doc/*/*.herrind doc/*/*.hidx doc/*/*.hind \ doc/*/*.htacind doc/*/*.htoc doc/*/*.v.html rm -f doc/stdlib/index-list.html doc/stdlib/index-body.html \ - doc/stdlib/Library.coqdoc.tex doc/stdlib/library.files \ - doc/stdlib/library.files.ls - rm -f doc/*/*.ps doc/*/*.pdf + doc/stdlib/*Library.coqdoc.tex doc/stdlib/library.files \ + doc/stdlib/library.files.ls doc/stdlib/FullLibrary.tex + rm -f doc/*/*.ps doc/*/*.pdf rm -rf doc/refman/html doc/stdlib/html doc/faq/html doc/tutorial/tutorial.v.html rm -f doc/refman/euclid.ml doc/refman/euclid.mli rm -f doc/refman/heapsort.ml doc/refman/heapsort.mli rm -f doc/common/version.tex rm -f doc/refman/styles.hva doc/refman/cover.html doc/refman/Reference-Manual.html rm -f doc/coq.tex - rm -f doc/refman/styles.hva doc/refman/cover.html -archclean: clean-ide cleantheories +archclean: clean-ide optclean voclean + rm -rf _build myocamlbuild_config.ml + rm -f $(ALLSTDLIB).* + +optclean: rm -f $(COQTOPEXE) $(COQMKTOP) $(COQC) $(CHICKEN) $(COQDEPBOOT) rm -f $(COQTOPOPT) $(COQMKTOPOPT) $(COQCOPT) $(CHICKENOPT) - find . -name '*.cmx' -o -name '*.cmxs' -o -name '*.cmxa' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f rm -f $(TOOLS) $(CSDPCERT) - rm -rf _build myocamlbuild_config.ml + find . -name '*.cmx' -o -name '*.cmxs' -o -name '*.cmxa' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f clean-ide: rm -f $(COQIDECMO) $(COQIDECMX) $(COQIDECMO:.cmo=.cmi) $(COQIDEBYTE) $(COQIDEOPT) $(COQIDE) rm -f ide/input_method_lexer.ml - rm -f ide/extract_index.ml ide/find_phrase.ml ide/highlight.ml - rm -f ide/config_lexer.ml ide/config_parser.mli ide/config_parser.ml + rm -f ide/highlight.ml ide/config_lexer.ml ide/config_parser.mli ide/config_parser.ml rm -f ide/utf8_convert.ml ml4clean: - rm -f $(ML4FILESML) $(ML4FILESML:.ml=.ml4-preprocessed) + rm -f $(GENML4FILES) ml4depclean: find . -name '*.ml4.d' | xargs rm -f @@ -261,19 +223,24 @@ cleanconfig: distclean: clean cleanconfig $(MAKE) -C test-suite distclean -cleantheories: +voclean: rm -f states/*.coq - find theories -name '*.vo' -o -name '*.glob' | xargs rm -f + find theories plugins test-suite -name '*.vo' -o -name '*.glob' | xargs rm -f devdocclean: - find . -name '*.dep.ps' -o -name '*.dot' -exec rm -f {} \; + 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)/html/*.html ########################################################################### # Emacs tags ########################################################################### +.PHONY: tags otags + tags: - echo $(MLIFILES) $(MLFILES) $(ML4FILES) | sort -r | xargs \ + echo $(MLIFILES) $(MLSTATICFILES) $(ML4FILES) | sort -r | xargs \ etags --language=none\ "--regex=/let[ \t]+\([^ \t]+\)/\1/" \ "--regex=/let[ \t]+rec[ \t]+\([^ \t]+\)/\1/" \ @@ -288,7 +255,7 @@ tags: otags: - echo $(MLIFILES) $(MLFILES) | sort -r | xargs otags + echo $(MLIFILES) $(MLSTATICFILES) | sort -r | xargs otags echo $(ML4FILES) | sort -r | xargs \ etags --append --language=none\ "--regex=/let[ \t]+\([^ \t]+\)/\1/" \ diff --git a/Makefile.build b/Makefile.build index 717fcf20..59ee457c 100644 --- a/Makefile.build +++ b/Makefile.build @@ -1,4 +1,4 @@ -###################################################################### +####################################################################### # v # The Coq Proof Assistant / The Coq Development Team # # $@ +## then the target file will be created even if cmd has failed. +## Hence relaunching make will go further, as make thinks the target has been +## done ok. To avoid this, we use the following macro: + +TOTARGET = > "$@" || (RV=$$?; rm -f "$@"; exit $${RV}) + ########################################################################### # Compilation option for .c files ########################################################################### @@ -141,22 +177,19 @@ $(LIBCOQRUN): kernel/byterun/coq_jumptbl.h $(BYTERUN) #coq_jumptbl.h is required only if you have GCC 2.0 or later kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h sed -n -e '/^ /s/ \([A-Z]\)/ \&\&coq_lbl_\1/gp' \ - -e '/^}/q' kernel/byterun/coq_instruct.h > \ - kernel/byterun/coq_jumptbl.h \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + -e '/^}/q' $< $(TOTARGET) kernel/copcodes.ml: kernel/byterun/coq_instruct.h - sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' \ - kernel/byterun/coq_instruct.h | \ - awk -f kernel/make-opcodes > kernel/copcodes.ml \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) - + sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' $< | \ + awk -f kernel/make-opcodes $(TOTARGET) ########################################################################### # Main targets (coqmktop, coqtop.opt, coqtop.byte) ########################################################################### -coqbinaries:: ${COQBINARIES} ${CSDPCERT} +.PHONY: coqbinaries coq coqlib coqlight states + +coqbinaries:: ${COQBINARIES} ${CSDPCERT} ${FAKEIDE} coq: coqlib tools coqbinaries @@ -166,14 +199,14 @@ coqlight: theories-light tools coqbinaries states:: states/initial.coq -$(COQTOPOPT): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) +$(COQTOPOPT): $(BESTCOQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(SHOW)'COQMKTOP -o $@' - $(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) -o $@ + $(HIDE)$(BESTCOQMKTOP) -boot -opt $(OPTFLAGS) -o $@ $(STRIP) $@ -$(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) +$(COQTOPBYTE): $(BESTCOQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(SHOW)'COQMKTOP -o $@' - $(HIDE)$(COQMKTOP) -boot -top $(BYTEFLAGS) -o $@ + $(HIDE)$(BESTCOQMKTOP) -boot -top $(BYTEFLAGS) -o $@ $(COQTOPEXE): $(ORDER_ONLY_SEP) $(BESTCOQTOP) cd bin; ln -sf coqtop.$(BEST)$(EXE) coqtop$(EXE) @@ -185,12 +218,12 @@ CHKOPTFLAGS:=$(CHKLIBS) $(CAMLDEBUGOPT) $(CAMLTIMEPROF) $(USERFLAGS) $(CHICKENOPT): checker/check.cmxa checker/main.ml $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(CHKOPTFLAGS) -o $@ str.cmxa unix.cmxa gramlib.cmxa $^ + $(HIDE)$(OCAMLOPT) $(CHKOPTFLAGS) -o $@ $(SYSCMXA) $^ $(STRIP) $@ $(CHICKENBYTE): checker/check.cma checker/main.ml $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(CHKBYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ str.cma unix.cma gramlib.cma $^ + $(HIDE)$(OCAMLC) $(CHKBYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ $(SYSCMA) $^ $(CHICKEN): $(ORDER_ONLY_SEP) $(BESTCHICKEN) cd bin && ln -sf coqchk.$(BEST)$(EXE) coqchk$(EXE) @@ -199,13 +232,11 @@ $(CHICKEN): $(ORDER_ONLY_SEP) $(BESTCHICKEN) $(COQMKTOPBYTE): $(COQMKTOPCMO) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma gramlib.cma\ - $^ $(OSDEPLIBS) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(SYSCMA) $^ $(OSDEPLIBS) -$(COQMKTOPOPT): $(COQMKTOPCMX) +$(COQMKTOPOPT): $(COQMKTOPCMO:.cmo=.cmx) $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa unix.cmxa gramlib.cmxa\ - $^ $(OSDEPLIBS) + $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ $(SYSCMXA) $^ $(OSDEPLIBS) $(STRIP) $@ $(COQMKTOP): $(ORDER_ONLY_SEP) $(BESTCOQMKTOP) @@ -216,20 +247,19 @@ scripts/tolink.ml: Makefile.build Makefile.common $(HIDE)echo "let copts = \"-cclib -lcoqrun\"" > $@ $(HIDE)echo "let core_libs = \""$(LINKCMO)"\"" >> $@ $(HIDE)echo "let core_objs = \""$(OBJSMOD)"\"" >> $@ - $(HIDE)echo "let ide = \""$(IDEMOD)"\"" >> $@ # coqc -$(COQCBYTE): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP) +$(COQCBYTE): $(COQCCMO) | $(COQTOPBYTE) $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma gramlib.cma $(COQCCMO) $(OSDEPLIBS) + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(SYSCMA) $^ $(OSDEPLIBS) -$(COQCOPT): $(COQCCMX) $(COQTOPOPT) $(BESTCOQTOP) +$(COQCOPT): $(COQCCMO:.cmo=.cmx) | $(COQTOPOPT) $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa unix.cmxa gramlib.cmxa $(COQCCMX) $(OSDEPLIBS) + $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ $(SYSCMXA) $^ $(OSDEPLIBS) $(STRIP) $@ -$(COQC): $(ORDER_ONLY_SEP) $(BESTCOQC) +$(COQC): $(ORDER_ONLY_SEP) $(BESTCOQC) cd bin; ln -sf coqc.$(BEST)$(EXE) coqc$(EXE) # target for libraries @@ -256,21 +286,16 @@ checker/check.cmxa: | checker/check.mllib.d # Csdp to micromega special targets ########################################################################### -ifeq ($(BEST),opt) -plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMX) - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) nums.cmxa unix.cmxa -o $@ $^ - $(STRIP) $@ -else -plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMO) - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) nums.cma unix.cma -o $@ $^ -endif +plugins/micromega/csdpcert$(EXE): $(CSDPCERTCMO:.cmo=$(BESTOBJ)) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,nums unix) ########################################################################### # CoqIde special targets ########################################################################### +.PHONY: coqide coqide-binaries coqide-no coqide-byte coqide-opt coqide-files + # target to build CoqIde coqide:: coqide-files coqide-binaries states @@ -278,7 +303,7 @@ COQIDEFLAGS=-thread $(COQIDEINCLUDES) .SUFFIXES:.vo -IDEFILES=ide/coq.png ide/.coqide-gtk2rc +IDEFILES=ide/coq.png ide/coqide-gtk2rc ide/mac_default_accel_map coqide-binaries: coqide-$(HASCOQIDE) coqide-no: @@ -286,75 +311,75 @@ coqide-byte: $(COQIDEBYTE) $(COQIDE) coqide-opt: $(COQIDEBYTE) $(COQIDEOPT) $(COQIDE) coqide-files: $(IDEFILES) -$(COQIDEOPT): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) ide/ide.cmxa - $(SHOW)'COQMKTOP -o $@' - $(HIDE)$(COQMKTOP) -boot -ide -opt $(OPTFLAGS) -o $@ +$(COQIDEOPT): $(LINKIDEOPT) | $(COQTOPOPT) + $(SHOW)'OCAMLOPT -o $@' + $(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) $(IDEOPTFLAGS) -o $@ unix.cmxa threads.cmxa lablgtk.cmxa\ + gtkThread.cmx str.cmxa $(LINKIDEOPT) $(STRIP) $@ -$(COQIDEBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) ide/ide.cma - $(SHOW)'COQMKTOP -o $@' - $(HIDE)$(COQMKTOP) -boot -g -ide -top $(BYTEFLAGS) -o $@ +$(COQIDEBYTE): $(LINKIDE) | $(COQTOPBYTE) + $(SHOW)'OCAMLOPT -o $@' + $(HIDE)$(OCAMLC) $(COQIDEFLAGS) $(BYTEFLAGS) -o $@ unix.cma threads.cma lablgtk.cma gtkThread.cmo\ + str.cma $(COQRUNBYTEFLAGS) $(LINKIDE) $(COQIDE): cd bin; ln -sf coqide.$(HASCOQIDE)$(EXE) coqide$(EXE) -ide/%.cmo: ide/%.ml | ide/%.ml.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $< - -ide/%.cmi: ide/%.mli | ide/%.mli.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) -g $(COQIDEFLAGS) $(BYTEFLAGS) -c $< - -ide/%.cmx: ide/%.ml | ide/%.ml.d - $(SHOW)'OCAMLOPT $<' - $(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -c $< - # install targets -FULLIDELIB=$(FULLCOQLIB)/ide +.PHONY: install-coqide install-ide-no install-ide-byte install-ide-opt +.PHONY: install-ide-files install-ide-info install-im install-coqide:: install-ide-$(HASCOQIDE) install-ide-files install-ide-info install-ide-no: -install-ide-byte: +install-ide-byte: $(MKDIR) $(FULLBINDIR) $(INSTALLBIN) $(COQIDEBYTE) $(FULLBINDIR) $(INSTALLSH) $(FULLCOQLIB) $(IDECMA) \ - `cat $(IDECMA:.cma=.mllib.d) | tr ' ' '\n' | sed -n -e "/\.cmo/s/\.cmo/\.cmi/p"` + $(foreach lib,$(IDECMA:.cma=_MLLIB_DEPENDENCIES),$(addsuffix .cmi,$($(lib)))) cd $(FULLBINDIR); ln -sf coqide.byte$(EXE) coqide$(EXE) install-ide-opt: $(MKDIR) $(FULLBINDIR) - $(INSTALLBIN) $(COQIDEBYTE) $(COQIDEOPT) $(FULLBINDIR) + $(INSTALLBIN) $(COQIDEOPT) $(FULLBINDIR) $(INSTALLSH) $(FULLCOQLIB) $(IDECMA) $(IDECMA:.cma=.cmxa) $(IDECMA:.cma=.a) \ - `cat $(IDECMA:.cma=.mllib.d) | tr ' ' '\n' | sed -n -e "/\.cmo/s/\.cmo/\.cmi/p"` + $(foreach lib,$(IDECMA:.cma=_MLLIB_DEPENDENCIES),$(addsuffix .cmi,$($(lib)))) cd $(FULLBINDIR); ln -sf coqide.opt$(EXE) coqide$(EXE) install-ide-files: - $(MKDIR) $(FULLIDELIB) - $(INSTALLLIB) $(IDEFILES) $(FULLIDELIB) + $(MKDIR) $(FULLDATADIR) + $(INSTALLLIB) ide/coq.png $(FULLDATADIR) + $(MKDIR) $(FULLCONFIGDIR) + $(INSTALLLIB) ide/coqide-gtk2rc $(FULLCONFIGDIR) + if [ $(IDEOPTINT) = QUARTZ ] ; then $(INSTALLLIB) ide/mac_default_accel_map $(FULLCONFIGDIR)/coqide.keys ; fi install-ide-info: - $(MKDIR) $(FULLIDELIB) - $(INSTALLLIB) ide/FAQ $(FULLIDELIB) + $(MKDIR) $(FULLDOCDIR) + $(INSTALLLIB) ide/FAQ $(FULLDOCDIR)/FAQ-CoqIde ########################################################################### # tests ########################################################################### +.PHONY: validate check test-suite $(ALLSTDLIB).v + VALIDOPTS=-silent -o -m validate:: $(BESTCHICKEN) $(ALLVO) $(SHOW)'COQCHK ' $(HIDE)$(BESTCHICKEN) -boot $(VALIDOPTS) $(ALLMODS) +$(ALLSTDLIB).v: + $(SHOW)'MAKE $(notdir $@)' + $(HIDE)echo "Require $(ALLMODS)." > $@ + MAKE_TSOPTS=-C test-suite -s BEST=$(BEST) VERBOSE=$(VERBOSE) check:: validate test-suite -test-suite: world +test-suite: world $(ALLSTDLIB).v $(MAKE) $(MAKE_TSOPTS) clean $(MAKE) $(MAKE_TSOPTS) all $(HIDE)if grep -F 'Error!' test-suite/summary.log ; then false; fi @@ -363,6 +388,9 @@ test-suite: world # partial targets: 1) core ML parts ################################################################## +.PHONY: lib kernel byterun library proofs tactics interp parsing pretyping +.PHONY: highparsing toplevel hightactics + lib: lib/lib.cma kernel: kernel/kernel.cma byterun: $(BYTERUN) @@ -380,6 +408,10 @@ hightactics: tactics/hightactics.cma # 2) theories and plugins files ########################################################################### +.PHONY: init theories theories-light +.PHONY: logic arith bool narith zarith qarith lists strings sets +.PHONY: fsets relations wellfounded reals setoids sorting numbers noreal + init: $(INITVO) theories: $(THEORIESVO) @@ -401,6 +433,11 @@ reals: $(REALSVO) setoids: $(SETOIDSVO) sorting: $(SORTINGVO) numbers: $(NUMBERSVO) +unicode: $(UNICODEVO) +classes: $(CLASSESVO) +program: $(PROGRAMVO) +structures: $(STRUCTURESVO) +vectors: $(VECTORSVO) noreal: logic arith bool zarith qarith lists sets fsets relations \ wellfounded setoids sorting @@ -409,6 +446,9 @@ noreal: logic arith bool zarith qarith lists sets fsets relations \ # 3) plugins ########################################################################### +.PHONY: plugins omega micromega ring setoid_ring nsatz dp xml extraction +.PHONY: field fourier funind cc subtac rtauto pluginsopt + plugins: $(PLUGINSVO) omega: $(OMEGAVO) $(OMEGACMA) $(ROMEGAVO) $(ROMEGACMA) micromega: $(MICROMEGAVO) $(MICROMEGACMA) $(CSDPCERT) @@ -425,6 +465,8 @@ cc: $(CCVO) $(CCCMA) subtac: $(SUBTACCMA) rtauto: $(RTAUTOVO) $(RTAUTOCMA) +pluginsopt: $(PLUGINSOPT) + ########################################################################### # rules to make theories, plugins and states ########################################################################### @@ -436,97 +478,81 @@ states/initial.coq: states/MakeInitial.v $(INITVO) $(VO_TOOLS_STRICT) | states/M theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_STRICT) | theories/Init/%.v.d $(VO_TOOLS_ORDER_ONLY) $(SHOW)'COQC -nois $<' $(HIDE)rm -f theories/Init/$*.glob - $(HIDE)$(BOOTCOQTOP) -nois -compile theories/Init/$* + $(HIDE)$(BOOTCOQC) theories/Init/$* -nois theories/Numbers/Natural/BigN/NMake_gen.v: theories/Numbers/Natural/BigN/NMake_gen.ml - $(OCAML) $< > $@ + $(OCAML) $< $(TOTARGET) ########################################################################### # tools ########################################################################### +.PHONY: printers tools + printers: $(DEBUGPRINTERS) tools:: $(TOOLS) $(DEBUGPRINTERS) $(COQDEPBOOT) -# coqdep_boot : a basic version of coqdep, with almost no dependencies +# coqdep_boot : a basic version of coqdep, with almost no dependencies. -$(COQDEPBOOT): $(COQDEPBOOTML) -ifeq ($(BEST),opt) - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ -I tools unix.cmxa $^ - $(STRIP) $@ -else - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ -I tools unix.cma $^ -endif +# Here it is important to mention .ml files instead of .cmo in order +# to avoid using implicit rules and hence .ml.d files that would need +# coqdep_boot. + +COQDEPBOOTSRC:= \ + tools/coqdep_lexer.mli tools/coqdep_lexer.ml \ + tools/coqdep_common.mli tools/coqdep_common.ml \ + tools/coqdep_boot.ml + +$(COQDEPBOOT): $(COQDEPBOOTSRC) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml, -I tools, unix) # the full coqdep -ifeq ($(BEST),opt) -$(COQDEP): $(COQDEPCMX) - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa unix.cmxa gramlib.cmxa $^ $(OSDEPLIBS) - $(STRIP) $@ -else -$(COQDEP): $(COQDEPCMO) - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ str.cma unix.cma gramlib.cma $^ $(OSDEPLIBS) -endif +$(COQDEP): $(COQDEPCMO:.cmo=$(BESTOBJ)) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD)) -ifeq ($(BEST),opt) -$(GALLINA): $(GALLINACMX) - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ $(GALLINACMX) - $(STRIP) $@ -else -$(GALLINA): $(GALLINACMO) - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ $^ -endif +$(GALLINA): $(addsuffix $(BESTOBJ), tools/gallina_lexer tools/gallina) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,) -ifeq ($(BEST),opt) -$(COQMAKEFILE): tools/coq_makefile.cmx config/coq_config.cmx - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa config/coq_config.cmx tools/coq_makefile.cmx - $(STRIP) $@ -else -$(COQMAKEFILE): config/coq_config.cmo tools/coq_makefile.cmo - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ str.cma $^ -endif +$(COQMAKEFILE): $(addsuffix $(BESTOBJ),config/coq_config ide/minilib ide/project_file tools/coq_makefile) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,str unix) -ifeq ($(BEST),opt) -$(COQTEX): tools/coq_tex.cmx - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa $^ - $(STRIP) $@ -else -$(COQTEX): tools/coq_tex.cmo - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ str.cma $^ -endif +$(COQTEX): tools/coq_tex$(BESTOBJ) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,str) -ifeq ($(BEST),opt) -$(COQWC): tools/coqwc.cmx - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ tools/coqwc.cmx - $(STRIP) $@ -else -$(COQWC): tools/coqwc.cmo - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ $^ -endif +$(COQWC): tools/coqwc$(BESTOBJ) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,) -ifeq ($(BEST),opt) -$(COQDOC): $(COQDOCCMX) - $(SHOW)'OCAMLOPT -o $@' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -o $@ str.cmxa unix.cmxa $(COQDOCCMX) - $(STRIP) $@ +$(COQDOC): $(COQDOCCMO:.cmo=$(BESTOBJ)) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,str unix) + +# fake_ide : for debugging or test-suite purpose, a fake ide simulating +# a connection to coqtop -ideslave + +$(FAKEIDE): lib/xml_lexer$(BESTOBJ) lib/xml_parser$(BESTOBJ) lib/xml_utils$(BESTOBJ) toplevel/ide_intf$(BESTOBJ) tools/fake_ide$(BESTOBJ) + $(SHOW)'OCAMLBEST -o $@' + $(HIDE)$(call bestocaml,,unix) + +# Special rule for the compatibility-with-camlp5 extension for camlp4 + +ifeq ($(CAMLP4),camlp4) +tools/compat5.cmo: tools/compat5.mlp + $(OCAMLC) -c -I $(MYCAMLP4LIB) -pp "$(CAMLP4O) -impl" -impl $< +tools/compat5b.cmo: tools/compat5b.mlp + $(OCAMLC) -c -I $(MYCAMLP4LIB) -pp "$(CAMLP4O) -impl" -impl $< else -$(COQDOC): $(COQDOCCMO) - $(SHOW)'OCAMLC -o $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(COQTOOLSBYTEFLAGS) -o $@ str.cma unix.cma $^ +tools/compat5.cmo: tools/compat5.ml + $(OCAMLC) -c $< +tools/compat5b.cmo: tools/compat5b.ml + $(OCAMLC) -c $< endif ########################################################################### @@ -543,6 +569,8 @@ endif ifdef COQINSTALLPREFIX FULLBINDIR=$(BINDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) FULLCOQLIB=$(COQLIBINSTALL:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) +FULLCONFIGDIR=$(CONFIGDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) +FULLDATADIR=$(DATADIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) FULLMANDIR=$(MANDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) FULLEMACSLIB=$(EMACSLIB:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) FULLCOQDOCDIR=$(COQDOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) @@ -550,12 +578,18 @@ FULLDOCDIR=$(DOCDIR:"$(OLDROOT)%="$(COQINSTALLPREFIX)%) else FULLBINDIR=$(BINDIR) FULLCOQLIB=$(COQLIBINSTALL) +FULLCONFIGDIR=$(CONFIGDIR) +FULLDATADIR=$(DATADIR) FULLMANDIR=$(MANDIR) FULLEMACSLIB=$(EMACSLIB) FULLCOQDOCDIR=$(COQDOCDIR) FULLDOCDIR=$(DOCDIR) endif +.PHONY: install-coq install-coqlight install-binaries install-byte install-opt +.PHONY: install-tools install-library install-library-light +.PHONY: install-coq-info install-coq-manpages install-emacs install-latex + install-coq: install-binaries install-library install-coq-info install-coqlight: install-binaries install-library-light @@ -579,6 +613,14 @@ install-tools:: $(INSTALLLIB) tools/coqdoc/coqdoc.css tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc $(INSTALLBIN) $(TOOLS) $(FULLBINDIR) +# The list of .cmi to install, including the ones obtained +# from .mli without .ml, and the ones obtained from .ml without .mli + +INSTALLCMI = $(sort \ + $(CONFIG:.cmo=.cmi) \ + $(filter-out checker/% ide/% tools/%, $(MLIFILES:.mli=.cmi)) \ + $(foreach lib,$(CORECMA) $(PLUGINSCMA), $(addsuffix .cmi,$($(lib:.cma=_MLLIB_DEPENDENCIES))))) + install-library: $(MKDIR) $(FULLCOQLIB) $(INSTALLSH) $(FULLCOQLIB) $(LIBFILES) $(PLUGINS) $(PLUGINSOPT) @@ -587,9 +629,7 @@ install-library: $(MKDIR) $(FULLCOQLIB)/user-contrib $(INSTALLLIB) $(DLLCOQRUN) $(FULLCOQLIB) $(INSTALLSH) $(FULLCOQLIB) $(CONFIG) $(LINKCMO) $(GRAMMARCMA) - # reconstitute the list of core .cmi - $(INSTALLSH) $(FULLCOQLIB) $(CONFIG:.cmo=.cmi) \ - `cat $(CORECMA:.cma=.mllib.d) $(PLUGINSCMA:.cma=.mllib.d) | tr ' ' '\n' | sed -n -e "/\.cmo/s/\.cmo/\.cmi/p"` + $(INSTALLSH) $(FULLCOQLIB) $(INSTALLCMI) ifeq ($(BEST),opt) $(INSTALLLIB) $(LIBCOQRUN) $(FULLCOQLIB) $(INSTALLSH) $(FULLCOQLIB) $(CONFIG:.cmo=.cmx) $(CONFIG:.cmo=.o) $(LINKCMO:.cma=.cmxa) $(LINKCMO:.cma=.a) @@ -598,6 +638,7 @@ endif # it with libraries -$(MKDIR) $(FULLCOQLIB)/plugins/micromega $(INSTALLBIN) $(CSDPCERT) $(FULLCOQLIB)/plugins/micromega + rm -f $(FULLCOQLIB)/revision -$(INSTALLLIB) revision $(FULLCOQLIB) install-library-light: @@ -605,6 +646,7 @@ install-library-light: $(INSTALLSH) $(FULLCOQLIB) $(LIBFILESLIGHT) $(INITPLUGINS) $(INITPLUGINSOPT) $(MKDIR) $(FULLCOQLIB)/states $(INSTALLLIB) states/*.coq $(FULLCOQLIB)/states + rm -f $(FULLCOQLIB)/revision -$(INSTALLLIB) revision $(FULLCOQLIB) install-coq-info: install-coq-manpages install-emacs install-latex @@ -629,12 +671,47 @@ install-latex: # Documentation of the source code (using ocamldoc) ########################################################################### -.PHONY: source-doc +.PHONY: source-doc mli-doc ml-doc + +source-doc: mli-doc $(OCAMLDOCDIR)/coq.pdf -source-doc: - if !(test -d $(SOURCEDOCDIR)); then mkdir $(SOURCEDOCDIR); fi - $(OCAMLDOC) -html -rectypes $(LOCALINCLUDES) -d $(SOURCEDOCDIR) $(MLFILES) +$(OCAMLDOCDIR)/coq.tex:: $(DOCMLIS:.mli=.cmi) + $(OCAMLDOC) -latex -rectypes -I $(MYCAMLP4LIB) $(MLINCLUDES)\ + $(DOCMLIS) -t "Coq mlis documentation" \ + -intro $(OCAMLDOCDIR)/docintro -o $@ +mli-doc:: $(DOCMLIS:.mli=.cmi) + $(OCAMLDOC) -html -rectypes -I $(MYCAMLP4LIB) $(MLINCLUDES)\ + $(DOCMLIS) -d $(OCAMLDOCDIR)/html -colorize-code \ + -t "Coq mlis documentation" -intro $(OCAMLDOCDIR)/docintro \ + -css-style style.css + +%_dep.png: %.dot + $(DOT) -Tpng $< -o $@ + +%_types.dot: %.mli + $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -dot-types -o $@ $< + +OCAMLDOC_MLLIBD = $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ \ + $(foreach lib,$(|:.mllib.d=_MLLIB_DEPENDENCIES),$(addsuffix .ml,$($(lib)))) + +%.dot: | %.mllib.d + $(OCAMLDOC_MLLIBD) + +ml-doc: + $(OCAMLDOC) -html -rectypes $(LOCALINCLUDES) -d $(SOURCEDOCDIR) $(MLSTATICFILES) + +parsing/parsing.dot : | parsing/parsing.mllib.d parsing/highparsing.mllib.d + $(OCAMLDOC_MLLIBD) + +tactics/tactics.dot: | tactics/tactics.mllib.d tactics/hightactics.mllib.d + $(OCAMLDOC_MLLIBD) + +%.dot: %.mli + $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ $< + +$(OCAMLDOCDIR)/%.pdf: $(OCAMLDOCDIR)/%.tex + (cd $(OCAMLDOCDIR) ; pdflatex $*.tex && pdflatex $*.tex) ########################################################################### ### Special rules @@ -642,7 +719,7 @@ source-doc: dev/printers.cma: | dev/printers.mllib.d $(SHOW)'Testing $@' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) unix.cma gramlib.cma $^ -o test-printer + $(HIDE)$(OCAMLC) $(BYTEFLAGS) $(SYSCMA) $^ -o test-printer @rm -f test-printer $(SHOW)'OCAMLC -a $@' $(HIDE)$(OCAMLC) $(BYTEFLAGS) $^ -linkall -a -o $@ @@ -650,35 +727,38 @@ dev/printers.cma: | dev/printers.mllib.d parsing/grammar.cma: | parsing/grammar.mllib.d $(SHOW)'Testing $@' @touch test.ml4 - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) $^ -impl" -impl test.ml4 -o test-grammar + $(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) -I $(CAMLLIB) $^ -impl" -impl test.ml4 -o test-grammar @rm -f test-grammar test.* $(SHOW)'OCAMLC -a $@' $(HIDE)$(OCAMLC) $(BYTEFLAGS) $^ -linkall -a -o $@ # toplevel/mltop.ml4 (ifdef Byte) -toplevel/mltop.cmo: toplevel/mltop.byteml | toplevel/mltop.ml4.ml.d toplevel/mltop.ml4.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -c -impl $< -o $@ +## NB: mltop.ml correspond to the byte version (and hence need no special rules) +## while the opt version is in mltop.optml. Since mltop.optml uses mltop.ml.d +## as dependency file, be sure to import the same modules in the different sections +## of the ml4 -toplevel/mltop.cmx: toplevel/mltop.optml | toplevel/mltop.ml4.ml.d toplevel/mltop.ml4.d - $(SHOW)'OCAMLOPT $<' +toplevel/mltop.cmx: toplevel/mltop.optml | toplevel/mltop.ml.d toplevel/mltop.ml4.d + $(SHOW)'OCAMLOPT $<' $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -c -impl $< -o $@ -## This works dependency-wise because the dependencies of the -## .{opt,byte}ml files are those we deduce from the .ml4 file. -## In other words, the Byte-only code doesn't import a new module. -toplevel/mltop.byteml: toplevel/mltop.ml4 config/Makefile # no camlp4deps here - $(SHOW)'CAMLP4O $<' - $(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo `$(CAMLP4USE) $<` \ - -DByte -DHasDynlink -impl $< > $@ \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) +toplevel/mltop.ml: toplevel/mltop.ml4 config/Makefile # no camlp4deps here + $(SHOW)'CAMLP4O $<' + $(HIDE)$(CAMLP4O) $(PR_O) $(CAMLP4USE) -DByte -DHasDynlink -impl $< -o $@ + +toplevel/mltop.optml: toplevel/mltop.ml4 config/Makefile # no camlp4deps here + $(SHOW)'CAMLP4O $<' + $(HIDE)$(CAMLP4O) $(PR_O) $(CAMLP4USE) $(NATDYNLINKDEF) -impl $< -o $@ + +ide/coqide_main.ml: ide/coqide_main.ml4 + $(SHOW)'CAMLP4O $<' + $(HIDE)$(CAMLP4O) $(CAMLP4USE) -impl $< -o $@ + +ide/coqide_main_opt.ml: ide/coqide_main.ml4 config/Makefile # no camlp4deps here + $(SHOW)'CAMLP4O $<' + $(HIDE)$(CAMLP4O) $(CAMLP4USE) -D$(IDEOPTINT) -impl $< -o $@ -toplevel/mltop.optml: toplevel/mltop.ml4 config/Makefile # no camlp4deps here - $(SHOW)'CAMLP4O $<' - $(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo `$(CAMLP4USE) $<` \ - $(NATDYNLINKDEF) -impl $< > $@ \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) # pretty printing of the revision number when compiling a checked out # source tree @@ -731,52 +811,46 @@ endif # Default rules ########################################################################### -checker/%.cmo: checker/%.ml | checker/%.ml.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) -c $(CHKBYTEFLAGS) $< +## Three flavor of flags: checker/* ide/* and normal files -checker/%.cmx: checker/%.ml | checker/%.ml.d - $(SHOW)'OCAMLOPT $<' - $(HIDE)$(OCAMLOPT) -c $(CHKOPTFLAGS) $< +COND_BYTEFLAGS= \ + $(if $(filter checker/%,$<), $(CHKBYTEFLAGS), \ + $(if $(filter ide/%,$<),$(COQIDEFLAGS),) $(BYTEFLAGS)) -checker/%.cmi: checker/%.mli | checker/%.mli.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) -c $(CHKBYTEFLAGS) $< +COND_OPTFLAGS= \ + $(if $(filter checker/%,$<), $(CHKOPTFLAGS), \ + $(if $(filter ide/%,$<),$(COQIDEFLAGS),) $(OPTFLAGS)) %.o: %.c $(SHOW)'OCAMLC $<' $(HIDE)cd $(dir $<) && $(OCAMLC) -ccopt "$(CFLAGS)" -c $(notdir $<) -ifdef KEEP_ML4_PREPROCESSED -.PRECIOUS: %.ml4-preprocessed -%.cmo: %.ml4-preprocessed | %.ml4.ml.d +%.cmi: %.mli | %.mli.d $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -c -impl $< - -%.cmx: %.ml4-preprocessed | %.ml4.ml.d - $(SHOW)'OCAMLOPT $<' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -c -impl $< -else -%.cmo: %.ml4 | %.ml4.ml.d %.ml4.d - $(SHOW)'OCAMLC4 $<' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4USE) $<` `$(CAMLP4DEPS) $<` $(CAMLP4COMPAT) -impl" -c -impl $< - -%.cmx: %.ml4 | %.ml4.ml.d %.ml4.d - $(SHOW)'OCAMLOPT4 $<' - $(HIDE)$(OCAMLOPT) $(OPTFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4USE) $<` `$(CAMLP4DEPS) $<` $(CAMLP4COMPAT) -impl" -c -impl $< -endif + $(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -c $< %.cmo: %.ml | %.ml.d $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -c $< + $(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -c $< -%.cmi: %.mli | %.mli.d - $(SHOW)'OCAMLC $<' - $(HIDE)$(OCAMLC) $(BYTEFLAGS) -c $< +## NB: for the moment ocamlopt erases and recreates .cmi if there's no .mli around. +## This can lead to nasty things with make -j. To avoid that: +## 1) We make .cmx always depend on .cmi +## 2) This .cmi will be created from the .mli, or trigger the compilation of the +## .cmo if there's no .mli (see rule below about MLWITHOUTMLI) +## 3) We tell ocamlopt to use the .cmi as the interface source file. With this +## hack, everything goes as if there is a .mli, and the .cmi is preserved +## and the .cmx is checked with respect to this .cmi + +HACKMLI = $(if $(wildcard $ $@ $(HIDE)echo "let _=Mltop.add_known_module\"$(notdir $*)\"" >> $@ -.SECONDARY: $(filter plugins/%,$(MLLIBFILES:%.mllib=%_mod.ml)) +# NB: compatibility modules for camlp4: +# - tools/compat5.cmo changes GEXTEND into EXTEND. Safe, always loaded +# - tools/compat5b.cmo changes EXTEND into EXTEND Gram. Interact badly with +# syntax such that VERNAC EXTEND, we only load it for a few files via camlp4deps -%.ml4-preprocessed: %.ml4 | %.ml4.d +%.ml: %.ml4 | %.ml4.d tools/compat5.cmo tools/compat5b.cmo $(SHOW)'CAMLP4O $<' - $(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo `$(CAMLP4USE) $<` `$(CAMLP4DEPS) $<` $(CAMLP4COMPAT) -impl $< > $@ \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + $(HIDE)\ + DEPS=$(CAMLP4DEPS); \ + if ls $${DEPS} > /dev/null 2>&1; then \ + $(CAMLP4O) $(PR_O) -I $(CAMLLIB) tools/compat5.cmo $${DEPS} $(CAMLP4USE) $(CAMLP4COMPAT) -impl $< -o $@; \ + else echo $< : Dependency $${DEPS} not ready yet; false; fi %.vo %.glob: %.v states/initial.coq $(INITPLUGINSBEST) $(VO_TOOLS_STRICT) | %.v.d $(VO_TOOLS_ORDER_ONLY) $(SHOW)'COQC $<' $(HIDE)rm -f $*.glob - $(HIDE)$(BOOTCOQTOP) -compile $* + $(HIDE)$(BOOTCOQC) $* ifdef VALIDATE $(SHOW)'COQCHK $(call vo_to_mod,$@)' $(HIDE)$(BESTCHICKEN) -boot -silent -norec $(call vo_to_mod,$@) \ @@ -826,69 +906,51 @@ endif # .ml4.d contains the dependencies to generate the .ml from the .ml4 # NOT to generate object code. -ifdef NO_RECOMPILE_ML4 - SEP:=$(ORDER_ONLY_SEP) -else - SEP:= -endif + %.ml4.d: $(D_DEPEND_BEFORE_SRC) %.ml4 $(SHOW)'CAMLP4DEPS $<' - $(HIDE)( printf "%s" '$*.cmo $*.cmx $*.ml4.ml.d $*.ml4-preprocessed: $(SEP)' && $(CAMLP4DEPS) "$<" ) > "$@" \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + $(HIDE)echo "$*.ml: $(if $(NO_RECOMPILE_ML4),$(ORDER_ONLY_SEP)) $(CAMLP4DEPS)" $(TOTARGET) + +# We now use coqdep_boot to wrap around ocamldep -modules, since it is aware +# of .ml4 files -%.ml4.ml.d: $(D_DEPEND_BEFORE_SRC) %.ml4 $(D_DEPEND_AFTER_SRC) $(GENFILES) $(ML4FILESML) %.ml4.d -#Critical section: -# Nobody (in a make -j) should touch the .ml file here. - $(SHOW)'OCAMLDEP4 $<' - $(HIDE)$(CAMLP4O) $(CAMLP4EXTENDFLAGS) pr_o.cmo `$(CAMLP4USE) $<` `$(CAMLP4DEPS) $<` $(CAMLP4COMPAT) -impl $< -o $*.ml \ - || ( RV=$$?; rm -f "$*.ml"; exit $${RV} ) - $(HIDE)$(OCAMLDEP) $(DEPFLAGS) $*.ml | sed '' > "$@" || ( RV=$$?; rm -f "$@"; exit $${RV} ) - $(HIDE)echo "let keep_ocamldep_happy Do_not_compile_me = assert false" > $*.ml -#End critical section - -checker/%.ml.d: $(D_DEPEND_BEFORE_SRC) checker/%.ml $(D_DEPEND_AFTER_SRC) +OCAMLDEP_NG = $(COQDEPBOOT) -mldep $(OCAMLDEP) + +checker/%.ml.d: $(D_DEPEND_BEFORE_SRC) checker/%.ml $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'OCAMLDEP $<' - $(HIDE)$(OCAMLDEP) -slash $(LOCALCHKLIBS) "$<" | sed '' > "$@" + $(HIDE)$(OCAMLDEP_NG) -slash $(LOCALCHKLIBS) "$<" $(TOTARGET) -checker/%.mli.d: $(D_DEPEND_BEFORE_SRC) checker/%.mli $(D_DEPEND_AFTER_SRC) +checker/%.mli.d: $(D_DEPEND_BEFORE_SRC) checker/%.mli $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'OCAMLDEP $<' - $(HIDE)$(OCAMLDEP) -slash $(LOCALCHKLIBS) "$<" | sed '' > "$@" + $(HIDE)$(OCAMLDEP_NG) -slash $(LOCALCHKLIBS) "$<" $(TOTARGET) -%.ml.d: $(D_DEPEND_BEFORE_SRC) %.ml $(D_DEPEND_AFTER_SRC) $(GENFILES) $(ML4FILESML) +%.ml.d: $(D_DEPEND_BEFORE_SRC) %.ml $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'OCAMLDEP $<' - $(HIDE)$(OCAMLDEP) $(DEPFLAGS) "$<" | sed '' > "$@" + $(HIDE)$(OCAMLDEP_NG) $(DEPFLAGS) "$<" $(TOTARGET) -%.mli.d: $(D_DEPEND_BEFORE_SRC) %.mli $(D_DEPEND_AFTER_SRC) $(GENFILES) $(ML4FILESML) +%.mli.d: $(D_DEPEND_BEFORE_SRC) %.mli $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'OCAMLDEP $<' - $(HIDE)$(OCAMLDEP) $(DEPFLAGS) "$<" | sed '' > "$@" + $(HIDE)$(OCAMLDEP_NG) $(DEPFLAGS) "$<" $(TOTARGET) -checker/%.mllib.d: $(D_DEPEND_BEFORE_SRC) checker/%.mllib $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) +checker/%.mllib.d: $(D_DEPEND_BEFORE_SRC) checker/%.mllib $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'COQDEP $<' - $(HIDE)$(COQDEPBOOT) -slash -boot -I checker -c "$<" > "$@" \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + $(HIDE)$(COQDEPBOOT) -slash -I checker -c "$<" $(TOTARGET) -%.mllib.d: $(D_DEPEND_BEFORE_SRC) %.mllib $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) +%.mllib.d: $(D_DEPEND_BEFORE_SRC) %.mllib $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENFILES) $(SHOW)'COQDEP $<' - $(HIDE)$(COQDEPBOOT) -slash -boot -I kernel -I tools/coqdoc -c "$<" > "$@" \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) - -## Veerry nasty hack to keep ocamldep happy -%.ml: | %.ml4 - $(SHOW)'TOUCH $@' - $(HIDE)echo "let keep_ocamldep_happy Do_not_compile_me = assert false" > $@ \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + $(HIDE)$(COQDEPBOOT) -slash -I kernel -I tools/coqdoc -c "$<" $(TOTARGET) %.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT) $(GENVFILES) $(SHOW)'COQDEP $<' - $(HIDE)$(COQDEPBOOT) $(DEPNATDYN) -slash -boot "$<" > "$@" \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) + $(HIDE)$(COQDEPBOOT) $(DEPNATDYN) -slash "$<" $(TOTARGET) + +%_stubs.c.d: $(D_DEPEND_BEFORE_SRC) %_stubs.c $(D_DEPEND_AFTER_SRC) + $(SHOW)'CCDEP $<' + $(HIDE)echo "$@ $(@:.c.d=.o): $(@:.c.d=.c)" > $@ %.c.d: $(D_DEPEND_BEFORE_SRC) %.c $(D_DEPEND_AFTER_SRC) $(GENHFILES) $(SHOW)'CCDEP $<' - $(HIDE)$(CC) -MM -MQ "$@" -MQ "$(<:.c=.o)" $(CFLAGS) -isystem $(CAMLHLIB) $< > $@ \ - || ( RV=$$?; rm -f "$@"; exit $${RV} ) - -.SECONDARY: $(GENFILES) + $(HIDE)$(CC) -MM -MQ "$@" -MQ "$(<:.c=.o)" $(CFLAGS) -isystem $(CAMLHLIB) $< $(TOTARGET) ########################################################################### # this sets up developper supporting stuff @@ -900,28 +962,6 @@ devel: $(DEBUGPRINTERS) ########################################################################### -%.types.dot: %.mli - $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -dot-types -o $@ $< - -%.dep.ps: %.dot - $(DOT) $(DOTOPTS) -o $@ $< - -OCAMLDOC_MLLIBD = $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ \ - `cat $| | tr ' ' '\n' | sed -n -e "/\.cmo/s/\.cmo/\.ml/p"` - -%.dot: | %.mllib.d - $(OCAMLDOC_MLLIBD) - -parsing/parsing.dot : | parsing/parsing.mllib.d parsing/highparsing.mllib.d - $(OCAMLDOC_MLLIBD) - -tactics/tactics.dot: | tactics/tactics.mllib.d tactics/hightactics.mllib.d - $(OCAMLDOC_MLLIBD) - -%.dot: %.mli - $(OCAMLDOC) -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -o $@ $< - - # For emacs: # Local Variables: # mode: makefile diff --git a/Makefile.common b/Makefile.common index 46bf2175..b560bae5 100644 --- a/Makefile.common +++ b/Makefile.common @@ -1,4 +1,3 @@ - ####################################################################### # v # The Coq Proof Assistant / The Coq Development Team # # /dev/null;\ ../tools/show_latex_messages -no-overfull Reference-Manual.log) -doc/refman/Reference-Manual.pdf: $(REFMANFILES) doc/refman/Reference-Manual.tex +doc/refman/Reference-Manual.pdf: doc/refman/Reference-Manual.dvi (cd doc/refman;\ $(PDFLATEX) -interaction=batchmode Reference-Manual.tex;\ ../tools/show_latex_messages -no-overfull Reference-Manual.log) @@ -117,14 +123,17 @@ doc/refman/cover.html: doc/common/styles/html/$(HTMLSTYLE)/cover.html doc/refman/styles.hva: doc/common/styles/html/$(HTMLSTYLE)/styles.hva $(INSTALLLIB) $< doc/refman -doc/refman/html/index.html: doc/refman/Reference-Manual.html $(REFMANPNGFILES) \ - doc/refman/cover.html doc/refman/styles.hva doc/refman/index.html +INDEXES:= doc/refman/html/command-index.html doc/refman/html/tactic-index.html +ALLINDEXES:= doc/refman/html/index.html $(INDEXES) + +$(ALLINDEXES): doc/refman/Reference-Manual.html $(REFMANPNGFILES) \ + doc/refman/cover.html doc/refman/styles.hva doc/refman/index.html - rm -rf doc/refman/html $(MKDIR) doc/refman/html $(INSTALLLIB) $(REFMANPNGFILES) doc/refman/html (cd doc/refman/html; hacha -nolinks -tocbis -o toc.html ../styles.hva ../Reference-Manual.html) $(INSTALLLIB) doc/refman/cover.html doc/refman/html/index.html - -$(INSTALLLIB) doc/common/styles/html/$(HTMLSTYLE)/*.css doc/refman/html + $(INSTALLLIB) doc/common/styles/html/$(HTMLSTYLE)/*.css doc/refman/html refman-quick: (cd doc/refman;\ @@ -132,6 +141,14 @@ refman-quick: ../tools/show_latex_messages -no-overfull Reference-Manual.log && \ $(HEVEA) $(HEVEAOPTS) ./Reference-Manual.tex) +###################################################################### +# Index file for CoqIDE +###################################################################### + +$(INDEXURLS): $(INDEXES) + cat $< | grep li-indexenv | grep HREF | sed -e 's@.*\(.*\).*, .*@\1,\2@' > $@ + + ###################################################################### # Tutorial ###################################################################### @@ -183,32 +200,40 @@ doc/faq/html/index.html: doc/faq/FAQ.v.html ### Standard library (browsable html format) ifdef QUICK -doc/stdlib/html/genindex.html: +doc/stdlib/index-body.html: + - rm -rf doc/stdlib/html + $(MKDIR) doc/stdlib/html + $(COQDOC) -q -boot -d doc/stdlib/html --multi-index --html -g --utf8 \ + -R theories Coq $(THEORIESVO:.vo=.v) + mv doc/stdlib/html/index.html doc/stdlib/index-body.html else -doc/stdlib/html/genindex.html: | $(COQDOC) $(THEORIESVO) $(PLUGINSVO) -endif +doc/stdlib/index-body.html: $(COQDOC) $(THEORIESVO) - rm -rf doc/stdlib/html $(MKDIR) doc/stdlib/html - $(COQDOC) -q -d doc/stdlib/html --with-header doc/common/styles/html/$(HTMLSTYLE)/header.html --with-footer doc/common/styles/html/$(HTMLSTYLE)/footer.html --multi-index --html -g \ - -R theories Coq -R plugins Coq $(THEORIESVO:.vo=.v) $(PLUGINSVO:.vo=.v) - mv doc/stdlib/html/index.html doc/stdlib/html/genindex.html + $(COQDOC) -q -boot -d doc/stdlib/html --multi-index --html -g --utf8 \ + -R theories Coq $(THEORIESVO:.vo=.v) + mv doc/stdlib/html/index.html doc/stdlib/index-body.html +endif doc/stdlib/index-list.html: doc/stdlib/index-list.html.template doc/stdlib/make-library-index ./doc/stdlib/make-library-index doc/stdlib/index-list.html -doc/stdlib/html/index.html: doc/stdlib/html/genindex.html doc/stdlib/index-list.html - cat doc/common/styles/html/$(HTMLSTYLE)/header.html doc/stdlib/index-list.html > $@ - cat doc/common/styles/html/$(HTMLSTYLE)/footer.html >> $@ +doc/stdlib/html/index.html: doc/stdlib/index-list.html doc/stdlib/index-body.html doc/stdlib/index-trailer.html + cat doc/stdlib/index-list.html > $@ + sed -n -e '//,/<\/table>/p' doc/stdlib/index-body.html >> $@ + cat doc/stdlib/index-trailer.html >> $@ ### Standard library (light version, full version is definitely too big) ifdef QUICK doc/stdlib/Library.coqdoc.tex: + $(COQDOC) -q -boot --gallina --body-only --latex --stdout --utf8 \ + -R theories Coq $(THEORIESLIGHTVO:.vo=.v) > $@ else -doc/stdlib/Library.coqdoc.tex: | $(COQDOC) $(THEORIESLIGHTVO) +doc/stdlib/Library.coqdoc.tex: $(COQDOC) $(THEORIESLIGHTVO) + $(COQDOC) -q -boot --gallina --body-only --latex --stdout --utf8 \ + -R theories Coq $(THEORIESLIGHTVO:.vo=.v) > $@ endif - $(COQDOC) -q -boot --gallina --body-only --latex --stdout \ - -R theories Coq $(THEORIESLIGHTVO:.vo=.v) >> $@ doc/stdlib/Library.dvi: $(DOCCOMMON) doc/stdlib/Library.coqdoc.tex doc/stdlib/Library.tex (cd doc/stdlib;\ @@ -221,6 +246,34 @@ doc/stdlib/Library.pdf: $(DOCCOMMON) doc/stdlib/Library.coqdoc.tex doc/stdlib/Li $(PDFLATEX) -interaction=batchmode Library;\ ../tools/show_latex_messages -no-overfull Library.log) +### Standard library (full version if you're crazy enouth to try) + +doc/stdlib/FullLibrary.tex: doc/stdlib/Library.tex + sed -e 's/Library.coqdoc/FullLibrary.coqdoc/g;s/\\begin{document}/\\newcommand{\\textlambda}{\\ensuremath{\\lambda}}\\newcommand{\\textPi}{\\ensuremath{\\Pi}}\\begin{document}/' $< > $@ + +ifdef QUICK +doc/stdlib/FullLibrary.coqdoc.tex: + $(COQDOC) -q -boot --gallina --body-only --latex --stdout --utf8 \ + -R theories Coq $(THEORIESVO:.vo=.v) > $@ + sed -i "" -e 's///g' $@ +else +doc/stdlib/FullLibrary.coqdoc.tex: $(COQDOC) $(THEORIESVO) + $(COQDOC) -q -boot --gallina --body-only --latex --stdout --utf8 \ + -R theories Coq $(THEORIESVO:.vo=.v) > $@ + sed -i "" -e 's///g' $@ +endif + +doc/stdlib/FullLibrary.dvi: $(DOCCOMMON) doc/stdlib/FullLibrary.coqdoc.tex doc/stdlib/FullLibrary.tex + (cd doc/stdlib;\ + $(LATEX) -interaction=batchmode FullLibrary;\ + $(LATEX) -interaction=batchmode FullLibrary > /dev/null;\ + ../tools/show_latex_messages -no-overfull FullLibrary.log) + +doc/stdlib/FullLibrary.pdf: $(DOCCOMMON) doc/stdlib/FullLibrary.coqdoc.tex doc/stdlib/FullLibrary.dvi + (cd doc/stdlib;\ + $(PDFLATEX) -interaction=batchmode FullLibrary;\ + ../tools/show_latex_messages -no-overfull FullLibrary.log) + ###################################################################### # Tutorial on inductive types ###################################################################### @@ -241,23 +294,13 @@ doc/RecTutorial/RecTutorial.pdf: doc/common/version.tex doc/common/title.tex doc doc/RecTutorial/RecTutorial.html: doc/RecTutorial/RecTutorial.tex (cd doc/RecTutorial; $(HEVEA) $(HEVEAOPTS) RecTutorial) -###################################################################### -# Index file for CoqIDE -###################################################################### - -# Not robust, improve... -ide/index_urls.txt: doc/refman/html/index.html - @ rm -f doc/refman/html/index_urls.txt - cat doc/refman/html/command-index.html doc/refman/html/tactic-index.html | grep li-indexenv | grep HREF | sed -e 's@.*\(.*\).*, .*@\1,\2@' > doc/refman/html/index_urls.txt - - ###################################################################### # Install all documentation files ###################################################################### -.PHONY: install-doc install-doc-meta install-doc-html install-doc-printable install-doc-index-url +.PHONY: install-doc install-doc-meta install-doc-html install-doc-printable install-doc-index-urls -install-doc: install-doc-meta install-doc-html install-doc-printable install-doc-index-url +install-doc: install-doc-meta install-doc-html install-doc-printable install-doc-index-urls install-doc-meta: $(MKDIR) $(FULLDOCDIR) @@ -284,9 +327,9 @@ install-doc-printable: $(INSTALLLIB) doc/RecTutorial/RecTutorial.ps $(FULLDOCDIR)/ps/RecTutorial.ps $(INSTALLLIB) doc/faq/FAQ.v.ps $(FULLDOCDIR)/ps/FAQ.ps -install-doc-index-url: +install-doc-index-urls: $(MKDIR) $(FULLDOCDIR)/ps $(FULLDOCDIR)/pdf - $(INSTALLLIB) doc/refman/html/index_urls.txt \ + $(INSTALLLIB) $(INDEXURLS) \ $(FULLDOCDIR)/html/refman # For emacs: diff --git a/Makefile.stage1 b/Makefile.stage1 deleted file mode 100644 index a60d388f..00000000 --- a/Makefile.stage1 +++ /dev/null @@ -1,33 +0,0 @@ -####################################################################### -# v # The Coq Proof Assistant / The Coq Development Team # -# = 3.81) + - the GNU make utility The Cygwin environment is well suited for compiling Coq (official packages are made using Cygwin) See: @@ -43,9 +43,9 @@ COMPILATION. make world make install - 5- Though not necessary, you can find useful: + 5- Though not nescessary, you can find useful: - Windows version of (X)Emacs: it is a powerful environment for - developers with colored syntax, modes for compilation and debug, + developpers with coloured syntax, modes for compilation and debug, and many more. It is free. See: http://www.gnu.org/software. - Windows subversion client (very useful if you have access to the Coq archive). diff --git a/TODO b/TODO new file mode 100644 index 00000000..d6891e5f --- /dev/null +++ b/TODO @@ -0,0 +1,53 @@ +Langage: + +Distribution: + +Environnement: + +- Porter SearchIsos + +Noyau: + +Tactic: + +- Que contradiction raisonne a isomorphisme pres de False + +Vernac: + +- Print / Print Proof en fait identiques ; Print ne devrait pas afficher + les constantes opaques (devrait afficher qqchose comme ) + +Theories: + +- Rendre transparent tous les theoremes prouvant {A}+{B} +- Faire demarrer PolyList.nth a` l'indice 0 + Renommer l'actuel nth en nth1 ?? + +Doc: + +- Mettre à jour les messages d'erreurs de Discriminate/Simplify_eq/Injection +- Documenter le filtrage sur les types inductifs avec let-ins (dont la + compatibilite V6) + +- Ajouter let dans les règles du CIC + -> FAIT, mais reste a documenter le let dans les inductifs + et les champs manifestes dans les Record +- revoir le chapitre sur les tactiques utilisateur +- faut-il mieux spécifier la sémantique de Simpl (??) + +- Préciser la clarification syntaxique de IntroPattern +- preciser que Goal vient en dernier dans une clause pattern list et + qu'il doit apparaitre si il y a un "in" + +- Omega Time debranche mais Omega System et Omega Action remarchent ? +- Ajout "Replace in" (mais TODO) +- Syntaxe Conditional tac Rewrite marche, à documenter +- Documenter Dependent Rewrite et CutRewrite ? +- Ajouter les motifs sous-termes de ltac + +- ajouter doc de GenFixpoint (mais avant: changer syntaxe) (J. Forest ou Pierre C.) +- mettre à jour la doc de induction (arguments multiples) (Pierre C.) +- mettre à jour la doc de functional induction/scheme (J. Forest ou Pierre C.) +--> mettre à jour le CHANGES (vers la ligne 72) + + diff --git a/_tags b/_tags index 96776266..6c69011b 100644 --- a/_tags +++ b/_tags @@ -1,16 +1,18 @@ ## tags for binaries - : use_str, use_unix, use_gramlib - : use_unix, use_gramlib + : use_str, use_unix, use_dynlink, use_camlpX + : use_unix, use_dynlink, use_camlpX : use_unix - : use_unix, use_gramlib + : use_unix, use_dynlink, use_camlpX : use_str - : use_str + : use_str, use_unix : use_str - : use_str, use_unix, use_gramlib + : use_str, use_unix, thread, ide + : use_str, use_unix, use_dynlink, use_camlpX : use_nums, use_unix : use_unix + : use_unix ## tags for ide @@ -22,30 +24,9 @@ ## tags for camlp4 files -<**/*.ml4>: is_ml4 - -"toplevel/mltop.ml4": is_mltop, use_macro - -"parsing/lexer.ml4": use_macro -"lib/compat.ml4": use_macro -"lib/refutpat.ml4": use_extend, use_MLast -"parsing/g_xml.ml4": use_extend -"parsing/q_constr.ml4": use_extend, use_MLast -"parsing/argextend.ml4": use_extend, use_MLast -"parsing/tacextend.ml4": use_extend, use_MLast -"parsing/g_prim.ml4": use_extend -"parsing/g_ltac.ml4": use_extend -"parsing/pcoq.ml4": use_extend, use_macro -"parsing/q_util.ml4": use_MLast -"parsing/vernacextend.ml4": use_extend, use_MLast -"parsing/g_constr.ml4": use_extend -"parsing/g_tactic.ml4": use_extend -"parsing/g_proofs.ml4": use_extend -"parsing/q_coqast.ml4": use_MLast, use_macro +"toplevel/mltop.ml4": is_mltop "toplevel/whelp.ml4": use_grammar -"parsing/g_vernac.ml4": use_grammar, use_extend -"parsing/g_decl_mode.ml4": use_grammar, use_extend, use_MLast "tactics/extraargs.ml4": use_grammar "tactics/extratactics.ml4": use_grammar "tactics/class_tactics.ml4": use_grammar @@ -55,8 +36,24 @@ "tactics/hipattern.ml4": use_grammar, use_constr "tactics/rewrite.ml4": use_grammar +"parsing/g_constr.ml4": use_compat5 +"parsing/g_ltac.ml4": use_compat5 +"parsing/g_prim.ml4": use_compat5 +"parsing/g_proofs.ml4": use_compat5 +"parsing/g_tactic.ml4": use_compat5 +"parsing/g_vernac.ml4": use_compat5 +"parsing/g_xml.ml4": use_compat5 +"parsing/pcoq.ml4": use_compat5 +"plugins/decl_mode/g_decl_mode.ml4": use_compat5 +"plugins/funind/g_indfun.ml4": use_compat5 +"plugins/subtac/g_subtac.ml4": use_compat5 + +"parsing/argextend.ml4": use_compat5b +"parsing/q_constr.ml4": use_compat5b +"parsing/tacextend.ml4": use_compat5b +"parsing/vernacextend.ml4": use_compat5b + : use_grammar -"plugins/subtac/g_subtac.ml4": use_extend ## sub-directory inclusion diff --git a/build b/build index 69b47239..c4b90d86 100755 --- a/build +++ b/build @@ -5,6 +5,8 @@ OCAMLBUILD=ocamlbuild CFG=config/coq_config.ml MYCFG=myocamlbuild_config.ml +export CAML_LD_LIBRARY_PATH=`pwd`/_build/kernel/byterun + check_config() { [ -f $CFG ] || (echo "please run ./configure first"; exit 1) [ -L $MYCFG ] || ln -sf $CFG $MYCFG diff --git a/checker/check.ml b/checker/check.ml index 40119a7e..bb42b949 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -1,18 +1,15 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* default_root_prefix | _,l -> anomaly ("Two logical paths are associated to "^phys_dir) -let is_in_load_paths phys_dir = - let dir = canonical_path_name phys_dir in - let lp = get_load_paths () in - let check_p = fun p -> (String.compare dir p) == 0 in - List.exists check_p lp - let remove_load_path dir = load_paths := list_filter2 (fun p d -> p <> dir) !load_paths @@ -191,13 +182,9 @@ let add_load_path (phys_path,coq_path) = load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) | _ -> anomaly ("Two logical paths are associated to "^phys_path) -let physical_paths (dp,lp) = dp - let load_paths_of_dir_path dir = fst (list_filter2 (fun p d -> d = dir) !load_paths) -let get_full_load_paths () = List.combine (fst !load_paths) (snd !load_paths) - (************************************************************************) (*s Locate absolute or partially qualified library names in the path *) @@ -269,8 +256,8 @@ let try_locate_qualified_library qid = (*s Loading from disk to cache (preparation phase) *) -let (raw_extern_library, raw_intern_library) = - System.raw_extern_intern Coq_config.vo_magic_number ".vo" +let raw_intern_library = + snd (System.raw_extern_intern Coq_config.vo_magic_number ".vo") let with_magic_number_check f a = try f a @@ -283,10 +270,10 @@ let with_magic_number_check f a = (************************************************************************) (* Internalise libraries *) -let mk_library md f digest = { +let mk_library md f table digest = { library_name = md.md_name; library_filename = f; - library_compiled = md.md_compiled; + library_compiled = Safe_typing.LightenLibrary.load table md.md_compiled; library_deps = md.md_deps; library_digest = digest } @@ -300,20 +287,21 @@ let depgraph = ref LibraryMap.empty let intern_from_file (dir, f) = Flags.if_verbose msg (str"[intern "++str f++str" ..."); - let (md,digest) = + let (md,table,digest) = try let ch = with_magic_number_check raw_intern_library f in let (md:library_disk) = System.marshal_in ch in let digest = System.marshal_in ch in + let table = (System.marshal_in ch : Safe_typing.LightenLibrary.table) in close_in ch; if dir <> md.md_name then errorlabstrm "load_physical_library" (name_clash_message dir md.md_name f); Flags.if_verbose msgnl(str" done]"); - md,digest + md,table,digest with e -> Flags.if_verbose msgnl(str" failed!]"); raise e in depgraph := LibraryMap.add md.md_name md.md_deps !depgraph; - mk_library md f digest + mk_library md f table digest let get_deps (dir, f) = try LibraryMap.find dir !depgraph diff --git a/checker/check_stat.ml b/checker/check_stat.ml index 88f2374b..5f28269e 100644 --- a/checker/check_stat.ml +++ b/checker/check_stat.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* if f c ce then c::acc else acc) csts [] -let is_ax _ cb = cb.const_body = None +let is_ax _ cb = not (constant_has_body cb) let pr_ax csts = let axs = cst_filter is_ax csts in diff --git a/checker/check_stat.mli b/checker/check_stat.mli index d39eb454..353edda6 100644 --- a/checker/check_stat.mli +++ b/checker/check_stat.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* invalid_arg "dirpath_of_string" + [] -> Check.default_root_prefix | dir -> make_dirpath (List.map id_of_string dir) let path_of_string s = match parse_dir s with - [] -> invalid_arg "dirpath_of_string" + [] -> invalid_arg "path_of_string" | l::dir -> {dirpath=dir; basename=l} let (/) = Filename.concat @@ -73,17 +72,17 @@ let convert_string d = flush_all (); failwith "caught" -let add_rec_path ~unix_path:dir ~coq_root:coq_dirpath = - if exists_dir dir then - let dirs = all_subdirs dir in - let prefix = repr_dirpath coq_dirpath in +let add_rec_path ~unix_path ~coq_root = + if exists_dir unix_path then + let dirs = all_subdirs ~unix_path in + let prefix = repr_dirpath coq_root in let convert_dirs (lp,cp) = (lp,make_dirpath (List.map convert_string (List.rev cp)@prefix)) in let dirs = map_succeed convert_dirs dirs in List.iter Check.add_load_path dirs; - Check.add_load_path (dir,coq_dirpath) + Check.add_load_path (unix_path, coq_root) else - msg_warning (str ("Cannot open " ^ dir)) + msg_warning (str ("Cannot open " ^ unix_path)) (* By the option -include -I or -R of the command line *) let includes = ref [] @@ -92,9 +91,6 @@ let push_rec_include (s, alias) = includes := (s,alias,true) :: !includes let set_default_include d = push_include (d, Check.default_root_prefix) -let set_default_rec_include d = - let p = Check.default_root_prefix in - push_rec_include (d, p) let set_include d p = let p = dirpath_of_string p in push_include (d,p) @@ -106,24 +102,27 @@ let set_rec_include d p = let init_load_path () = let coqlib = Envars.coqlib () in let user_contrib = coqlib/"user-contrib" in + let xdg_dirs = Envars.xdg_dirs in + let coqpath = Envars.coqpath in let plugins = coqlib/"plugins" in - (* first user-contrib *) - if Sys.file_exists user_contrib then - add_rec_path user_contrib Check.default_root_prefix; + (* NOTE: These directories are searched from last to first *) + (* first standard library *) + add_rec_path ~unix_path:(coqlib/"theories") ~coq_root:(Names.make_dirpath[coq_root]); (* then plugins *) - add_rec_path plugins (Names.make_dirpath [coq_root]); - (* then standard library *) -(* List.iter - (fun (s,alias) -> - add_rec_path (coqlib/s) ([alias; coq_root])) - theories_dirs_map;*) - add_rec_path (coqlib/"theories") (Names.make_dirpath[coq_root]); + add_rec_path ~unix_path:plugins ~coq_root:(Names.make_dirpath [coq_root]); + (* then user-contrib *) + if Sys.file_exists user_contrib then + add_rec_path ~unix_path:user_contrib ~coq_root:Check.default_root_prefix; + (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME *) + List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) xdg_dirs; + (* then directories in COQPATH *) + List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) coqpath; (* then current directory *) - add_path "." Check.default_root_prefix; + add_path ~unix_path:"." ~coq_root:Check.default_root_prefix; (* additional loadpath, given with -I -include -R options *) List.iter - (fun (s,alias,reci) -> - if reci then add_rec_path s alias else add_path s alias) + (fun (unix_path, coq_root, reci) -> + if reci then add_rec_path ~unix_path ~coq_root else add_path ~unix_path ~coq_root) (List.rev !includes); includes := [] @@ -168,43 +167,41 @@ let version () = let print_usage_channel co command = output_string co command; - output_string co "Coq options are:\n"; + output_string co "coqchk options are:\n"; output_string co -" -I dir -as coqdir map physical dir to logical coqdir - -I dir map directory dir to the empty logical path - -include dir (idem) - -R dir -as coqdir recursively map physical dir to logical coqdir - -R dir coqdir (idem) - - -admit module load module and dependencies without checking - -norec module check module but admit dependencies without checking - - -where print Coq's standard library location and exit - -v print Coq version and exit - -boot boot mode - -o, --output-context print the list of assumptions - -m, --memoty print the maximum heap size - -silent disable trace of constants being checked - - -impredicative-set set sort Set impredicative - - -h, --help print this list of options -" +" -I dir -as coqdir map physical dir to logical coqdir\ +\n -I dir map directory dir to the empty logical path\ +\n -include dir (idem)\ +\n -R dir -as coqdir recursively map physical dir to logical coqdir\ +\n -R dir coqdir (idem)\ +\n\ +\n -admit module load module and dependencies without checking\ +\n -norec module check module but admit dependencies without checking\ +\n\ +\n -where print coqchk's standard library location and exit\ +\n -v print coqchk version and exit\ +\n -boot boot mode\ +\n -o, --output-context print the list of assumptions\ +\n -m, --memory print the maximum heap size\ +\n -silent disable trace of constants being checked\ +\n\ +\n -impredicative-set set sort Set impredicative\ +\n\ +\n -h, --help print this list of options\ +\n" (* print the usage on standard error *) let print_usage = print_usage_channel stderr let print_usage_coqtop () = - print_usage "Usage: coqchk \n\n" + print_usage "Usage: coqchk modules\n\n" let usage () = print_usage_coqtop (); flush stderr; exit 1 -let warning s = msg_warning (str s) - open Type_errors let anomaly_string () = str "Anomaly: " @@ -239,14 +236,9 @@ let rec explain_exn = function | Anomaly (s,pps) -> hov 1 (anomaly_string () ++ where s ++ pps ++ report ()) | Match_failure(filename,pos1,pos2) -> - hov 1 (anomaly_string () ++ str "Match failure in file " ++ str (guill filename) ++ - if Sys.ocaml_version = "3.06" then - (str " from character " ++ int pos1 ++ - str " to " ++ int pos2) - else - (str " at line " ++ int pos1 ++ - str " character " ++ int pos2) - ++ report ()) + hov 1 (anomaly_string () ++ str "Match failure in file " ++ + str (guill filename) ++ str " at line " ++ int pos1 ++ + str " character " ++ int pos2 ++ report ()) | Not_found -> hov 0 (anomaly_string () ++ str "uncaught exception Not_found" ++ report ()) | Failure s -> @@ -274,22 +266,17 @@ let rec explain_exn = function (* let ctx = Check.get_env() in hov 0 (str "Error:" ++ spc () ++ Himsg.explain_inductive_error ctx e)*) - | Stdpp.Exc_located (loc,exc) -> + | Loc.Exc_located (loc,exc) -> hov 0 ((if loc = dummy_loc then (mt ()) else (str"At location " ++ print_loc loc ++ str":" ++ fnl ())) ++ explain_exn exc) | Assert_failure (s,b,e) -> hov 0 (anomaly_string () ++ str "assert failure" ++ spc () ++ - (if s <> "" then - if Sys.ocaml_version = "3.06" then - (str ("(file \"" ^ s ^ "\", characters ") ++ - int b ++ str "-" ++ int e ++ str ")") - else - (str ("(file \"" ^ s ^ "\", line ") ++ int b ++ - str ", characters " ++ int e ++ str "-" ++ - int (e+6) ++ str ")") - else - (mt ())) ++ + (if s = "" then mt () + else + (str ("(file \"" ^ s ^ "\", line ") ++ int b ++ + str ", characters " ++ int e ++ str "-" ++ + int (e+6) ++ str ")")) ++ report ()) | reraise -> hov 0 (anomaly_string () ++ str "Uncaught exception " ++ @@ -298,8 +285,15 @@ let rec explain_exn = function let parse_args argv = let rec parse = function | [] -> () - | "-impredicative-set" :: rem -> - set_engagement Declarations.ImpredicativeSet; parse rem + | "-impredicative-set" :: rem -> + set_engagement Declarations.ImpredicativeSet; parse rem + + | "-coqlib" :: s :: rem -> + if not (exists_dir s) then + (msgnl (str ("Directory '"^s^"' does not exist")); exit 1); + Flags.coqlib := s; + Flags.coqlib_spec := true; + parse rem | ("-I"|"-include") :: d :: "-as" :: p :: rem -> set_include d p; parse rem | ("-I"|"-include") :: d :: "-as" :: [] -> usage () diff --git a/checker/closure.ml b/checker/closure.ml index da25b3b3..033e2bd7 100644 --- a/checker/closure.ml +++ b/checker/closure.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* red_kind val no_red : reds val red_add : reds -> red_kind -> reds - val red_sub : reds -> red_kind -> reds - val red_add_transparent : reds -> transparent_state -> reds val mkflags : red_kind list -> reds val red_set : reds -> red_kind -> bool - val red_get_const : reds -> bool * evaluable_global_reference list end module RedFlags = (struct @@ -114,21 +112,6 @@ module RedFlags = (struct let (l1,l2) = red.r_const in { red with r_const = Idpred.add id l1, l2 } - let red_sub red = function - | BETA -> { red with r_beta = false } - | DELTA -> { red with r_delta = false } - | CONST kn -> - let (l1,l2) = red.r_const in - { red with r_const = l1, Cpred.remove kn l2 } - | IOTA -> { red with r_iota = false } - | ZETA -> { red with r_zeta = false } - | VAR id -> - let (l1,l2) = red.r_const in - { red with r_const = Idpred.remove id l1, l2 } - - let red_add_transparent red tr = - { red with r_const = tr } - let mkflags = List.fold_left red_add no_red let red_set red = function @@ -146,160 +129,14 @@ module RedFlags = (struct | DELTA -> (* Used for Rel/Var defined in context *) incr_cnt red.r_delta delta - let red_get_const red = - let p1,p2 = red.r_const in - let (b1,l1) = Idpred.elements p1 in - let (b2,l2) = Cpred.elements p2 in - if b1=b2 then - let l1' = List.map (fun x -> EvalVarRef x) l1 in - let l2' = List.map (fun x -> EvalConstRef x) l2 in - (b1, l1' @ l2') - else error "unrepresentable pair of predicate" - end : RedFlagsSig) open RedFlags let betadeltaiota = mkflags [fBETA;fDELTA;fZETA;fIOTA] let betadeltaiotanolet = mkflags [fBETA;fDELTA;fIOTA] -let betaiota = mkflags [fBETA;fIOTA] -let beta = mkflags [fBETA] let betaiotazeta = mkflags [fBETA;fIOTA;fZETA] -let unfold_red kn = - let flag = match kn with - | EvalVarRef id -> fVAR id - | EvalConstRef kn -> fCONST kn - in (* Remove fZETA for finer behaviour ? *) - mkflags [fBETA;flag;fIOTA;fZETA] - -(************************* Obsolète -(* [r_const=(true,cl)] means all constants but those in [cl] *) -(* [r_const=(false,cl)] means only those in [cl] *) -type reds = { - r_beta : bool; - r_const : bool * constant_path list * identifier list; - r_zeta : bool; - r_evar : bool; - r_iota : bool } - -let betadeltaiota_red = { - r_beta = true; - r_const = true,[],[]; - r_zeta = true; - r_evar = true; - r_iota = true } - -let betaiota_red = { - r_beta = true; - r_const = false,[],[]; - r_zeta = false; - r_evar = false; - r_iota = true } - -let beta_red = { - r_beta = true; - r_const = false,[],[]; - r_zeta = false; - r_evar = false; - r_iota = false } - -let no_red = { - r_beta = false; - r_const = false,[],[]; - r_zeta = false; - r_evar = false; - r_iota = false } - -let betaiotazeta_red = { - r_beta = true; - r_const = false,[],[]; - r_zeta = true; - r_evar = false; - r_iota = true } - -let unfold_red kn = - let c = match kn with - | EvalVarRef id -> false,[],[id] - | EvalConstRef kn -> false,[kn],[] - in { - r_beta = true; - r_const = c; - r_zeta = true; (* false for finer behaviour ? *) - r_evar = false; - r_iota = true } - -(* Sets of reduction kinds. - Main rule: delta implies all consts (both global (= by - kernel_name) and local (= by Rel or Var)), all evars, and zeta (= letin's). - Rem: reduction of a Rel/Var bound to a term is Delta, but reduction of - a LetIn expression is Letin reduction *) - -type red_kind = - BETA | DELTA | ZETA | IOTA - | CONST of constant_path list | CONSTBUT of constant_path list - | VAR of identifier | VARBUT of identifier - -let rec red_add red = function - | BETA -> { red with r_beta = true } - | DELTA -> - (match red.r_const with - | _,_::_,[] | _,[],_::_ -> error "Conflict in the reduction flags" - | _ -> { red with r_const = true,[],[]; r_zeta = true; r_evar = true }) - | CONST cl -> - (match red.r_const with - | true,_,_ -> error "Conflict in the reduction flags" - | _,l1,l2 -> { red with r_const = false, list_union cl l1, l2 }) - | CONSTBUT cl -> - (match red.r_const with - | false,_::_,_ | false,_,_::_ -> - error "Conflict in the reduction flags" - | _,l1,l2 -> - { red with r_const = true, list_union cl l1, l2; - r_zeta = true; r_evar = true }) - | IOTA -> { red with r_iota = true } - | ZETA -> { red with r_zeta = true } - | VAR id -> - (match red.r_const with - | true,_,_ -> error "Conflict in the reduction flags" - | _,l1,l2 -> { red with r_const = false, l1, list_union [id] l2 }) - | VARBUT cl -> - (match red.r_const with - | false,_::_,_ | false,_,_::_ -> - error "Conflict in the reduction flags" - | _,l1,l2 -> - { red with r_const = true, l1, list_union [cl] l2; - r_zeta = true; r_evar = true }) - -let red_delta_set red = - let b,_,_ = red.r_const in b - -let red_local_const = red_delta_set - -(* to know if a redex is allowed, only a subset of red_kind is used ... *) -let red_set red = function - | BETA -> incr_cnt red.r_beta beta - | CONST [kn] -> - let (b,l,_) = red.r_const in - let c = List.mem kn l in - incr_cnt ((b & not c) or (c & not b)) delta - | VAR id -> (* En attendant d'avoir des kn pour les Var *) - let (b,_,l) = red.r_const in - let c = List.mem id l in - incr_cnt ((b & not c) or (c & not b)) delta - | ZETA -> incr_cnt red.r_zeta zeta - | EVAR -> incr_cnt red.r_zeta evar - | IOTA -> incr_cnt red.r_iota iota - | DELTA -> red_delta_set red (*Used for Rel/Var defined in context*) - (* Not for internal use *) - | CONST _ | CONSTBUT _ | VAR _ | VARBUT _ -> failwith "not implemented" - -(* Gives the constant list *) -let red_get_const red = - let b,l1,l2 = red.r_const in - let l1' = List.map (fun x -> EvalConstRef x) l1 in - let l2' = List.map (fun x -> EvalVarRef x) l2 in - b, l1' @ l2' -fin obsolète **************) + (* specification of the reduction function *) @@ -336,8 +173,6 @@ type 'a infos = { i_vars : (identifier * constr) list; i_tab : (table_key, 'a) Hashtbl.t } -let info_flags info = info.i_flags - let ref_value_cache info ref = try Some (Hashtbl.find info.i_tab ref) @@ -447,9 +282,6 @@ and fterm = let fterm_of v = v.term let set_norm v = v.norm <- Norm -let is_val v = v.norm = Norm - -let mk_atom c = {norm=Norm;term=FAtom c} (* Could issue a warning if no is still Red, pointing out that we loose sharing. *) @@ -472,7 +304,6 @@ type stack_member = and stack = stack_member list -let empty_stack = [] let append_stack v s = if Array.length v = 0 then s else match s with @@ -486,52 +317,6 @@ let zshift n s = | (_,Zshift(k)::s) -> Zshift(n+k)::s | _ -> Zshift(n)::s -let rec stack_args_size = function - | Zapp v :: s -> Array.length v + stack_args_size s - | Zshift(_)::s -> stack_args_size s - | Zupdate(_)::s -> stack_args_size s - | _ -> 0 - -(* When used as an argument stack (only Zapp can appear) *) -let rec decomp_stack = function - | Zapp v :: s -> - (match Array.length v with - 0 -> decomp_stack s - | 1 -> Some (v.(0), s) - | _ -> - Some (v.(0), (Zapp (Array.sub v 1 (Array.length v - 1)) :: s))) - | _ -> None -let array_of_stack s = - let rec stackrec = function - | [] -> [] - | Zapp args :: s -> args :: (stackrec s) - | _ -> assert false - in Array.concat (stackrec s) -let rec stack_assign s p c = match s with - | Zapp args :: s -> - let q = Array.length args in - if p >= q then - Zapp args :: stack_assign s (p-q) c - else - (let nargs = Array.copy args in - nargs.(p) <- c; - Zapp nargs :: s) - | _ -> s -let rec stack_tail p s = - if p = 0 then s else - match s with - | Zapp args :: s -> - let q = Array.length args in - if p >= q then stack_tail (p-q) s - else Zapp (Array.sub args p (q-p)) :: s - | _ -> failwith "stack_tail" -let rec stack_nth s p = match s with - | Zapp args :: s -> - let q = Array.length args in - if p >= q then stack_nth s (p-q) - else args.(p) - | _ -> raise Not_found - (* Lifting. Preserves sharing (useful only for cell with norm=Red). lft_fconstr always create a new cell, while lift_fconstr avoids it when the lift is 0. *) @@ -643,7 +428,7 @@ let optimise_closure env c = let (c',(_,s)) = compact_constr (0,[]) c 1 in let env' = Array.map (fun i -> clos_rel env i) (Array.of_list s) in - (subs_cons (env', ESID 0),c') + (subs_cons (env', subs_id 0),c') let mk_lambda env t = let (env,t) = optimise_closure env t in @@ -774,7 +559,7 @@ let term_of_fconstr = | FFix(fx,e) when is_subs_id e & is_lift_id lfts -> Fix fx | FCoFix(cfx,e) when is_subs_id e & is_lift_id lfts -> CoFix cfx | _ -> to_constr term_of_fconstr_lift lfts v in - term_of_fconstr_lift ELID + term_of_fconstr_lift el_id @@ -808,16 +593,6 @@ let fapp_stack (m,stk) = zip m stk (strip_update_shift_app), a fix (get_nth_arg) or an abstraction (strip_update_shift, through get_arg). *) -(* optimised for the case where there are no shifts... *) -let strip_update_shift head stk = - assert (head.norm <> Red); - let rec strip_rec h depth = function - | Zshift(k)::s -> strip_rec (lift_fconstr k h) (depth+k) s - | Zupdate(m)::s -> - strip_rec (update m (h.norm,h.term)) depth s - | stk -> (depth,stk) in - strip_rec head 0 stk - (* optimised for the case where there are no shifts... *) let strip_update_shift_app head stk = assert (head.norm <> Red); @@ -835,15 +610,15 @@ let strip_update_shift_app head stk = let get_nth_arg head n stk = assert (head.norm <> Red); - let rec strip_rec rstk h depth n = function + let rec strip_rec rstk h n = function | Zshift(k) as e :: s -> - strip_rec (e::rstk) (lift_fconstr k h) (depth+k) n s + strip_rec (e::rstk) (lift_fconstr k h) n s | Zapp args::s' -> let q = Array.length args in if n >= q then strip_rec (Zapp args::rstk) - {norm=h.norm;term=FApp(h,args)} depth (n-q) s' + {norm=h.norm;term=FApp(h,args)} (n-q) s' else let bef = Array.sub args 0 n in let aft = Array.sub args (n+1) (q-n-1) in @@ -851,9 +626,9 @@ let get_nth_arg head n stk = List.rev (if n = 0 then rstk else (Zapp bef :: rstk)) in (Some (stk', args.(n)), append_stack aft s') | Zupdate(m)::s -> - strip_rec rstk (update m (h.norm,h.term)) depth n s + strip_rec rstk (update m (h.norm,h.term)) n s | s -> (None, List.rev rstk @ s) in - strip_rec [] head 0 n stk + strip_rec [] head n stk (* Beta reduction: look for an applied argument in the stack. Since the encountered update marks are removed, h must be a whnf *) @@ -876,6 +651,12 @@ let rec get_args n tys f e stk = get_args (n-na) etys f (subs_cons(l,e)) s | _ -> (Inr {norm=Cstr;term=FLambda(n,tys,f,e)}, stk) +(* Eta expansion: add a reference to implicit surrounding lambda at end of stack *) +let rec eta_expand_stack = function + | (Zapp _ | Zfix _ | Zcase _ | Zshift _ | Zupdate _ as e) :: s -> + e :: eta_expand_stack s + | [] -> + [Zshift 1; Zapp [|{norm=Norm; term= FRel 1}|]] (* Iota reduction: extract the arguments to be passed to the Case branches *) @@ -1025,7 +806,7 @@ let kh info v stk = fapp_stack(kni info v stk) let whd_val info v = with_stats (lazy (term_of_fconstr (kh info v []))) -let inject = mk_clos (ESID 0) +let inject = mk_clos (subs_id 0) let whd_stack infos m stk = let k = kni infos m stk in diff --git a/checker/closure.mli b/checker/closure.mli index 12cee770..707a51f9 100644 --- a/checker/closure.mli +++ b/checker/closure.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* variable -> bool +val is_transparent_constant : transparent_state -> constant -> bool + (* Sets of reduction kinds. *) module type RedFlagsSig = sig type reds @@ -51,33 +52,20 @@ module type RedFlagsSig = sig (* Adds a reduction kind to a set *) val red_add : reds -> red_kind -> reds - (* Removes a reduction kind to a set *) - val red_sub : reds -> red_kind -> reds - - (* Adds a reduction kind to a set *) - val red_add_transparent : reds -> transparent_state -> reds - (* Build a reduction set from scratch = iter [red_add] on [no_red] *) val mkflags : red_kind list -> reds (* Tests if a reduction kind is set *) val red_set : reds -> red_kind -> bool - - (* Gives the constant list *) - val red_get_const : reds -> bool * evaluable_global_reference list end module RedFlags : RedFlagsSig open RedFlags -val beta : reds -val betaiota : reds val betadeltaiota : reds val betaiotazeta : reds val betadeltaiotanolet : reds -val unfold_red : evaluable_global_reference -> reds - (***********************************************************************) type table_key = | ConstKey of constant @@ -86,7 +74,6 @@ type table_key = type 'a infos val ref_value_cache: 'a infos -> table_key -> 'a option -val info_flags: 'a infos -> reds val create: ('a infos -> constr -> 'a) -> reds -> env -> 'a infos (************************************************************************) @@ -132,23 +119,14 @@ type stack_member = and stack = stack_member list -val empty_stack : stack val append_stack : fconstr array -> stack -> stack - -val decomp_stack : stack -> (fconstr * stack) option -val array_of_stack : stack -> fconstr array -val stack_assign : stack -> int -> fconstr -> stack -val stack_args_size : stack -> int -val stack_tail : int -> stack -> stack -val stack_nth : stack -> int -> fconstr +val eta_expand_stack : stack -> stack (* To lazy reduce a constr, create a [clos_infos] with [create_clos_infos], inject the term to reduce with [inject]; then use a reduction function *) val inject : constr -> fconstr -(* mk_atom: prevents a term from being evaluated *) -val mk_atom : constr -> fconstr val fterm_of : fconstr -> fterm val term_of_fconstr : fconstr -> constr diff --git a/checker/declarations.ml b/checker/declarations.ml index 0deb80a2..890996d1 100644 --- a/checker/declarations.ml +++ b/checker/declarations.ml @@ -20,7 +20,7 @@ type polymorphic_arity = { poly_level : Univ.universe; } let val_pol_arity = - val_tuple"polyorphic_arity"[|val_list(val_opt val_univ);val_univ|] + val_tuple ~name:"polyorphic_arity"[|val_list(val_opt val_univ);val_univ|] type constant_type = | NonPolymorphicType of constr @@ -29,256 +29,164 @@ type constant_type = let val_cst_type = val_sum "constant_type" 0 [|[|val_constr|];[|val_rctxt;val_pol_arity|]|] - -type substitution_domain = - | MBI of mod_bound_id - | MPI of module_path - -let val_subst_dom = - val_sum "substitution_domain" 0 [|[|val_uid|];[|val_mp|]|] - -module Umap = Map.Make(struct - type t = substitution_domain - let compare = Pervasives.compare - end) - +(** Substitutions, code imported from kernel/mod_subst *) type delta_hint = - Inline of constr option + | Inline of int * constr option | Equiv of kernel_name - | Prefix_equiv of module_path - -type delta_key = - KN of kernel_name - | MP of module_path -module Deltamap = Map.Make(struct - type t = delta_key - let compare = Pervasives.compare - end) -type delta_resolver = delta_hint Deltamap.t +module Deltamap = struct + type t = module_path MPmap.t * delta_hint KNmap.t + let empty = MPmap.empty, KNmap.empty + let add_kn kn hint (mm,km) = (mm,KNmap.add kn hint km) + let add_mp mp mp' (mm,km) = (MPmap.add mp mp' mm, km) + let remove_mp mp (mm,km) = (MPmap.remove mp mm, km) + let find_mp mp map = MPmap.find mp (fst map) + let find_kn kn map = KNmap.find kn (snd map) + let mem_mp mp map = MPmap.mem mp (fst map) + let mem_kn kn map = KNmap.mem kn (snd map) + let fold_kn f map i = KNmap.fold f (snd map) i + let fold fmp fkn (mm,km) i = + MPmap.fold fmp mm (KNmap.fold fkn km i) + let join map1 map2 = fold add_mp add_kn map1 map2 +end + +type delta_resolver = Deltamap.t let empty_delta_resolver = Deltamap.empty +module MBImap = Map.Make + (struct + type t = mod_bound_id + let compare = Pervasives.compare + end) + +module Umap = struct + type 'a t = 'a MPmap.t * 'a MBImap.t + let empty = MPmap.empty, MBImap.empty + let is_empty (m1,m2) = MPmap.is_empty m1 && MBImap.is_empty m2 + let add_mbi mbi x (m1,m2) = (m1,MBImap.add mbi x m2) + let add_mp mp x (m1,m2) = (MPmap.add mp x m1, m2) + let find_mp mp map = MPmap.find mp (fst map) + let find_mbi mbi map = MBImap.find mbi (snd map) + let mem_mp mp map = MPmap.mem mp (fst map) + let mem_mbi mbi map = MBImap.mem mbi (snd map) + let iter_mbi f map = MBImap.iter f (snd map) + let fold fmp fmbi (m1,m2) i = + MPmap.fold fmp m1 (MBImap.fold fmbi m2 i) + let join map1 map2 = fold add_mp add_mbi map1 map2 +end + type substitution = (module_path * delta_resolver) Umap.t type 'a subst_fun = substitution -> 'a -> 'a -let val_res_dom = - val_sum "delta_key" 0 [|[|val_kn|];[|val_mp|]|] +let empty_subst = Umap.empty -let val_res = - val_map ~name:"delta_resolver" - val_res_dom - (val_sum "delta_hint" 0 [|[|val_opt val_constr|];[|val_kn|];[|val_mp|]|]) +let is_empty_subst = Umap.is_empty -let val_subst = - val_map ~name:"substitution" - val_subst_dom (val_tuple "substition range" [|val_mp;val_res|]) +let val_delta_hint = + val_sum "delta_hint" 0 + [|[|val_int; val_opt val_constr|];[|val_kn|]|] +let val_res = + val_tuple ~name:"delta_resolver" + [|val_map ~name:"delta_resolver" val_mp val_mp; + val_map ~name:"delta_resolver" val_kn val_delta_hint|] -let fold_subst fb fp = - Umap.fold - (fun k (mp,_) acc -> - match k with - | MBI mbid -> fb mbid mp acc - | MPI mp1 -> fp mp1 mp acc) +let val_mp_res = val_tuple [|val_mp;val_res|] -let empty_subst = Umap.empty +let val_subst = + val_tuple ~name:"substitution" + [|val_map ~name:"substitution" val_mp val_mp_res; + val_map ~name:"substitution" val_uid val_mp_res|] -let add_mbid mbid mp = - Umap.add (MBI mbid) (mp,empty_delta_resolver) -let add_mp mp1 mp2 = - Umap.add (MPI mp1) (mp2,empty_delta_resolver) +let add_mbid mbid mp = Umap.add_mbi mbid (mp,empty_delta_resolver) +let add_mp mp1 mp2 = Umap.add_mp mp1 (mp2,empty_delta_resolver) let map_mbid mbid mp = add_mbid mbid mp empty_subst let map_mp mp1 mp2 = add_mp mp1 mp2 empty_subst -let add_inline_delta_resolver con = - Deltamap.add (KN(user_con con)) (Inline None) - -let add_inline_constr_delta_resolver con cstr = - Deltamap.add (KN(user_con con)) (Inline (Some cstr)) - -let add_constant_delta_resolver con = - Deltamap.add (KN(user_con con)) (Equiv (canonical_con con)) - -let add_mind_delta_resolver mind = - Deltamap.add (KN(user_mind mind)) (Equiv (canonical_mind mind)) - -let add_mp_delta_resolver mp1 mp2 = - Deltamap.add (MP mp1) (Prefix_equiv mp2) - -let mp_in_delta mp = - Deltamap.mem (MP mp) - -let con_in_delta con resolver = -try - match Deltamap.find (KN(user_con con)) resolver with - | Inline _ | Prefix_equiv _ -> false - | Equiv _ -> true -with - Not_found -> false - -let mind_in_delta mind resolver = -try - match Deltamap.find (KN(user_mind mind)) resolver with - | Inline _ | Prefix_equiv _ -> false - | Equiv _ -> true -with - Not_found -> false - -let delta_of_mp resolve mp = - try - match Deltamap.find (MP mp) resolve with - | Prefix_equiv mp1 -> mp1 - | _ -> anomaly "mod_subst: bad association in delta_resolver" - with - Not_found -> mp - -let delta_of_kn resolve kn = - try - match Deltamap.find (KN kn) resolve with - | Equiv kn1 -> kn1 - | Inline _ -> kn - | _ -> anomaly - "mod_subst: bad association in delta_resolver" - with - Not_found -> kn - -let remove_mp_delta_resolver resolver mp = - Deltamap.remove (MP mp) resolver - -exception Inline_kn +let mp_in_delta mp = + Deltamap.mem_mp mp -let rec find_prefix resolve mp = +let rec find_prefix resolve mp = let rec sub_mp = function - | MPdot(mp,l) as mp_sup -> - (try - match Deltamap.find (MP mp_sup) resolve with - | Prefix_equiv mp1 -> mp1 - | _ -> anomaly - "mod_subst: bad association in delta_resolver" - with - Not_found -> MPdot(sub_mp mp,l)) - | p -> - match Deltamap.find (MP p) resolve with - | Prefix_equiv mp1 -> mp1 - | _ -> anomaly - "mod_subst: bad association in delta_resolver" + | MPdot(mp,l) as mp_sup -> + (try Deltamap.find_mp mp_sup resolve + with Not_found -> MPdot(sub_mp mp,l)) + | p -> Deltamap.find_mp p resolve in - try - sub_mp mp - with - Not_found -> mp - + try sub_mp mp with Not_found -> mp + +(** Nota: the following function is slightly different in mod_subst + PL: Is it on purpose ? *) + let solve_delta_kn resolve kn = - try - match Deltamap.find (KN kn) resolve with - | Equiv kn1 -> kn1 - | Inline _ -> raise Inline_kn - | _ -> anomaly - "mod_subst: bad association in delta_resolver" - with - Not_found | Inline_kn -> - let mp,dir,l = repr_kn kn in - let new_mp = find_prefix resolve mp in - if mp == new_mp then - kn - else - make_kn new_mp dir l - + try + match Deltamap.find_kn kn resolve with + | Equiv kn1 -> kn1 + | Inline _ -> raise Not_found + with Not_found -> + let mp,dir,l = repr_kn kn in + let new_mp = find_prefix resolve mp in + if mp == new_mp then + kn + else + make_kn new_mp dir l + +let gen_of_delta resolve x kn fix_can = + try + let new_kn = solve_delta_kn resolve kn in + if kn == new_kn then x else fix_can new_kn + with _ -> x let constant_of_delta resolve con = let kn = user_con con in - let new_kn = solve_delta_kn resolve kn in - if kn == new_kn then - con - else - constant_of_kn_equiv kn new_kn - + gen_of_delta resolve con kn (constant_of_kn_equiv kn) + let constant_of_delta2 resolve con = - let kn = canonical_con con in - let kn1 = user_con con in - let new_kn = solve_delta_kn resolve kn in - if kn == new_kn then - con - else - constant_of_kn_equiv kn1 new_kn + let kn, kn' = canonical_con con, user_con con in + gen_of_delta resolve con kn (constant_of_kn_equiv kn') let mind_of_delta resolve mind = let kn = user_mind mind in - let new_kn = solve_delta_kn resolve kn in - if kn == new_kn then - mind - else - mind_of_kn_equiv kn new_kn - -let mind_of_delta2 resolve mind = - let kn = canonical_mind mind in - let kn1 = user_mind mind in - let new_kn = solve_delta_kn resolve kn in - if kn == new_kn then - mind - else - mind_of_kn_equiv kn1 new_kn - + gen_of_delta resolve mind kn (mind_of_kn_equiv kn) +let mind_of_delta2 resolve mind = + let kn, kn' = canonical_mind mind, user_mind mind in + gen_of_delta resolve mind kn (mind_of_kn_equiv kn') -let inline_of_delta resolver = - let extract key hint l = - match key,hint with - |KN kn, Inline _ -> kn::l - | _,_ -> l - in - Deltamap.fold extract resolver [] +let find_inline_of_delta kn resolve = + match Deltamap.find_kn kn resolve with + | Inline (_,o) -> o + | _ -> raise Not_found -exception Not_inline - let constant_of_delta_with_inline resolve con = let kn1,kn2 = canonical_con con,user_con con in - try - match Deltamap.find (KN kn2) resolve with - | Inline None -> None - | Inline (Some const) -> Some const - | _ -> raise Not_inline - with - Not_found | Not_inline -> - try match Deltamap.find (KN kn1) resolve with - | Inline None -> None - | Inline (Some const) -> Some const - | _ -> raise Not_inline - with - Not_found | Not_inline -> None + try find_inline_of_delta kn2 resolve + with Not_found -> + try find_inline_of_delta kn1 resolve + with Not_found -> None let subst_mp0 sub mp = (* 's like subst *) let rec aux mp = match mp with - | MPfile sid -> - let mp',resolve = Umap.find (MPI (MPfile sid)) sub in - mp',resolve + | MPfile sid -> Umap.find_mp mp sub | MPbound bid -> begin - try - let mp',resolve = Umap.find (MBI bid) sub in - mp',resolve - with Not_found -> - let mp',resolve = Umap.find (MPI mp) sub in - mp',resolve + try Umap.find_mbi bid sub + with Not_found -> Umap.find_mp mp sub end | MPdot (mp1,l) as mp2 -> begin - try - let mp',resolve = Umap.find (MPI mp2) sub in - mp',resolve + try Umap.find_mp mp2 sub with Not_found -> let mp1',resolve = aux mp1 in - MPdot (mp1',l),resolve + MPdot (mp1',l),resolve end in - try - Some (aux mp) - with Not_found -> None + try Some (aux mp) with Not_found -> None let subst_mp sub mp = match subst_mp0 sub mp with @@ -305,127 +213,58 @@ type sideconstantsubst = | User | Canonical + +let gen_subst_mp f sub mp1 mp2 = + match subst_mp0 sub mp1, subst_mp0 sub mp2 with + | None, None -> raise No_subst + | Some (mp',resolve), None -> User, (f mp' mp2), resolve + | None, Some (mp',resolve) -> Canonical, (f mp1 mp'), resolve + | Some (mp1',_), Some (mp2',resolve2) -> Canonical, (f mp1' mp2'), resolve2 + let subst_ind sub mind = - let kn1,kn2 = user_mind mind,canonical_mind mind in + let kn1,kn2 = user_mind mind, canonical_mind mind in let mp1,dir,l = repr_kn kn1 in let mp2,_,_ = repr_kn kn2 in - try - let side,mind',resolve = - match subst_mp0 sub mp1,subst_mp0 sub mp2 with - None,None ->raise No_subst - | Some (mp',resolve),None -> User,(make_mind_equiv mp' mp2 dir l), resolve - | None, Some(mp',resolve)-> Canonical,(make_mind_equiv mp1 mp' dir l), resolve - | Some(mp1',resolve1),Some(mp2',resolve2)->Canonical, - (make_mind_equiv mp1' mp2' dir l), resolve2 - in - match side with - |User -> - let mind = mind_of_delta resolve mind' in - mind - |Canonical -> - let mind = mind_of_delta2 resolve mind' in - mind - with - No_subst -> mind - -let subst_mind0 sub mind = - let kn1,kn2 = user_mind mind,canonical_mind mind in - let mp1,dir,l = repr_kn kn1 in - let mp2,_,_ = repr_kn kn2 in - try - let side,mind',resolve = - match subst_mp0 sub mp1,subst_mp0 sub mp2 with - None,None ->raise No_subst - | Some (mp',resolve),None -> User,(make_mind_equiv mp' mp2 dir l), resolve - | None, Some(mp',resolve)-> Canonical,(make_mind_equiv mp1 mp' dir l), resolve - | Some(mp1',resolve1),Some(mp2',resolve2)->Canonical, - (make_mind_equiv mp1' mp2' dir l), resolve2 - in - match side with - |User -> - let mind = mind_of_delta resolve mind' in - Some mind - |Canonical -> - let mind = mind_of_delta2 resolve mind' in - Some mind - with - No_subst -> Some mind - -let subst_con sub con = - let kn1,kn2 = user_con con,canonical_con con in - let mp1,dir,l = repr_kn kn1 in - let mp2,_,_ = repr_kn kn2 in - try - let side,con',resolve = - match subst_mp0 sub mp1,subst_mp0 sub mp2 with - None,None ->raise No_subst - | Some (mp',resolve),None -> User,(make_con_equiv mp' mp2 dir l), resolve - | None, Some(mp',resolve)-> Canonical,(make_con_equiv mp1 mp' dir l), resolve - | Some(mp1',resolve1),Some(mp2',resolve2)->Canonical, - (make_con_equiv mp1' mp2' dir l), resolve2 - in - match constant_of_delta_with_inline resolve con' with - None -> begin - match side with - |User -> - let con = constant_of_delta resolve con' in - con,Const con - |Canonical -> - let con = constant_of_delta2 resolve con' in - con,Const con - end - | Some t -> con',t - with No_subst -> con , Const con - + let rebuild_mind mp1 mp2 = make_mind_equiv mp1 mp2 dir l in + try + let side,mind',resolve = gen_subst_mp rebuild_mind sub mp1 mp2 in + match side with + | User -> mind_of_delta resolve mind' + | Canonical -> mind_of_delta2 resolve mind' + with No_subst -> mind let subst_con0 sub con = let kn1,kn2 = user_con con,canonical_con con in let mp1,dir,l = repr_kn kn1 in let mp2,_,_ = repr_kn kn2 in - try - let side,con',resolve = - match subst_mp0 sub mp1,subst_mp0 sub mp2 with - None,None ->raise No_subst - | Some (mp',resolve),None -> User,(make_con_equiv mp' mp2 dir l), resolve - | None, Some(mp',resolve)-> Canonical,(make_con_equiv mp1 mp' dir l), resolve - | Some(mp1',resolve1),Some(mp2',resolve2)->Canonical, - (make_con_equiv mp1' mp2' dir l), resolve2 + let rebuild_con mp1 mp2 = make_con_equiv mp1 mp2 dir l in + let dup con = con, Const con in + let side,con',resolve = gen_subst_mp rebuild_con sub mp1 mp2 in + match constant_of_delta_with_inline resolve con' with + | Some t -> con', t + | None -> + let con'' = match side with + | User -> constant_of_delta resolve con' + | Canonical -> constant_of_delta2 resolve con' in - match constant_of_delta_with_inline resolve con' with - None ->begin - match side with - |User -> - let con = constant_of_delta resolve con' in - Some (Const con) - |Canonical -> - let con = constant_of_delta2 resolve con' in - Some (Const con) - end - | t -> t - with No_subst -> Some (Const con) - + if con'' == con then raise No_subst else dup con'' let rec map_kn f f' c = let func = map_kn f f' in match c with - | Const kn -> - (match f' kn with - None -> c - | Some const ->const) + | Const kn -> (try snd (f' kn) with No_subst -> c) | Ind (kn,i) -> - (match f kn with - None -> c - | Some kn' -> - Ind (kn',i)) + let kn' = f kn in + if kn'==kn then c else Ind (kn',i) | Construct ((kn,i),j) -> - (match f kn with - None -> c - | Some kn' -> - Construct ((kn',i),j)) + let kn' = f kn in + if kn'==kn then c else Construct ((kn',i),j) | Case (ci,p,ct,l) -> let ci_ind = let (kn,i) = ci.ci_ind in - (match f kn with None -> ci.ci_ind | Some kn' -> kn',i ) in + let kn' = f kn in + if kn'==kn then ci.ci_ind else kn',i + in let p' = func p in let ct' = func ct in let l' = array_smartmap func l in @@ -476,8 +315,9 @@ let rec map_kn f f' c = else CoFix (ln,(lna,tl',bl')) | _ -> c -let subst_mps sub = - map_kn (subst_mind0 sub) (subst_con0 sub) +let subst_mps sub c = + if is_empty_subst sub then c + else map_kn (subst_ind sub) (subst_con0 sub) c type 'a lazy_subst = @@ -507,125 +347,113 @@ let rec mp_in_mp mp mp1 = | _ when mp1 = mp -> true | MPdot (mp2,l) -> mp_in_mp mp mp2 | _ -> false - -let mp_in_key mp key = - match key with - | MP mp1 -> - mp_in_mp mp mp1 - | KN kn -> - let mp1,dir,l = repr_kn kn in - mp_in_mp mp mp1 - + let subset_prefixed_by mp resolver = - let prefixmp key hint resolv = - if mp_in_key mp key then - Deltamap.add key hint resolv - else - resolv + let mp_prefix mkey mequ rslv = + if mp_in_mp mp mkey then Deltamap.add_mp mkey mequ rslv else rslv + in + let kn_prefix kn hint rslv = + match hint with + | Inline _ -> rslv + | Equiv _ -> + if mp_in_mp mp (modpath kn) then Deltamap.add_kn kn hint rslv else rslv in - Deltamap.fold prefixmp resolver empty_delta_resolver + Deltamap.fold mp_prefix kn_prefix resolver empty_delta_resolver let subst_dom_delta_resolver subst resolver = - let apply_subst key hint resolver = - match key with - (MP mp) -> - Deltamap.add (MP (subst_mp subst mp)) hint resolver - | (KN kn) -> - Deltamap.add (KN (subst_kn subst kn)) hint resolver + let mp_apply_subst mkey mequ rslv = + Deltamap.add_mp (subst_mp subst mkey) mequ rslv in - Deltamap.fold apply_subst resolver empty_delta_resolver + let kn_apply_subst kkey hint rslv = + Deltamap.add_kn (subst_kn subst kkey) hint rslv + in + Deltamap.fold mp_apply_subst kn_apply_subst resolver empty_delta_resolver -let subst_mp_delta sub mp key= +let subst_mp_delta sub mp mkey = match subst_mp0 sub mp with None -> empty_delta_resolver,mp - | Some (mp',resolve) -> + | Some (mp',resolve) -> let mp1 = find_prefix resolve mp' in let resolve1 = subset_prefixed_by mp1 resolve in - match key with - MP mpk -> - (subst_dom_delta_resolver - (map_mp mp1 mpk) resolve1),mp1 - | _ -> anomaly "Mod_subst: Bad association in resolver" - -let subst_codom_delta_resolver subst resolver = - let apply_subst key hint resolver = - match hint with - Prefix_equiv mp -> - let derived_resolve,mpnew = subst_mp_delta subst mp key in - Deltamap.fold Deltamap.add derived_resolve - (Deltamap.add key (Prefix_equiv mpnew) resolver) - | (Equiv kn) -> - Deltamap.add key (Equiv (subst_kn_delta subst kn)) resolver - | Inline None -> - Deltamap.add key hint resolver - | Inline (Some t) -> - Deltamap.add key (Inline (Some (subst_mps subst t))) resolver + (subst_dom_delta_resolver + (map_mp mp1 mkey) resolve1),mp1 + +let gen_subst_delta_resolver dom subst resolver = + let mp_apply_subst mkey mequ rslv = + let mkey' = if dom then subst_mp subst mkey else mkey in + let rslv',mequ' = subst_mp_delta subst mequ mkey in + Deltamap.join rslv' (Deltamap.add_mp mkey' mequ' rslv) in - Deltamap.fold apply_subst resolver empty_delta_resolver + let kn_apply_subst kkey hint rslv = + let kkey' = if dom then subst_kn subst kkey else kkey in + let hint' = match hint with + | Equiv kequ -> Equiv (subst_kn_delta subst kequ) + | Inline (lev,Some t) -> Inline (lev,Some (subst_mps subst t)) + | Inline (_,None) -> hint + in + Deltamap.add_kn kkey' hint' rslv + in + Deltamap.fold mp_apply_subst kn_apply_subst resolver empty_delta_resolver + +let subst_codom_delta_resolver = gen_subst_delta_resolver false +let subst_dom_codom_delta_resolver = gen_subst_delta_resolver true -let subst_dom_codom_delta_resolver subst resolver = - subst_dom_delta_resolver subst - (subst_codom_delta_resolver subst resolver) - let update_delta_resolver resolver1 resolver2 = - let apply_res key hint res = - try - match hint with - Prefix_equiv mp -> - let new_hint = - Prefix_equiv (find_prefix resolver2 mp) - in Deltamap.add key new_hint res - | Equiv kn -> - let new_hint = - Equiv (solve_delta_kn resolver2 kn) - in Deltamap.add key new_hint res - | _ -> Deltamap.add key hint res - with Not_found -> - Deltamap.add key hint res - in - Deltamap.fold apply_res resolver1 empty_delta_resolver + let mp_apply_rslv mkey mequ rslv = + if Deltamap.mem_mp mkey resolver2 then rslv + else Deltamap.add_mp mkey (find_prefix resolver2 mequ) rslv + in + let kn_apply_rslv kkey hint rslv = + if Deltamap.mem_kn kkey resolver2 then rslv + else + let hint' = match hint with + | Equiv kequ -> Equiv (solve_delta_kn resolver2 kequ) + | _ -> hint + in + Deltamap.add_kn kkey hint' rslv + in + Deltamap.fold mp_apply_rslv kn_apply_rslv resolver1 empty_delta_resolver let add_delta_resolver resolver1 resolver2 = if resolver1 == resolver2 then resolver2 + else if resolver2 = empty_delta_resolver then + resolver1 else - Deltamap.fold Deltamap.add (update_delta_resolver resolver1 resolver2) - resolver2 + Deltamap.join (update_delta_resolver resolver1 resolver2) resolver2 let substition_prefixed_by k mp subst = - let prefixmp key (mp_to,reso) sub = - match key with - | MPI mpk -> - if mp_in_mp mp mpk && mp <> mpk then - let new_key = replace_mp_in_mp mp k mpk in - Umap.add (MPI new_key) (mp_to,reso) sub - else - sub - | _ -> sub + let mp_prefixmp kmp (mp_to,reso) sub = + if mp_in_mp mp kmp && mp <> kmp then + let new_key = replace_mp_in_mp mp k kmp in + Umap.add_mp new_key (mp_to,reso) sub + else sub + in + let mbi_prefixmp mbi _ sub = sub in - Umap.fold prefixmp subst empty_subst + Umap.fold mp_prefixmp mbi_prefixmp subst empty_subst -let join (subst1 : substitution) (subst2 : substitution) = - let apply_subst key (mp,resolve) res = +let join subst1 subst2 = + let apply_subst mpk add (mp,resolve) res = let mp',resolve' = match subst_mp0 subst2 mp with - None -> mp, None - | Some (mp',resolve') -> mp' - ,Some resolve' in - let resolve'' : delta_resolver = + | None -> mp, None + | Some (mp',resolve') -> mp', Some resolve' in + let resolve'' = match resolve' with - Some res -> - add_delta_resolver + | Some res -> + add_delta_resolver (subst_dom_codom_delta_resolver subst2 resolve) res - | None -> + | None -> subst_codom_delta_resolver subst2 resolve in - let k = match key with MBI mp -> MPbound mp | MPI mp -> mp in - let prefixed_subst = substition_prefixed_by k mp subst2 in - Umap.fold Umap.add prefixed_subst - (Umap.add key (mp',resolve'') res) in - let subst = Umap.fold apply_subst subst1 empty_subst in - (Umap.fold Umap.add subst2 subst) + let prefixed_subst = substition_prefixed_by mpk mp' subst2 in + Umap.join prefixed_subst (add (mp',resolve'') res) + in + let mp_apply_subst mp = apply_subst mp (Umap.add_mp mp) in + let mbi_apply_subst mbi = apply_subst (MPbound mbi) (Umap.add_mbi mbi) in + let subst = Umap.fold mp_apply_subst mbi_apply_subst subst1 empty_subst in + Umap.join subst2 subst let force fsubst r = match !r with @@ -650,25 +478,67 @@ let val_cstr_subst = val_substituted val_constr let subst_constr_subst = subst_substituted +(** Beware! In .vo files, lazy_constr are stored as integers + used as indexes for a separate table. The actual lazy_constr is restored + later, by [Safe_typing.LightenLibrary.load]. This allows us + to use here a different definition of lazy_constr than coqtop: + since the checker will inspect all proofs parts, even opaque + ones, no need to use Lazy.t here *) + +type lazy_constr = constr_substituted +let subst_lazy_constr = subst_substituted +let force_lazy_constr = force_constr +let lazy_constr_from_val c = c +let val_lazy_constr = val_cstr_subst + +(** Inlining level of parameters at functor applications. + This is ignored by the checker. *) + +type inline = int option + +(** A constant can have no body (axiom/parameter), or a + transparent body, or an opaque one *) + +type constant_def = + | Undef of inline + | Def of constr_substituted + | OpaqueDef of lazy_constr + +let val_cst_def = + val_sum "constant_def" 0 + [|[|val_opt val_int|]; [|val_cstr_subst|]; [|val_lazy_constr|]|] + +let subst_constant_def sub = function + | Undef inl -> Undef inl + | Def c -> Def (subst_constr_subst sub c) + | OpaqueDef lc -> OpaqueDef (subst_lazy_constr sub lc) + type constant_body = { const_hyps : section_context; (* New: younger hyp at top *) - const_body : constr_substituted option; + const_body : constant_def; const_type : constant_type; const_body_code : to_patch_substituted; - (* const_type_code : Cemitcodes.to_patch; *) - const_constraints : Univ.constraints; - const_opaque : bool; - const_inline : bool} + const_constraints : Univ.constraints } -let val_cb = val_tuple "constant_body" +let body_of_constant cb = match cb.const_body with + | Undef _ -> None + | Def c -> Some c + | OpaqueDef c -> Some c + +let constant_has_body cb = match cb.const_body with + | Undef _ -> false + | Def _ | OpaqueDef _ -> true + +let is_opaque cb = match cb.const_body with + | OpaqueDef _ -> true + | Def _ | Undef _ -> false + +let val_cb = val_tuple ~name:"constant_body" [|val_nctxt; - val_opt val_cstr_subst; + val_cst_def; val_cst_type; no_val; - val_cstrs; - val_bool; - val_bool |] - + val_cstrs|] let subst_rel_declaration sub (id,copt,t as x) = let copt' = Option.smartmap (subst_mps sub) copt in @@ -679,14 +549,14 @@ let subst_rel_context sub = list_smartmap (subst_rel_declaration sub) type recarg = | Norec - | Mrec of int + | Mrec of inductive | Imbr of inductive let val_recarg = val_sum "recarg" 1 (* Norec *) - [|[|val_int|] (* Mrec *);[|val_ind|] (* Imbr *)|] + [|[|val_ind|] (* Mrec *);[|val_ind|] (* Imbr *)|] let subst_recarg sub r = match r with - | Norec | Mrec _ -> r - | Imbr (kn,i) -> let kn' = subst_ind sub kn in + | Norec -> r + | (Mrec(kn,i)|Imbr (kn,i)) -> let kn' = subst_ind sub kn in if kn==kn' then r else Imbr (kn',i) type wf_paths = recarg Rtree.t @@ -724,7 +594,7 @@ type monomorphic_inductive_arity = { mind_sort : sorts; } let val_mono_ind_arity = - val_tuple"monomorphic_inductive_arity"[|val_constr;val_sort|] + val_tuple ~name:"monomorphic_inductive_arity"[|val_constr;val_sort|] type inductive_arity = | Monomorphic of monomorphic_inductive_arity @@ -784,7 +654,7 @@ type one_inductive_body = { mind_reloc_tbl : reloc_table; } -let val_one_ind = val_tuple "one_inductive_body" +let val_one_ind = val_tuple ~name:"one_inductive_body" [|val_id;val_rctxt;val_ind_arity;val_array val_id;val_array val_constr; val_int;val_int;val_list val_sortfam;val_array val_constr;val_array val_int; val_wfp;val_int;val_int;no_val|] @@ -820,7 +690,7 @@ type mutual_inductive_body = { mind_constraints : Univ.constraints; } -let val_ind_pack = val_tuple "mutual_inductive_body" +let val_ind_pack = val_tuple ~name:"mutual_inductive_body" [|val_array val_one_ind;val_bool;val_bool;val_int;val_nctxt; val_int; val_int; val_rctxt;val_cstrs|] @@ -832,13 +702,10 @@ let subst_arity sub = function (* TODO: should be changed to non-coping after Term.subst_mps *) let subst_const_body sub cb = { const_hyps = (assert (cb.const_hyps=[]); []); - const_body = Option.map (subst_constr_subst sub) cb.const_body; + const_body = subst_constant_def sub cb.const_body; const_type = subst_arity sub cb.const_type; const_body_code = (*Cemitcodes.subst_to_patch_subst sub*) cb.const_body_code; - (*const_type_code = Cemitcodes.subst_to_patch sub cb.const_type_code;*) - const_constraints = cb.const_constraints; - const_opaque = cb.const_opaque; - const_inline = cb.const_inline} + const_constraints = cb.const_constraints} let subst_arity sub = function | Monomorphic s -> @@ -923,7 +790,7 @@ let rec val_sfb o = val_sum "struct_field_body" 0 [|val_module|]; (* SFBmodule *) [|val_modtype|] (* SFBmodtype *) |] o -and val_sb o = val_list (val_tuple"label*sfb"[|val_id;val_sfb|]) o +and val_sb o = val_list (val_tuple ~name:"label*sfb"[|val_id;val_sfb|]) o and val_seb o = val_sum "struct_expr_body" 0 [|[|val_mp|]; (* SEBident *) [|val_uid;val_modtype;val_seb|]; (* SEBfunctor *) @@ -934,10 +801,10 @@ and val_seb o = val_sum "struct_expr_body" 0 and val_with o = val_sum "with_declaration_body" 0 [|[|val_list val_id;val_mp|]; [|val_list val_id;val_cb|]|] o -and val_module o = val_tuple "module_body" +and val_module o = val_tuple ~name:"module_body" [|val_mp;val_opt val_seb;val_seb; val_opt val_seb;val_cstrs;val_res;no_val|] o -and val_modtype o = val_tuple "module_type_body" +and val_modtype o = val_tuple ~name:"module_type_body" [|val_mp;val_seb;val_opt val_seb;val_cstrs;val_res|] o diff --git a/checker/declarations.mli b/checker/declarations.mli index b39fd6f2..90beb326 100644 --- a/checker/declarations.mli +++ b/checker/declarations.mli @@ -29,26 +29,53 @@ type constr_substituted val force_constr : constr_substituted -> constr val from_val : constr -> constr_substituted +(** Beware! In .vo files, lazy_constr are stored as integers + used as indexes for a separate table. The actual lazy_constr is restored + later, by [Safe_typing.LightenLibrary.load]. This allows us + to use here a different definition of lazy_constr than coqtop: + since the checker will inspect all proofs parts, even opaque + ones, no need to use Lazy.t here *) + +type lazy_constr +val force_lazy_constr : lazy_constr -> constr +val lazy_constr_from_val : constr_substituted -> lazy_constr + +(** Inlining level of parameters at functor applications. + This is ignored by the checker. *) + +type inline = int option + +(** A constant can have no body (axiom/parameter), or a + transparent body, or an opaque one *) + +type constant_def = + | Undef of inline + | Def of constr_substituted + | OpaqueDef of lazy_constr + type constant_body = { const_hyps : section_context; (* New: younger hyp at top *) - const_body : constr_substituted option; + const_body : constant_def; const_type : constant_type; const_body_code : to_patch_substituted; - const_constraints : Univ.constraints; - const_opaque : bool; - const_inline : bool} + const_constraints : Univ.constraints } + +val body_of_constant : constant_body -> constr_substituted option +val constant_has_body : constant_body -> bool +val is_opaque : constant_body -> bool (* Mutual inductives *) type recarg = | Norec - | Mrec of int + | Mrec of inductive | Imbr of inductive type wf_paths = recarg Rtree.t val mk_norec : wf_paths val mk_paths : recarg -> wf_paths list array -> wf_paths +val dest_recarg : wf_paths -> recarg val dest_subterms : wf_paths -> wf_paths list array type monomorphic_inductive_arity = { @@ -186,11 +213,6 @@ and module_type_body = (* Substitutions *) -val fold_subst : - (mod_bound_id -> module_path -> 'a -> 'a) -> - (module_path -> module_path -> 'a -> 'a) -> - substitution -> 'a -> 'a - type 'a subst_fun = substitution -> 'a -> 'a val empty_subst : substitution @@ -211,6 +233,6 @@ val subst_module : substitution -> module_body -> module_body val join : substitution -> substitution -> substitution (* Validation *) -val val_eng : Obj.t -> unit -val val_module : Obj.t -> unit -val val_modtype : Obj.t -> unit +val val_eng : Validate.func +val val_module : Validate.func +val val_modtype : Validate.func diff --git a/checker/environ.ml b/checker/environ.ml index f7dd46f8..99b36457 100644 --- a/checker/environ.ml +++ b/checker/environ.ml @@ -98,7 +98,7 @@ let named_type id env = (* Universe constraints *) let add_constraints c env = - if c == Constraint.empty then + if c == empty_constraint then env else let s = env.env_stratification in @@ -121,25 +121,16 @@ let add_constant kn cs env = env_constants = new_constants } in { env with env_globals = new_globals } -(* constant_type gives the type of a constant *) -let constant_type env kn = - let cb = lookup_constant kn env in - cb.const_type - type const_evaluation_result = NoBody | Opaque exception NotEvaluableConst of const_evaluation_result let constant_value env kn = let cb = lookup_constant kn env in - if cb.const_opaque then raise (NotEvaluableConst Opaque); match cb.const_body with - | Some l_body -> force_constr l_body - | None -> raise (NotEvaluableConst NoBody) - -let constant_opt_value env cst = - try Some (constant_value env cst) - with NotEvaluableConst _ -> None + | Def l_body -> force_constr l_body + | OpaqueDef _ -> raise (NotEvaluableConst Opaque) + | Undef _ -> raise (NotEvaluableConst NoBody) (* A global const is evaluable if it is defined and not opaque *) let evaluable_constant cst env = diff --git a/checker/environ.mli b/checker/environ.mli index ea446cdb..628febbb 100644 --- a/checker/environ.mli +++ b/checker/environ.mli @@ -50,11 +50,9 @@ val add_constraints : Univ.constraints -> env -> env (* Constants *) val lookup_constant : constant -> env -> Declarations.constant_body val add_constant : constant -> Declarations.constant_body -> env -> env -val constant_type : env -> constant -> Declarations.constant_type type const_evaluation_result = NoBody | Opaque exception NotEvaluableConst of const_evaluation_result val constant_value : env -> constant -> constr -val constant_opt_value : env -> constant -> constr option val evaluable_constant : constant -> env -> bool (* Inductives *) diff --git a/checker/indtypes.ml b/checker/indtypes.ml index 277fed30..1e773df6 100644 --- a/checker/indtypes.ml +++ b/checker/indtypes.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* let u' = fresh_local_univ () in let cst = - merge_constraints (enforce_geq u' u Constraint.empty) + merge_constraints (enforce_geq u' u empty_constraint) (universes env) in if not (check_geq cst u' level) then failwith "impredicative Type inductive type" @@ -394,7 +392,7 @@ let rec ienv_decompose_prod (env,_,_,_ as ienv) n c = (* The recursive function that checks positivity and builds the list of recursive arguments *) -let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp i indlc = +let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp (_,i as ind) indlc = let lparams = rel_context_length hyps in (* check the inductive types occur positively in [c] *) let rec check_pos (env, n, ntypes, ra_env as ienv) c = @@ -496,7 +494,7 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp i indlc = with IllFormedInd err -> explain_ind_err (ntypes-i) env lparams c err) indlc - in mk_paths (Mrec i) irecargs + in mk_paths (Mrec ind) irecargs let check_subtree (t1:'a) (t2:'a) = if not (Rtree.compare_rtree (fun t1 t2 -> @@ -507,16 +505,17 @@ let check_subtree (t1:'a) (t2:'a) = failwith "bad recursive trees" (* if t1=t2 then () else msg_warning (str"TODO: check recursive positions")*) -let check_positivity env_ar params nrecp inds = +let check_positivity env_ar mind params nrecp inds = let ntypes = Array.length inds in - let rc = Array.mapi (fun j t -> (Mrec j,t)) (Rtree.mk_rec_calls ntypes) in + let rc = + Array.mapi (fun j t -> (Mrec(mind,j),t)) (Rtree.mk_rec_calls ntypes) in let lra_ind = List.rev (Array.to_list rc) in let lparams = rel_context_length params in let check_one i mip = let ra_env = list_tabulate (fun _ -> (Norec,mk_norec)) lparams @ lra_ind in let ienv = (env_ar, 1+lparams, ntypes, ra_env) in - check_positivity_one ienv params nrecp i mip.mind_nf_lc + check_positivity_one ienv params nrecp (mind,i) mip.mind_nf_lc in let irecargs = Array.mapi check_one inds in let wfp = Rtree.mk_rec irecargs in @@ -549,7 +548,7 @@ let check_inductive env kn mib = (* - check constructor types *) Array.iter (typecheck_one_inductive env_ar params mib) mib.mind_packets; (* check mind_nparams_rec: positivity condition *) - check_positivity env_ar params mib.mind_nparams_rec mib.mind_packets; + check_positivity env_ar kn params mib.mind_nparams_rec mib.mind_packets; (* check mind_equiv... *) (* Now we can add the inductive *) add_mind kn mib env diff --git a/checker/indtypes.mli b/checker/indtypes.mli index bca0a643..4c2b078c 100644 --- a/checker/indtypes.mli +++ b/checker/indtypes.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* [] then fail(); substl subs ty -let instantiate_partial_params = instantiate_params false - let full_inductive_instantiate mib params sign = let dummy = Prop Null in let t = mkArity (sign,dummy) in @@ -100,10 +96,6 @@ let full_constructor_instantiate ((mind,_),(mib,_),params) = (* Functions to build standard types related to inductive *) - -let number_of_inductives mib = Array.length mib.mind_packets -let number_of_constructors mip = Array.length mip.mind_consnames - (* Computing the actual sort of an applied or partially applied inductive type: @@ -346,14 +338,14 @@ let type_case_branches env (ind,largs) (p,pj) c = (************************************************************************) -(* Checking the case annotation is relevent *) +(* Checking the case annotation is relevant *) let check_case_info env indsp ci = let (mib,mip) = lookup_mind_specif env indsp in if not (eq_ind indsp ci.ci_ind) or (mib.mind_nparams <> ci.ci_npar) or - (mip.mind_consnrealdecls <> ci.ci_cstr_nargs) + (mip.mind_consnrealdecls <> ci.ci_cstr_ndecls) then raise (TypeError(env,WrongCaseInfo(indsp,ci))) (************************************************************************) @@ -404,8 +396,10 @@ type subterm_spec = | Dead_code | Not_subterm -let spec_of_tree t = - if Rtree.eq_rtree (=) t mk_norec then Not_subterm else Subterm(Strict,t) +let spec_of_tree t = lazy + (if Rtree.eq_rtree (=) (Lazy.force t) mk_norec + then Not_subterm + else Subterm(Strict,Lazy.force t)) let subterm_spec_glb = let glb2 s1 s2 = @@ -440,7 +434,7 @@ let make_renv env minds recarg (kn,tyi) = rel_min = recarg+2; inds = minds; recvec = mind_recvec; - genv = [Lazy.lazy_from_val (Subterm(Large,mind_recvec.(tyi)))] } + genv = [Lazy.lazy_from_val(Subterm(Large,mind_recvec.(tyi)))] } let push_var renv (x,ty,spec) = { renv with @@ -459,10 +453,6 @@ let subterm_var p renv = try Lazy.force (List.nth renv.genv (p-1)) with Failure _ | Invalid_argument _ -> Not_subterm -(* Add a variable and mark it as strictly smaller with information [spec]. *) -let add_subterm renv (x,a,spec) = - push_var renv (x,a,lazy (spec_of_tree (Lazy.force spec))) - let push_ctxt_renv renv ctxt = let n = rel_context_length ctxt in { renv with @@ -478,6 +468,15 @@ let push_fix_renv renv (_,v,_ as recdef) = genv = iterate (fun ge -> Lazy.lazy_from_val Not_subterm::ge) n renv.genv } +(* Definition and manipulation of the stack *) +type stack_element = |SClosure of guard_env*constr |SArg of subterm_spec Lazy.t + +let push_stack_closures renv l stack = + List.fold_right (fun h b -> (SClosure (renv,h))::b) l stack + +let push_stack_args l stack = + List.fold_right (fun h b -> (SArg h)::b) l stack + (******************************) (* Computing the recursive subterms of a term (propagation of size information through Cases). *) @@ -497,60 +496,38 @@ let lookup_subterms env ind = let (_,mip) = lookup_mind_specif env ind in mip.mind_recargs -(*********************************) - -let match_trees t1 t2 = - let v1 = dest_subterms t1 in - let v2 = dest_subterms t2 in - array_for_all2 (fun l1 l2 -> List.length l1 = List.length l2) v1 v2 +let match_inductive ind ra = + match ra with + | (Mrec i | Imbr i) -> eq_ind ind i + | Norec -> false -(* In {match c as z in ind y_s return P with |C_i x_s => t end} - [branches_specif renv c_spec ind] returns an array of x_s specs given - c_spec the spec of c. *) -let branches_specif renv c_spec ind = - let (_,mip) = lookup_mind_specif renv.env ind in +(* In {match c as z in ci y_s return P with |C_i x_s => t end} + [branches_specif renv c_spec ci] returns an array of x_s specs knowing + c_spec. *) +let branches_specif renv c_spec ci = let car = (* We fetch the regular tree associated to the inductive of the match. This is just to get the number of constructors (and constructor arities) that fit the match branches without forcing c_spec. Note that c_spec might be more precise than [v] below, because of nested inductive types. *) + let (_,mip) = lookup_mind_specif renv.env ci.ci_ind in let v = dest_subterms mip.mind_recargs in Array.map List.length v in Array.mapi (fun i nca -> (* i+1-th cstructor has arity nca *) let lvra = lazy (match Lazy.force c_spec with - Subterm (_,t) when match_trees mip.mind_recargs t -> + Subterm (_,t) when match_inductive ci.ci_ind (dest_recarg t) -> let vra = Array.of_list (dest_subterms t).(i) in assert (nca = Array.length vra); - Array.map spec_of_tree vra + Array.map + (fun t -> Lazy.force (spec_of_tree (lazy t))) + vra | Dead_code -> Array.create nca Dead_code | _ -> Array.create nca Not_subterm) in list_tabulate (fun j -> lazy (Lazy.force lvra).(j)) nca) - car - -(* Propagation of size information through Cases: if the matched - object is a recursive subterm then compute the information - associated to its own subterms. - Rq: if branch is not eta-long, then the recursive information - is not propagated to the missing abstractions *) -let case_branches_specif renv c_spec ind lbr = - let vlrec = branches_specif renv c_spec ind in - let rec push_branch_args renv lrec c = - match lrec with - ra::lr -> - let c' = whd_betadeltaiota renv.env c in - (match c' with - Lambda(x,a,b) -> - let renv' = push_var renv (x,a,ra) in - push_branch_args renv' lr b - | _ -> (* branch not in eta-long form: cannot perform rec. calls *) - (renv,c')) - | [] -> (renv, c) in - assert (Array.length vlrec = Array.length lbr); - array_map2 (push_branch_args renv) vlrec lbr - + car (* [subterm_specif renv t] computes the recursive structure of [t] and compare its size with the size of the initial recursive argument of @@ -558,78 +535,88 @@ let case_branches_specif renv c_spec ind lbr = about variables. *) -let rec subterm_specif renv t = + +let rec subterm_specif renv stack t = (* maybe reduction is not always necessary! *) let f,l = decompose_app (whd_betadeltaiota renv.env t) in - match f with - | Rel k -> subterm_var k renv - - | Case (ci,_,c,lbr) -> - let lbr_spec = case_subterm_specif renv ci c lbr in - let stl = - Array.map (fun (renv',br') -> subterm_specif renv' br') - lbr_spec in - subterm_spec_glb stl - - | Fix ((recindxs,i),(_,typarray,bodies as recdef)) -> -(* when proving that the fixpoint f(x)=e is less than n, it is enough - to prove that e is less than n assuming f is less than n - furthermore when f is applied to a term which is strictly less than - n, one may assume that x itself is strictly less than n -*) - let (ctxt,clfix) = dest_prod renv.env typarray.(i) in - let oind = - let env' = push_rel_context ctxt renv.env in - try Some(fst(find_inductive env' clfix)) - with Not_found -> None in - (match oind with - None -> Not_subterm (* happens if fix is polymorphic *) - | Some ind -> - let nbfix = Array.length typarray in - let recargs = lookup_subterms renv.env ind in - (* pushing the fixpoints *) - let renv' = push_fix_renv renv recdef in - let renv' = - (* Why Strict here ? To be general, it could also be - Large... *) - assign_var_spec renv' - (nbfix-i, Lazy.lazy_from_val (Subterm(Strict,recargs))) in - let decrArg = recindxs.(i) in - let theBody = bodies.(i) in - let nbOfAbst = decrArg+1 in - let sign,strippedBody = decompose_lam_n_assum nbOfAbst theBody in - (* pushing the fix parameters *) - let renv'' = push_ctxt_renv renv' sign in - let renv'' = - if List.length l < nbOfAbst then renv'' - else - let theDecrArg = List.nth l decrArg in - let arg_spec = lazy_subterm_specif renv theDecrArg in - assign_var_spec renv'' (1, arg_spec) in - subterm_specif renv'' strippedBody) - - | Lambda (x,a,b) -> - assert (l=[]); - subterm_specif (push_var_renv renv (x,a)) b - - (* Metas and evars are considered OK *) - | (Meta _|Evar _) -> Dead_code - - (* Other terms are not subterms *) - | _ -> Not_subterm - -and lazy_subterm_specif renv t = - lazy (subterm_specif renv t) - -and case_subterm_specif renv ci c lbr = - if Array.length lbr = 0 then [||] - else - let c_spec = lazy_subterm_specif renv c in - case_branches_specif renv c_spec ci.ci_ind lbr - -(* Check term c can be applied to one of the mutual fixpoints. *) -let check_is_subterm renv c = - match subterm_specif renv c with + match f with + | Rel k -> subterm_var k renv + + | Case (ci,_,c,lbr) -> + let stack' = push_stack_closures renv l stack in + let cases_spec = branches_specif renv + (lazy_subterm_specif renv [] c) ci in + let stl = + Array.mapi (fun i br' -> + let stack_br = push_stack_args (cases_spec.(i)) stack' in + subterm_specif renv stack_br br') + lbr in + subterm_spec_glb stl + + | Fix ((recindxs,i),(_,typarray,bodies as recdef)) -> + (* when proving that the fixpoint f(x)=e is less than n, it is enough + to prove that e is less than n assuming f is less than n + furthermore when f is applied to a term which is strictly less than + n, one may assume that x itself is strictly less than n + *) + let (ctxt,clfix) = dest_prod renv.env typarray.(i) in + let oind = + let env' = push_rel_context ctxt renv.env in + try Some(fst(find_inductive env' clfix)) + with Not_found -> None in + (match oind with + None -> Not_subterm (* happens if fix is polymorphic *) + | Some ind -> + let nbfix = Array.length typarray in + let recargs = lookup_subterms renv.env ind in + (* pushing the fixpoints *) + let renv' = push_fix_renv renv recdef in + let renv' = + (* Why Strict here ? To be general, it could also be + Large... *) + assign_var_spec renv' + (nbfix-i, lazy (Subterm(Strict,recargs))) in + let decrArg = recindxs.(i) in + let theBody = bodies.(i) in + let nbOfAbst = decrArg+1 in + let sign,strippedBody = decompose_lam_n_assum nbOfAbst theBody in + (* pushing the fix parameters *) + let stack' = push_stack_closures renv l stack in + let renv'' = push_ctxt_renv renv' sign in + let renv'' = + if List.length stack' < nbOfAbst then renv'' + else + let decrArg = List.nth stack' decrArg in + let arg_spec = stack_element_specif decrArg in + assign_var_spec renv'' (1, arg_spec) in + subterm_specif renv'' [] strippedBody) + + | Lambda (x,a,b) -> + assert (l=[]); + let spec,stack' = extract_stack renv a stack in + subterm_specif (push_var renv (x,a,spec)) stack' b + + (* Metas and evars are considered OK *) + | (Meta _|Evar _) -> Dead_code + + (* Other terms are not subterms *) + | _ -> Not_subterm + +and lazy_subterm_specif renv stack t = + lazy (subterm_specif renv stack t) + +and stack_element_specif = function + |SClosure (h_renv,h) -> lazy_subterm_specif h_renv [] h + |SArg x -> x + +and extract_stack renv a = function + | [] -> Lazy.lazy_from_val Not_subterm , [] + | h::t -> stack_element_specif h, t + + +(* Check size x is a correct size for recursive calls. *) +let check_is_subterm x = + match Lazy.force x with Subterm (Strict,_) | Dead_code -> true | _ -> false @@ -637,7 +624,7 @@ let check_is_subterm renv c = exception FixGuardError of env * guard_error -let error_illegal_rec_call renv fx arg = +let error_illegal_rec_call renv fx (arg_renv,arg) = let (_,le_vars,lt_vars) = List.fold_left (fun (i,le,lt) sbt -> @@ -647,7 +634,8 @@ let error_illegal_rec_call renv fx arg = | _ -> (i+1, le ,lt)) (1,[],[]) renv.genv in raise (FixGuardError (renv.env, - RecursionOnIllegalTerm(fx,arg,le_vars,lt_vars))) + RecursionOnIllegalTerm(fx,(arg_renv.env, arg), + le_vars,lt_vars))) let error_partial_apply renv fx = raise (FixGuardError (renv.env,NotEnoughArgumentsForFixCall fx)) @@ -659,48 +647,57 @@ let check_one_fix renv recpos def = let nfi = Array.length recpos in (* Checks if [t] only make valid recursive calls *) - let rec check_rec_call renv t = + let rec check_rec_call renv stack t = (* if [t] does not make recursive calls, it is guarded: *) if noccur_with_meta renv.rel_min nfi t then () else - let (f,l) = decompose_app (whd_betaiotazeta renv.env t) in + let (f,l) = decompose_app (whd_betaiotazeta t) in match f with | Rel p -> (* Test if [p] is a fixpoint (recursive call) *) if renv.rel_min <= p & p < renv.rel_min+nfi then begin - List.iter (check_rec_call renv) l; + List.iter (check_rec_call renv []) l; (* the position of the invoked fixpoint: *) let glob = renv.rel_min+nfi-1-p in (* the decreasing arg of the rec call: *) let np = recpos.(glob) in - if List.length l <= np then error_partial_apply renv glob + let stack' = push_stack_closures renv l stack in + if List.length stack' <= np then error_partial_apply renv glob else (* Check the decreasing arg is smaller *) - let z = List.nth l np in - if not (check_is_subterm renv z) then - error_illegal_rec_call renv glob z + let z = List.nth stack' np in + if not (check_is_subterm (stack_element_specif z)) then + begin match z with + |SClosure (z,z') -> error_illegal_rec_call renv glob (z,z') + |SArg _ -> error_partial_apply renv glob + end end else begin match pi2 (lookup_rel p renv.env) with | None -> - List.iter (check_rec_call renv) l + List.iter (check_rec_call renv []) l | Some c -> - try List.iter (check_rec_call renv) l - with FixGuardError _ -> check_rec_call renv (applist(c,l)) + try List.iter (check_rec_call renv []) l + with FixGuardError _ -> + check_rec_call renv stack (applist(lift p c,l)) end - + | Case (ci,p,c_0,lrest) -> - List.iter (check_rec_call renv) (c_0::p::l); + List.iter (check_rec_call renv []) (c_0::p::l); (* compute the recarg information for the arguments of each branch *) - let lbr = case_subterm_specif renv ci c_0 lrest in - Array.iter (fun (renv',br') -> check_rec_call renv' br') lbr + let case_spec = branches_specif renv + (lazy_subterm_specif renv [] c_0) ci in + let stack' = push_stack_closures renv l stack in + Array.iteri (fun k br' -> + let stack_br = push_stack_args case_spec.(k) stack' in + check_rec_call renv stack_br br') lrest (* Enables to traverse Fixpoint definitions in a more intelligent way, ie, the rule : - if - g = Fix g/p := [y1:T1]...[yp:Tp]e & + if - g = fix g (y1:T1)...(yp:Tp) {struct yp} := e & - f is guarded with respect to the set of pattern variables S in a1 ... am & - f is guarded with respect to the set of pattern variables S @@ -710,81 +707,80 @@ let check_one_fix renv recpos def = S+{yp} in e then f is guarded with respect to S in (g a1 ... am). Eduardo 7/9/98 *) - | Fix ((recindxs,i),(_,typarray,bodies as recdef)) -> - List.iter (check_rec_call renv) l; - Array.iter (check_rec_call renv) typarray; + List.iter (check_rec_call renv []) l; + Array.iter (check_rec_call renv []) typarray; let decrArg = recindxs.(i) in let renv' = push_fix_renv renv recdef in - if (List.length l < (decrArg+1)) then - Array.iter (check_rec_call renv') bodies - else + let stack' = push_stack_closures renv l stack in Array.iteri (fun j body -> - if i=j then - let theDecrArg = List.nth l decrArg in - let arg_spec = lazy_subterm_specif renv theDecrArg in - check_nested_fix_body renv' (decrArg+1) arg_spec body - else check_rec_call renv' body) + if i=j && (List.length stack' > decrArg) then + let recArg = List.nth stack' decrArg in + let arg_sp = stack_element_specif recArg in + check_nested_fix_body renv' (decrArg+1) arg_sp body + else check_rec_call renv' [] body) bodies | Const kn -> if evaluable_constant kn renv.env then - try List.iter (check_rec_call renv) l + try List.iter (check_rec_call renv []) l with (FixGuardError _ ) -> - check_rec_call renv(applist(constant_value renv.env kn, l)) - else List.iter (check_rec_call renv) l - - (* The cases below simply check recursively the condition on the - subterms *) - | Cast (a,_, b) -> - List.iter (check_rec_call renv) (a::b::l) + let value = (applist(constant_value renv.env kn, l)) in + check_rec_call renv stack value + else List.iter (check_rec_call renv []) l | Lambda (x,a,b) -> - List.iter (check_rec_call renv) (a::l); - check_rec_call (push_var_renv renv (x,a)) b + assert (l = []); + check_rec_call renv [] a ; + let spec, stack' = extract_stack renv a stack in + check_rec_call (push_var renv (x,a,spec)) stack' b | Prod (x,a,b) -> - List.iter (check_rec_call renv) (a::l); - check_rec_call (push_var_renv renv (x,a)) b + assert (l = [] && stack = []); + check_rec_call renv [] a; + check_rec_call (push_var_renv renv (x,a)) [] b | CoFix (i,(_,typarray,bodies as recdef)) -> - List.iter (check_rec_call renv) l; - Array.iter (check_rec_call renv) typarray; + List.iter (check_rec_call renv []) l; + Array.iter (check_rec_call renv []) typarray; let renv' = push_fix_renv renv recdef in - Array.iter (check_rec_call renv') bodies + Array.iter (check_rec_call renv' []) bodies - | (Ind _ | Construct _ | Sort _) -> - List.iter (check_rec_call renv) l + | (Ind _ | Construct _) -> + List.iter (check_rec_call renv []) l | Var id -> begin match pi2 (lookup_named id renv.env) with | None -> - List.iter (check_rec_call renv) l + List.iter (check_rec_call renv []) l | Some c -> - try List.iter (check_rec_call renv) l - with (FixGuardError _) -> check_rec_call renv (applist(c,l)) + try List.iter (check_rec_call renv []) l + with (FixGuardError _) -> + check_rec_call renv stack (applist(c,l)) end + | Sort _ -> assert (l = []) + (* l is not checked because it is considered as the meta's context *) | (Evar _ | Meta _) -> () - | (App _|LetIn _) -> assert false (* beta zeta reduction *) + | (App _ | LetIn _ | Cast _) -> assert false (* beta zeta reduction *) and check_nested_fix_body renv decr recArgsDecrArg body = if decr = 0 then - check_rec_call (assign_var_spec renv (1,recArgsDecrArg)) body + check_rec_call (assign_var_spec renv (1,recArgsDecrArg)) [] body else match body with | Lambda (x,a,b) -> - check_rec_call renv a; + check_rec_call renv [] a; let renv' = push_var_renv renv (x,a) in - check_nested_fix_body renv' (decr-1) recArgsDecrArg b + check_nested_fix_body renv' (decr-1) recArgsDecrArg b | _ -> anomaly "Not enough abstractions in fix body" - + in - check_rec_call renv def + check_rec_call renv [] def let inductive_of_mutfix env ((nvect,bodynum),(names,types,bodies as recdef)) = diff --git a/checker/inductive.mli b/checker/inductive.mli index e658a798..2cf7c70d 100644 --- a/checker/inductive.mli +++ b/checker/inductive.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr -> subterm_spec -val case_branches_specif : guard_env -> subterm_spec Lazy.t -> inductive -> - constr array -> (guard_env * constr) array +type stack_element = |SClosure of guard_env*constr |SArg of subterm_spec Lazy.t +val subterm_specif : guard_env -> stack_element list -> constr -> subterm_spec +val branches_specif : guard_env -> subterm_spec Lazy.t -> case_info -> + subterm_spec Lazy.t list array diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml index 95387cac..9942816d 100644 --- a/checker/mod_checking.ml +++ b/checker/mod_checking.ml @@ -21,8 +21,8 @@ let refresh_arity ar = Sort (Type u) when not (Univ.is_univ_variable u) -> let u' = Univ.fresh_local_univ() in mkArity (ctxt,Type u'), - Univ.enforce_geq u' u Univ.Constraint.empty - | _ -> ar, Univ.Constraint.empty + Univ.enforce_geq u' u Univ.empty_constraint + | _ -> ar, Univ.empty_constraint let check_constant_declaration env kn cb = Flags.if_verbose msgnl (str " checking cst: " ++ prcon kn); @@ -33,7 +33,7 @@ let check_constant_declaration env kn cb = let ty, cu = refresh_arity ty in let envty = add_constraints cu env' in let _ = infer_type envty ty in - (match cb.const_body with + (match body_of_constant cb with | Some bd -> let j = infer env' (force_constr bd) in conv_leq envty j ty @@ -58,13 +58,6 @@ let rec list_split_assoc k rev_before = function | (k',b)::after when k=k' -> rev_before,b,after | h::tail -> list_split_assoc k (h::rev_before) tail -let rec list_fold_map2 f e = function - | [] -> (e,[],[]) - | h::t -> - let e',h1',h2' = f e h in - let e'',t1',t2' = list_fold_map2 f e' t in - e'',h1'::t1',h2'::t2' - let check_definition_sub env cb1 cb2 = let check_type env t1 t2 = @@ -117,14 +110,19 @@ let check_definition_sub env cb1 cb2 = let typ1 = Typeops.type_of_constant_type env cb1.const_type in let typ2 = Typeops.type_of_constant_type env cb2.const_type in check_type env typ1 typ2; - (match cb2 with - | {const_body=Some lc2;const_opaque=false} -> - let c2 = force_constr lc2 in - let c1 = match cb1.const_body with - | Some lc1 -> force_constr lc1 - | None -> assert false in - Reduction.conv env c1 c2 - | _ -> ()) + (* In the spirit of subtyping.check_constant, we accept + any implementations of parameters and opaques terms, + as long as they have the right type *) + (match cb2.const_body with + | Undef _ | OpaqueDef _ -> () + | Def lc2 -> + (match cb1.const_body with + | Def lc1 -> + let c1 = force_constr lc1 in + let c2 = force_constr lc2 in + Reduction.conv env c1 c2 + (* Coq only places transparent cb in With_definition_body *) + | _ -> assert false)) let lookup_modtype mp env = try Environ.lookup_modtype mp env @@ -259,14 +257,14 @@ and check_module env mp mb = {typ_mp=mp; typ_expr=sign; typ_expr_alg=None; - typ_constraints=Univ.Constraint.empty; + typ_constraints=Univ.empty_constraint; typ_delta = mb.mod_delta;} and mtb2 = {typ_mp=mp; typ_expr=mb.mod_type; typ_expr_alg=None; - typ_constraints=Univ.Constraint.empty; - typ_delta = mb.mod_delta;}; + typ_constraints=Univ.empty_constraint; + typ_delta = mb.mod_delta;} in let env = add_module (module_body_of_type mp mtb1) env in check_subtypes env mtb1 mtb2 diff --git a/checker/mod_checking.mli b/checker/mod_checking.mli new file mode 100644 index 00000000..8021ed0f --- /dev/null +++ b/checker/mod_checking.mli @@ -0,0 +1,9 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* Names.module_path -> Declarations.module_body -> unit diff --git a/checker/modops.ml b/checker/modops.ml index 38aeaee2..2dc5d062 100644 --- a/checker/modops.ml +++ b/checker/modops.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* error_not_a_functor mtb - -let is_functor = function - | SEBfunctor (arg_id,arg_t,body_t) -> true - | _ -> false - let module_body_of_type mp mtb = { mod_mp = mp; mod_type = mtb.typ_expr; @@ -75,14 +66,6 @@ let module_body_of_type mp mtb = mod_delta = mtb.typ_delta; mod_retroknowledge = []} -let check_modpath_equiv env mp1 mp2 = - if mp1=mp2 then () else - (* let mb1=lookup_module mp1 env in - let mb2=lookup_module mp2 env in - if (delta_of_mp mb1.mod_delta mp1)=(delta_of_mp mb2.mod_delta mp2) - then () - else*) error_not_equal mp1 mp2 - let rec add_signature mp sign resolver env = let add_one env (l,elem) = let kn = make_kn mp empty_dirpath l in @@ -112,23 +95,16 @@ and add_module mb env = let strengthen_const mp_from l cb resolver = - match cb.const_opaque, cb.const_body with - | false, Some _ -> cb - | true, Some _ - | _, None -> + match cb.const_body with + | Def _ -> cb + | _ -> let con = make_con mp_from empty_dirpath l in - (* let con = constant_of_delta resolver con in*) - let const = Const con in - let const_subs = Some (Declarations.from_val const) in - {cb with - const_body = const_subs; - const_opaque = false; - } - + (* let con = constant_of_delta resolver con in*) + { cb with const_body = Def (Declarations.from_val (Const con)) } let rec strengthen_mod mp_from mp_to mb = if Declarations.mp_in_delta mb.mod_mp mb.mod_delta then - mb + mb else match mb.mod_type with | SEBstruct (sign) -> @@ -154,34 +130,33 @@ and strengthen_sig mp_from sign mp_to resolver = resolve_out,item'::rest' | (_,SFBmind _ as item):: rest -> let resolve_out,rest' = strengthen_sig mp_from rest mp_to resolver in - resolve_out,item::rest' + resolve_out,item::rest' | (l,SFBmodule mb) :: rest -> let mp_from' = MPdot (mp_from,l) in let mp_to' = MPdot(mp_to,l) in let mb_out = strengthen_mod mp_from' mp_to' mb in let item' = l,SFBmodule (mb_out) in let resolve_out,rest' = strengthen_sig mp_from rest mp_to resolver in - resolve_out, item'::rest' - | (l,SFBmodtype mty as item) :: rest -> + resolve_out (*add_delta_resolver resolve_out mb.mod_delta*), + item':: rest' + | (l,SFBmodtype mty as item) :: rest -> let resolve_out,rest' = strengthen_sig mp_from rest mp_to resolver in - resolve_out, item::rest' + resolve_out,item::rest' let strengthen mtb mp = match mtb.typ_expr with - | SEBstruct (sign) -> + | SEBstruct (sign) -> let resolve_out,sign_out = - strengthen_sig mtb.typ_mp sign mp mtb.typ_delta - in - {mtb with - typ_expr = SEBstruct(sign_out); - typ_delta = resolve_out(*add_delta_resolver mtb.typ_delta + strengthen_sig mtb.typ_mp sign mp mtb.typ_delta in + {mtb with + typ_expr = SEBstruct(sign_out); + typ_delta = resolve_out(*add_delta_resolver mtb.typ_delta (add_mp_delta_resolver mtb.typ_mp mp resolve_out)*)} | SEBfunctor _ -> mtb | _ -> anomaly "Modops:the evaluation of the structure failed " let subst_and_strengthen mb mp = - strengthen_mod mb.mod_mp mp - (subst_module (map_mp mb.mod_mp mp) mb) + strengthen_mod mb.mod_mp mp (subst_module (map_mp mb.mod_mp mp) mb) let module_type_of_module mp mb = diff --git a/checker/modops.mli b/checker/modops.mli index 2f9f2e8c..5ed7b0ce 100644 --- a/checker/modops.mli +++ b/checker/modops.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* structure_body -> delta_resolver -> env -> en (* adds a module and its components, but not the constraints *) val add_module : module_body -> env -> env -val check_modpath_equiv : env -> module_path -> module_path -> unit - val strengthen : module_type_body -> module_path -> module_type_body val subst_and_strengthen : module_body -> module_path -> module_body diff --git a/checker/reduction.ml b/checker/reduction.ml index ba8ceeef..3aeaa102 100644 --- a/checker/reduction.ml +++ b/checker/reduction.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* x - | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x) + | _ -> whd_val (create_clos_infos betaiotazeta empty_env) (inject x) let whd_betadeltaiota env t = match t with @@ -107,15 +105,6 @@ let beta_appvect c v = | _ -> applist (substl env t, stack) in stacklam [] c (Array.to_list v) -let betazeta_appvect n c v = - let rec stacklam n env t stack = - if n = 0 then applist (substl env t, stack) else - match t, stack with - Lambda(_,_,c), arg::stacktl -> stacklam (n-1) (arg::env) c stacktl - | LetIn(_,b,_,c), _ -> stacklam (n-1) (b::env) c stack - | _ -> anomaly "Not enough lambda/let's" in - stacklam n [] c (Array.to_list v) - (********************************************************************) (* Conversion *) (********************************************************************) @@ -219,7 +208,7 @@ let rec ccnv univ cv_pb infos lft1 lft2 term1 term2 = and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) = Util.check_for_interrupt (); (* First head reduce both terms *) - let rec whd_both (t1,stk1) (t2,stk2) = + let rec whd_both (t1,stk1) (t2,stk2) = let st1' = whd_stack infos t1 stk1 in let st2' = whd_stack infos t2 stk2 in (* Now, whd_stack on term2 might have modified st1 (due to sharing), @@ -279,20 +268,10 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) = | None -> raise NotConvertible) in eqappr univ cv_pb infos app1 app2) - (* only one constant, defined var or defined rel *) - | (FFlex fl1, _) -> - (match unfold_reference infos fl1 with - | Some def1 -> - eqappr univ cv_pb infos (lft1, whd_stack infos def1 v1) appr2 - | None -> raise NotConvertible) - | (_, FFlex fl2) -> - (match unfold_reference infos fl2 with - | Some def2 -> - eqappr univ cv_pb infos appr1 (lft2, whd_stack infos def2 v2) - | None -> raise NotConvertible) - (* other constructors *) | (FLambda _, FLambda _) -> + (* Inconsistency: we tolerate that v1, v2 contain shift and update but + we throw them away *) assert (is_empty_stack v1 && is_empty_stack v2); let (_,ty1,bd1) = destFLambda mk_clos hd1 in let (_,ty2,bd2) = destFLambda mk_clos hd2 in @@ -305,6 +284,32 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) = ccnv univ CONV infos el1 el2 c1 c'1; ccnv univ cv_pb infos (el_lift el1) (el_lift el2) c2 c'2 + (* Eta-expansion on the fly *) + | (FLambda _, _) -> + if v1 <> [] then + anomaly "conversion was given unreduced term (FLambda)"; + let (_,_ty1,bd1) = destFLambda mk_clos hd1 in + eqappr univ CONV infos + (el_lift lft1,(bd1,[])) (el_lift lft2,(hd2,eta_expand_stack v2)) + | (_, FLambda _) -> + if v2 <> [] then + anomaly "conversion was given unreduced term (FLambda)"; + let (_,_ty2,bd2) = destFLambda mk_clos hd2 in + eqappr univ CONV infos + (el_lift lft1,(hd1,eta_expand_stack v1)) (el_lift lft2,(bd2,[])) + + (* only one constant, defined var or defined rel *) + | (FFlex fl1, _) -> + (match unfold_reference infos fl1 with + | Some def1 -> + eqappr univ cv_pb infos (lft1, whd_stack infos def1 v1) appr2 + | None -> raise NotConvertible) + | (_, FFlex fl2) -> + (match unfold_reference infos fl2 with + | Some def2 -> + eqappr univ cv_pb infos appr1 (lft2, whd_stack infos def2 v2) + | None -> raise NotConvertible) + (* Inductive types: MutInd MutConstruct Fix Cofix *) | (FInd ind1, FInd ind2) -> @@ -367,37 +372,18 @@ and convert_vect univ infos lft1 lft2 v1 v2 = let clos_fconv cv_pb env t1 t2 = let infos = create_clos_infos betaiotazeta env in let univ = universes env in - ccnv univ cv_pb infos ELID ELID (inject t1) (inject t2) + ccnv univ cv_pb infos el_id el_id (inject t1) (inject t2) let fconv cv_pb env t1 t2 = if eq_constr t1 t2 then () else clos_fconv cv_pb env t1 t2 -let conv_cmp = fconv let conv = fconv CONV let conv_leq = fconv CUMUL -let conv_leq_vecti env v1 v2 = - array_fold_left2_i - (fun i _ t1 t2 -> - (try conv_leq env t1 t2 - with (NotConvertible|Invalid_argument _) -> - raise (NotConvertibleVect i)); - ()) - () - v1 - v2 - -(* option for conversion *) - -let vm_conv = ref fconv -let set_vm_conv f = vm_conv := f -let vm_conv cv_pb env t1 t2 = - try - !vm_conv cv_pb env t1 t2 - with Not_found | Invalid_argument _ -> - (* If compilation fails, fall-back to closure conversion *) - clos_fconv cv_pb env t1 t2 +(* option for conversion : no compilation for the checker *) + +let vm_conv = fconv (********************************************************************) (* Special-Purpose Reduction *) @@ -452,9 +438,3 @@ let dest_arity env c = | Sort s -> l,s | _ -> error "not an arity" -let is_arity env c = - try - let _ = dest_arity env c in - true - with UserError _ -> false - diff --git a/checker/reduction.mli b/checker/reduction.mli index 8e69da44..6695fd03 100644 --- a/checker/reduction.mli +++ b/checker/reduction.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr -> constr +val whd_betaiotazeta : constr -> constr val whd_betadeltaiota : env -> constr -> constr val whd_betadeltaiota_nolet : env -> constr -> constr @@ -31,7 +29,6 @@ type conv_pb = CONV | CUMUL val conv : constr conversion_function val conv_leq : constr conversion_function -val conv_leq_vecti : constr array conversion_function val vm_conv : conv_pb -> constr conversion_function @@ -40,9 +37,6 @@ val vm_conv : conv_pb -> constr conversion_function (* Builds an application node, reducing beta redexes it may produce. *) val beta_appvect : constr -> constr array -> constr -(* Builds an application node, reducing the [n] first beta-zeta redexes. *) -val betazeta_appvect : int -> constr -> constr array -> constr - (* Pseudo-reduction rule Prod(x,A,B) a --> B[x\a] *) val hnf_prod_applist : env -> constr -> constr list -> constr @@ -54,4 +48,3 @@ val dest_prod : env -> constr -> rel_context * constr val dest_prod_assum : env -> constr -> rel_context * constr val dest_arity : env -> constr -> arity -val is_arity : env -> constr -> bool diff --git a/checker/safe_typing.ml b/checker/safe_typing.ml index a669c5e8..bc067dc5 100644 --- a/checker/safe_typing.ml +++ b/checker/safe_typing.ml @@ -1,19 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* SFBconst {x with const_body=None} - | (SFBconst _ | SFBmind _ ) as x -> x - | SFBmodule m -> SFBmodule (lighten_module m) - | SFBmodtype m -> SFBmodtype - ({m with - typ_expr = lighten_modexpr m.typ_expr})) - in - List.map lighten_body struc - -and lighten_modexpr = function - | SEBfunctor (mbid,mty,mexpr) -> - SEBfunctor (mbid, - ({mty with - typ_expr = lighten_modexpr mty.typ_expr}), - lighten_modexpr mexpr) - | SEBident mp as x -> x - | SEBstruct ( struc) -> - SEBstruct ( lighten_struct struc) - | SEBapply (mexpr,marg,u) -> - SEBapply (lighten_modexpr mexpr,lighten_modexpr marg,u) - | SEBwith (seb,wdcl) -> - SEBwith (lighten_modexpr seb,wdcl) - -let lighten_library (dp,mb,depends,s) = (dp,lighten_module mb,depends,s) - - type compiled_library = dir_path * module_body * (dir_path * Digest.t) list * engagement option + (* Store the body of modules' opaque constants inside a table. + + This module is used during the serialization and deserialization + of vo files. + + By adding an indirection to the opaque constant definitions, we + gain the ability not to load them. As these constant definitions + are usually big terms, we save a deserialization time as well as + some memory space. *) +module LightenLibrary : sig + type table + type lightened_compiled_library + val load : table -> lightened_compiled_library -> compiled_library +end = struct + + (* The table is implemented as an array of [constr_substituted]. + Keys are hence integers. To avoid changing the [compiled_library] + type, we brutally encode integers into [lazy_constr]. This isn't + pretty, but shouldn't be dangerous since the produced structure + [lightened_compiled_library] is abstract and only meant for writing + to .vo via Marshal (which doesn't care about types). + *) + type table = constr_substituted array + let key_of_lazy_constr (c:lazy_constr) = (Obj.magic c : int) + + (* To avoid any future misuse of the lightened library that could + interpret encoded keys as real [constr_substituted], we hide + these kind of values behind an abstract datatype. *) + type lightened_compiled_library = compiled_library + + (* Map a [compiled_library] to another one by just updating + the opaque term [t] to [on_opaque_const_body t]. *) + let traverse_library on_opaque_const_body = + let rec traverse_module mb = + match mb.mod_expr with + None -> + { mb with + mod_expr = None; + mod_type = traverse_modexpr mb.mod_type; + } + | Some impl when impl == mb.mod_type-> + let mtb = traverse_modexpr mb.mod_type in + { mb with + mod_expr = Some mtb; + mod_type = mtb; + } + | Some impl -> + { mb with + mod_expr = Option.map traverse_modexpr mb.mod_expr; + mod_type = traverse_modexpr mb.mod_type; + } + and traverse_struct struc = + let traverse_body (l,body) = (l,match body with + | (SFBconst cb) when is_opaque cb -> + SFBconst {cb with const_body = on_opaque_const_body cb.const_body} + | (SFBconst _ | SFBmind _ ) as x -> + x + | SFBmodule m -> + SFBmodule (traverse_module m) + | SFBmodtype m -> + SFBmodtype ({m with typ_expr = traverse_modexpr m.typ_expr})) + in + List.map traverse_body struc + + and traverse_modexpr = function + | SEBfunctor (mbid,mty,mexpr) -> + SEBfunctor (mbid, + ({mty with + typ_expr = traverse_modexpr mty.typ_expr}), + traverse_modexpr mexpr) + | SEBident mp as x -> x + | SEBstruct (struc) -> + SEBstruct (traverse_struct struc) + | SEBapply (mexpr,marg,u) -> + SEBapply (traverse_modexpr mexpr,traverse_modexpr marg,u) + | SEBwith (seb,wdcl) -> + SEBwith (traverse_modexpr seb,wdcl) + in + fun (dp,mb,depends,s) -> (dp,traverse_module mb,depends,s) + + (* Loading is also a traversing that decodes the embedded keys that + are inside the [lightened_library]. If the [load_proof] flag is + set, we lookup inside the table to graft the + [constr_substituted]. Otherwise, we set the [const_body] field + to [None]. + *) + let load table lightened_library = + let decode_key = function + | Undef _ | Def _ -> assert false + | OpaqueDef k -> + let k = key_of_lazy_constr k in + let body = + try table.(k) + with _ -> error "Error while retrieving an opaque body" + in + OpaqueDef (lazy_constr_from_val body) + in + traverse_library decode_key lightened_library + +end + open Validate -let val_deps = val_list (val_tuple"dep"[|val_dp;no_val|]) -let val_vo = val_tuple "vo" [|val_dp;val_module;val_deps;val_opt val_eng|] +let val_deps = val_list (val_tuple ~name:"dep"[|val_dp;no_val|]) +let val_vo = val_tuple ~name:"vo" [|val_dp;val_module;val_deps;val_opt val_eng|] (* This function should append a certificate to the .vo file. The digest must be part of the certicate to rule out attackers @@ -124,15 +185,15 @@ let import file (dp,mb,depends,engmt as vo) digest = let env = !genv in check_imports msg_warning dp env depends; check_engagement env engmt; - check_module (add_constraints mb.mod_constraints env) mb.mod_mp mb; + Mod_checking.check_module (add_constraints mb.mod_constraints env) mb.mod_mp mb; stamp_library file digest; (* We drop proofs once checked *) (* let mb = lighten_module mb in*) full_add_module dp mb digest (* When the module is admitted, digests *must* match *) -let unsafe_import file (dp,mb,depends,engmt) digest = -(* if !Flags.debug then Validate.apply !Flags.debug val_vo vo;*) +let unsafe_import file (dp,mb,depends,engmt as vo) digest = + if !Flags.debug then ignore vo; (*Validate.apply !Flags.debug val_vo vo;*) let env = !genv in check_imports (errorlabstrm"unsafe_import") dp env depends; check_engagement env engmt; diff --git a/checker/safe_typing.mli b/checker/safe_typing.mli index 00aa1a84..cd2c06d2 100644 --- a/checker/safe_typing.mli +++ b/checker/safe_typing.mli @@ -1,20 +1,17 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit val get_env : unit -> env (* exporting and importing modules *) @@ -25,3 +22,19 @@ val import : System.physical_path -> compiled_library -> Digest.t -> unit val unsafe_import : System.physical_path -> compiled_library -> Digest.t -> unit + +(** Store the body of modules' opaque constants inside a table. + + This module is used during the serialization and deserialization + of vo files. +*) +module LightenLibrary : +sig + type table + type lightened_compiled_library + + (** [load table lcl] builds a compiled library from a + lightened library [lcl] by remplacing every index by its related + opaque terms inside [table]. *) + val load : table -> lightened_compiled_library -> compiled_library +end diff --git a/checker/subtyping.ml b/checker/subtyping.ml index 4f113cf9..0c97254b 100644 --- a/checker/subtyping.ml +++ b/checker/subtyping.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* assert (cb1.const_hyps=[] && cb2.const_hyps=[]) ; - (*Start by checking types*) - let cb1 = subst_const_body subst1 cb1 in - let cb2 = subst_const_body subst2 cb2 in - let typ1 = Typeops.type_of_constant_type env cb1.const_type in - let typ2 = Typeops.type_of_constant_type env cb2.const_type in - check_type env typ1 typ2; - let con = make_con mp1 empty_dirpath l in - (match cb2 with - | {const_body=Some lc2;const_opaque=false} -> - let c2 = force_constr lc2 in - let c1 = match cb1.const_body with - | Some lc1 -> force_constr lc1 - | None -> Const con - in - check_conv conv env c1 c2 - | _ -> ()) + 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 + check_type env typ1 typ2; + (* Now we check the bodies: + - A transparent constant can only be implemented by a compatible + transparent constant. + - In the signature, an opaque is handled just as a parameter: + anything of the right type can implement it, even if bodies differ. + *) + (match cb2.const_body with + | Undef _ | OpaqueDef _ -> () + | Def lc2 -> + (match cb1.const_body with + | Undef _ | OpaqueDef _ -> error () + | Def lc1 -> + (* NB: cb1 might have been strengthened and appear as transparent. + Anyway [check_conv] will handle that afterwards. *) + let c1 = force_constr lc1 in + let c2 = force_constr lc2 in + check_conv conv env c1 c2)) | IndType ((kn,i),mind1) -> ignore (Util.error ( "The kernel does not recognize yet that a parameter can be " ^ @@ -262,7 +267,7 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = "inductive type and give a definition to map the old name to the new " ^ "name.")); assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ; - if cb2.const_body <> None then error () ; + if constant_has_body cb2 then error () ; let arity1 = type_of_inductive env (mind1,mind1.mind_packets.(i)) in let typ2 = Typeops.type_of_constant_type env cb2.const_type in check_conv conv_leq env arity1 typ2 @@ -273,7 +278,7 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = "constructor and give a definition to map the old name to the new " ^ "name.")); assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ; - if cb2.const_body <> None then error () ; + if constant_has_body cb2 then error () ; let ty1 = type_of_constructor cstr (mind1,mind1.mind_packets.(i)) in let ty2 = Typeops.type_of_constant_type env cb2.const_type in check_conv conv env ty1 ty2 @@ -281,7 +286,7 @@ let check_constant env mp1 l info1 cb2 spec2 subst1 subst2 = let rec check_modules env msb1 msb2 subst1 subst2 = let mty1 = module_type_of_module None msb1 in - let mty2 = module_type_of_module None msb2 in + let mty2 = module_type_of_module None msb2 in check_modtypes env mty1 mty2 subst1 subst2 false; @@ -363,11 +368,5 @@ and check_modtypes env mtb1 mtb2 subst1 subst2 equiv = else check_structure env mtb1' mtb2' equiv subst1 subst2 let check_subtypes env sup super = - (*if sup<>super then*) check_modtypes env (strengthen sup sup.typ_mp) super empty_subst - (map_mp super.typ_mp sup.typ_mp) false - -let check_equal env sup super = - (*if sup<>super then*) - check_modtypes env sup super empty_subst - (map_mp super.typ_mp sup.typ_mp) true + (map_mp super.typ_mp sup.typ_mp) false diff --git a/checker/subtyping.mli b/checker/subtyping.mli index d9cbe5ad..ecdf5577 100644 --- a/checker/subtyping.mli +++ b/checker/subtyping.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* module_type_body -> module_type_body -> unit -val check_equal : env -> module_type_body -> module_type_body -> unit diff --git a/checker/term.ml b/checker/term.ml index 61369586..ab40b6fa 100644 --- a/checker/term.ml +++ b/checker/term.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (fun c -> c) | el -> exliftn el @@ -313,22 +312,15 @@ let subst1 lam = substl [lam] (***************************************************************************) let val_ndecl = - val_tuple"named_declaration"[|val_id;val_opt val_constr;val_constr|] + val_tuple ~name:"named_declaration"[|val_id;val_opt val_constr;val_constr|] let val_rdecl = - val_tuple"rel_declaration"[|val_name;val_opt val_constr;val_constr|] + val_tuple ~name:"rel_declaration"[|val_name;val_opt val_constr;val_constr|] let val_nctxt = val_list val_ndecl let val_rctxt = val_list val_rdecl type named_declaration = identifier * constr option * constr type rel_declaration = name * constr option * constr -let map_named_declaration f (id, v, ty) = (id, Option.map f v, f ty) -let map_rel_declaration = map_named_declaration - -let fold_named_declaration f (_, v, ty) a = f ty (Option.fold_right f v a) -let fold_rel_declaration = fold_named_declaration - - type named_context = named_declaration list let empty_named_context = [] let fold_named_context f l ~init = List.fold_right f l init @@ -439,7 +431,6 @@ let decompose_prod_n_assum n = (***************************) type arity = rel_context * sorts -let val_arity = val_tuple"arity"[|val_rctxt;val_constr|] let mkArity (sign,s) = it_mkProd_or_LetIn (Sort s) sign diff --git a/checker/term.mli b/checker/term.mli index 1367e581..0340c79b 100644 --- a/checker/term.mli +++ b/checker/term.mli @@ -12,7 +12,7 @@ type case_printing = { ind_nargs : int; style : case_style; } type case_info = { ci_ind : inductive; ci_npar : int; - ci_cstr_nargs : int array; + ci_cstr_ndecls : int array; ci_pp_info : case_printing; } type contents = Pos | Null @@ -73,14 +73,6 @@ val subst1 : constr -> constr -> constr type named_declaration = identifier * constr option * constr type rel_declaration = name * constr option * constr -val map_named_declaration : - (constr -> constr) -> named_declaration -> named_declaration -val map_rel_declaration : - (constr -> constr) -> rel_declaration -> rel_declaration -val fold_named_declaration : - (constr -> 'a -> 'a) -> named_declaration -> 'a -> 'a -val fold_rel_declaration : - (constr -> 'a -> 'a) -> rel_declaration -> 'a -> 'a type named_context = named_declaration list val empty_named_context : named_context val fold_named_context : @@ -111,8 +103,8 @@ val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool val eq_constr : constr -> constr -> bool (* Validation *) -val val_sortfam : Obj.t -> unit -val val_sort : Obj.t -> unit -val val_constr : Obj.t -> unit -val val_rctxt : Obj.t -> unit -val val_nctxt : Obj.t -> unit +val val_sortfam : Validate.func +val val_sort : Validate.func +val val_constr : Validate.func +val val_rctxt : Validate.func +val val_nctxt : Validate.func diff --git a/checker/type_errors.ml b/checker/type_errors.ml index bd3bb90d..12609832 100644 --- a/checker/type_errors.ml +++ b/checker/type_errors.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unsafe_judgment -> int -> 'a val error_ill_formed_branch : env -> constr -> int -> constr -> constr -> 'a -val error_generalization : env -> name * constr -> unsafe_judgment -> 'a - val error_actual_type : env -> unsafe_judgment -> constr -> 'a val error_cant_apply_not_functional : diff --git a/checker/typeops.ml b/checker/typeops.ml index dffc9fe1..5226db53 100644 --- a/checker/typeops.ml +++ b/checker/typeops.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* error_reference_variables env c - -(* Checks if the given context of variables [hyps] is included in the - current context of [env]. *) -(* -let check_hyps id env hyps = - let hyps' = named_context env in - if not (hyps_inclusion env hyps hyps') then - error_reference_variables env id -*) -(* 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 c with Sort (Type u) -> Some u | _ -> None - -let extract_context_levels env = - List.fold_left - (fun l (_,b,p) -> if b=None then extract_level env p::l else l) [] - -let make_polymorphic_if_arity env t = - let params, ccl = dest_prod_assum env t in - match ccl with - | Sort (Type u) -> - let param_ccls = extract_context_levels env params in - let s = { poly_param_levels = param_ccls; poly_level = u} in - PolymorphicArity (params,s) - | _ -> - NonPolymorphicType t - (* Type of constants *) let type_of_constant_knowing_parameters env t paramtyps = @@ -135,9 +102,6 @@ let type_of_constant_knowing_parameters env t paramtyps = let type_of_constant_type env t = type_of_constant_knowing_parameters env t [||] -let type_of_constant env cst = - type_of_constant_type env (constant_type env cst) - let judge_of_constant_knowing_parameters env cst paramstyp = let c = Const cst in let cb = @@ -291,7 +255,7 @@ let refresh_arity env ar = match hd with Sort (Type u) when not (is_univ_variable u) -> let u' = fresh_local_univ() in - let env' = add_constraints (enforce_geq u' u Constraint.empty) env in + let env' = add_constraints (enforce_geq u' u empty_constraint) env in env', mkArity (ctxt,Type u') | _ -> env, ar @@ -406,12 +370,9 @@ and execute_recdef env (names,lar,vdef) i = and execute_array env = Array.map (execute env) -and execute_list env = List.map (execute env) - (* Derived functions *) let infer env constr = execute env constr let infer_type env constr = execute_type env constr -let infer_v env cv = execute_array env cv (* Typing of several terms. *) diff --git a/checker/typeops.mli b/checker/typeops.mli index f4f29fe5..eafe4735 100644 --- a/checker/typeops.mli +++ b/checker/typeops.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* f ctx) +let ext s f (ctx:error_context) = f (ctx/s) + -let ep s1 f s2 = f (s1^"/"^s2) +exception ValidObjError of string * error_context * Obj.t +let fail ctx o s = raise (ValidObjError(s,ctx,o)) + +type func = error_context -> Obj.t -> unit let apply debug f x = let o = Obj.repr x in - try f o - with ValidObjError(msg,obj) -> + try f mt_ec o + with ValidObjError(msg,ctx,obj) -> if debug then begin print_endline ("Validation failed: "^msg); + print_endline ("Context: "^String.concat"/"(List.rev ctx)); pr_obj obj end; failwith "vo structure validation failed" (* data not validated *) -let no_val (o:Obj.t) = () +let no_val (c:error_context) (o:Obj.t) = () (* Check that object o is a block with tag t *) -let val_tag t o = +let val_tag t ctx o = if Obj.is_block o && Obj.tag o = t then () - else fail o ("expected tag "^string_of_int t) + else fail ctx o ("expected tag "^string_of_int t) -let val_block s o = +let val_block ctx o = if Obj.is_block o then (if Obj.tag o > Obj.no_scan_tag then - fail o (s^": found no scan tag")) - else fail o (s^": expected block obj") + fail ctx o "block: found no scan tag") + else fail ctx o "expected block obj" (* Check that an object is a tuple (or a record). v is an array of validation functions for each field. Its size corresponds to the expected size of the object. *) -let val_tuple s v o = +let val_tuple ?name v ctx o = + let ctx = match name with + Some n -> ctx/n + | _ -> ctx in let n = Array.length v in - val_block ("tuple: "^s) o; - if Obj.size o = n then Array.iteri (fun i f -> f (Obj.field o i)) v + let val_fld i f = + f (ctx/("fld="^string_of_int i)) (Obj.field o i) in + val_block ctx o; + if Obj.size o = n then Array.iteri val_fld v else - fail o ("tuple:" ^s^" size found:"^string_of_int (Obj.size o)) + fail ctx o + ("tuple size: found "^string_of_int (Obj.size o)^ + ", expected "^string_of_int n) (* Check that the object is either a constant constructor of tag < cc, or a constructed variant. each element of vv is an array of @@ -83,70 +96,79 @@ let val_tuple s v o = The size of vv corresponds to the number of non-constant constructors, and the size of vv.(i) is the expected arity of the i-th non-constant constructor. *) -let val_sum s cc vv o = +let val_sum name cc vv ctx o = + let ctx = ctx/name in if Obj.is_block o then - (val_block s o; + (val_block (ctx/name) o; let n = Array.length vv in let i = Obj.tag o in - if i < n then val_tuple (s^"(tag "^string_of_int i^")") vv.(i) o - else fail o ("bad tag in (sum type) "^s^": found "^string_of_int i)) + let ctx' = if n=1 then ctx else ctx/("tag="^string_of_int i) in + if i < n then val_tuple vv.(i) ctx' o + else fail ctx' o ("sum: unexpected tag")) else if Obj.is_int o then let (n:int) = Obj.magic o in (if n<0 || n>=cc then - fail o (s^": bad constant constructor "^string_of_int n)) - else fail o ("not a sum ("^s^")") + fail ctx o ("bad constant constructor "^string_of_int n)) + else fail ctx o "not a sum" let val_enum s n = val_sum s n [||] (* Recursive types: avoid looping by eta-expansion *) -let rec val_rec_sum s cc f o = - val_sum s cc (f (val_rec_sum s cc f)) o - -let rec val_rectype f o = - f (val_rectype f) o +let rec val_rec_sum name cc f ctx o = + val_sum name cc (f (overr (ctx/name) (val_rec_sum name cc f))) ctx o (**************************************************************************) (* Builtin types *) (* Check the o is an array of values satisfying f. *) -let val_array ?(name="array") f o = - val_block name o; +let val_array ?(pos=false) f ctx o = + let upd_ctx = + if pos then (fun i -> ctx/string_of_int i) else (fun _ -> ctx) in + val_block (ctx/"array") o; for i = 0 to Obj.size o - 1 do - (f (Obj.field o i):unit) + (f (upd_ctx i) (Obj.field o i):unit) done (* Integer validator *) -let val_int o = - if not (Obj.is_int o) then fail o "expected an int" +let val_int ctx o = + if not (Obj.is_int o) then fail ctx o "expected an int" (* String validator *) -let val_str o = - try val_tag Obj.string_tag o - with Failure _ -> fail o "expected a string" +let val_str ctx o = + try val_tag Obj.string_tag ctx o + with Failure _ -> fail ctx o "expected a string" (* Booleans *) let val_bool = val_enum "bool" 2 (* Option type *) -let val_opt ?(name="option") f = val_sum name 1 [|[|f|]|] +let val_opt ?(name="option") f = + val_sum name 1 [|[|f|]|] (* Lists *) -let val_list ?(name="list") f = - val_rec_sum name 1 (fun vlist -> [|[|f;vlist|]|]) +let val_list ?(name="list") f ctx = + val_rec_sum name 1 (fun vlist -> [|[|ext "elem" f;vlist|]|]) + ctx (* Reference *) -let val_ref ?(name="ref") f = val_tuple name [|f|] +let val_ref ?(name="ref") f ctx = + val_tuple [|f|] (ctx/name) (**************************************************************************) (* Standard library types *) (* Sets *) let val_set ?(name="Set.t") f = - val_rec_sum name 1 (fun vset -> [|[|vset;f;vset;val_int|]|]) + val_rec_sum name 1 + (fun vset -> [|[|vset;ext "elem" f; + vset;ext "bal" val_int|]|]) (* Maps *) let rec val_map ?(name="Map.t") fk fv = - val_rec_sum name 1 (fun vmap -> [|[|vmap;fk;fv;vmap;val_int|]|]) + val_rec_sum name 1 + (fun vmap -> + [|[|vmap; ext "key" fk; ext "value" fv; + vmap; ext "bal" val_int|]|]) (**************************************************************************) (* Coq types *) @@ -158,19 +180,19 @@ let val_dp = val_list ~name:"dirpath" val_id let val_name = val_sum "name" 1 [|[|val_id|]|] -let val_uid = val_tuple "uniq_ident" [|val_int;val_str;val_dp|] +let val_uid = val_tuple ~name:"uniq_ident" [|val_int;val_str;val_dp|] let val_mp = val_rec_sum "module_path" 0 (fun vmp -> [|[|val_dp|];[|val_uid|];[|vmp;val_id|]|]) -let val_kn = val_tuple "kernel_name" [|val_mp;val_dp;val_id|] +let val_kn = val_tuple ~name:"kernel_name" [|val_mp;val_dp;val_id|] let val_con = - val_tuple "constant/mutind" [|val_kn;val_kn|] + val_tuple ~name:"constant/mutind" [|val_kn;val_kn|] -let val_ind = val_tuple "inductive"[|val_con;val_int|] -let val_cstr = val_tuple "constructor"[|val_ind;val_int|] +let val_ind = val_tuple ~name:"inductive"[|val_con;val_int|] +let val_cstr = val_tuple ~name:"constructor"[|val_ind;val_int|] (* univ *) let val_level = val_sum "level" 1 [|[|val_dp;val_int|]|] @@ -179,5 +201,5 @@ let val_univ = val_sum "univ" 0 let val_cstrs = val_set ~name:"Univ.constraints" - (val_tuple "univ_constraint" + (val_tuple ~name:"univ_constraint" [|val_level;val_enum "order_request" 3;val_level|]) diff --git a/config/Makefile.template b/config/Makefile.template index 8864f52d..91b12cb4 100644 --- a/config/Makefile.template +++ b/config/Makefile.template @@ -34,6 +34,8 @@ BUILDLDPATH= # EMACSDIR=path where to put Coq's Emacs mode (coq.el) BINDIR="BINDIRDIRECTORY" COQLIBINSTALL="COQLIBDIRECTORY" +CONFIGDIR="CONFIGDIRDIRECTORY" +DATADIR="DATADIRDIRECTORY" MANDIR="MANDIRDIRECTORY" DOCDIR="DOCDIRDIRECTORY" EMACSLIB="EMACSLIBDIRECTORY" @@ -56,6 +58,7 @@ CAMLLIB="CAMLLIBDIRECTORY" CAMLHLIB="CAMLLIBDIRECTORY" # Camlp4 library directory (avoid CAMLP4LIB used on Windows) +CAMLP4=CAMLP4VARIANT CAMLP4O=CAMLP4TOOL CAMLP4COMPAT=CAMLP4COMPATFLAGS MYCAMLP4LIB="CAMLP4LIBDIRECTORY" @@ -137,15 +140,13 @@ STRIP=STRIPCOMMAND # CoqIde (no/byte/opt) HASCOQIDE=COQIDEOPT +IDEOPTFLAGS=IDEARCHFLAGS +IDEOPTDEPS=IDEARCHFILE +IDEOPTINT=IDEARCHDEF # Defining REVISION CHECKEDOUT=CHECKEDOUTSOURCETREE -# Defining options to generate dependencies graphs -DOT=dot -DOTOPTS=-Tps -ODOCDOTOPTS=-dot -dot-reduce - # Option to control compilation and installation of the documentation WITHDOC=WITHDOCOPT diff --git a/config/coq_config.mli b/config/coq_config.mli index 6845df7d..35446072 100644 --- a/config/coq_config.mli +++ b/config/coq_config.mli @@ -1,17 +1,17 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* " printf "\tUse to open URL %%s\n" echo "-with-doc (yes|no)" @@ -85,6 +93,8 @@ usage () { printf "\tAdd profiling information in the Coq executables\n" echo "-annotate" printf "\tCompiles Coq with -dtypes option\n" + echo "-makecmd " + printf "\tName of GNU Make command.\n" } @@ -121,6 +131,8 @@ src_spec=no prefix_spec=no bindir_spec=no libdir_spec=no +configdir_spec=no +datadir_spec=no mandir_spec=no docdir_spec=no emacslib_spec=no @@ -130,6 +142,7 @@ lablgtkdir_spec=no coqdocdir_spec=no arch_spec=no coqide_spec=no +nomacintegration_spec=no browser_spec=no wwwcoq_spec=no with_geoproof=false @@ -137,6 +150,7 @@ with_doc=all with_doc_spec=no force_caml_version=no force_caml_version_spec=no +usecamlp5=yes COQSRC=`pwd` @@ -168,6 +182,12 @@ while : ; do -libdir|--libdir) libdir_spec=yes libdir="$2" shift;; + -configdir|--configdir) configdir_spec=yes + configdir="$2" + shift;; + -datadir|--datadir) datadir_spec=yes + datadir="$2" + shift;; -mandir|--mandir) mandir_spec=yes mandir="$2" shift;; @@ -189,7 +209,12 @@ while : ; do -lablgtkdir|--lablgtkdir) lablgtkdir_spec=yes lablgtkdir="$2" shift;; + -usecamlp5|--usecamlp5) + usecamlp5=yes;; + -usecamlp4|--usecamlp4) + usecamlp5=no;; -camlp5dir|--camlp5dir) + usecamlp5=yes camlp5dir="$2" shift;; -arch|--arch) arch_spec=yes @@ -209,6 +234,8 @@ while : ; do *) COQIDE=no esac shift;; + -nomacintegration) nomacintegration_spec=yes + shift;; -browser|--browser) browser_spec=yes BROWSER=$2 shift;; @@ -239,6 +266,8 @@ while : ; do ranlib_spec=yes ranlib_exec=$2 shift;; + -makecmd|--makecmd) makecmd="$2" + shift;; -byte-only|-byteonly|--byteonly|--byte-only) best_compiler=byte;; -debug|--debug) coq_debug_flag=-g;; -profile|--profile) coq_profile_flag=-p;; @@ -273,18 +302,19 @@ case $arch_spec in # First we test if we are running a Cygwin system if [ `uname -s | cut -c -6` = "CYGWIN" ] ; then ARCH="win32" + CYGWIN=yes else # If not, we determine the architecture - if test -x /bin/arch ; then + if test -x /bin/uname ; then + ARCH=`/bin/uname -s` + elif test -x /usr/bin/uname ; then + ARCH=`/usr/bin/uname -s` + elif test -x /bin/arch ; then ARCH=`/bin/arch` elif test -x /usr/bin/arch ; then ARCH=`/usr/bin/arch` elif test -x /usr/ucb/arch ; then ARCH=`/usr/ucb/arch` - elif test -x /bin/uname ; then - ARCH=`/bin/uname -s` - elif test -x /usr/bin/uname ; then - ARCH=`/usr/bin/uname -s` else echo "I can not automatically find the name of your architecture." printf "%s"\ @@ -319,7 +349,7 @@ fi # make command -MAKE=`which make` +MAKE=`which ${makecmd:-make}` if [ "$MAKE" != "" ]; then MAKEVERSION=`$MAKE -v | head -1 | cut -d" " -f3` MAKEVERSIONMAJOR=`echo $MAKEVERSION | cut -d. -f1` @@ -328,6 +358,8 @@ if [ "$MAKE" != "" ]; then echo "You have GNU Make $MAKEVERSION. Good!" else OK="no" + #Extra support for local installation of make 3.81 + #will be useless when make >= 3.81 will be standard if [ -x ./make ]; then MAKEVERSION=`./make -v | head -1` if [ "$MAKEVERSION" = "GNU Make 3.81" ]; then OK="yes"; fi @@ -357,6 +389,7 @@ fi if [ "$browser_spec" = "no" ]; then case $ARCH in win32) BROWSER='C:\PROGRA~1\INTERN~1\IEXPLORE %s' ;; + Darwin) BROWSER='open %s' ;; *) BROWSER='firefox -remote "OpenURL(%s,new-tab)" || firefox %s &' ;; esac fi @@ -412,16 +445,16 @@ esac CAMLVERSION=`"$bytecamlc" -version` case $CAMLVERSION in - 1.*|2.*|3.00|3.01|3.02|3.03|3.03alpha|3.04|3.05beta|3.05|3.06|3.07*|3.08*|3.09*) + 1.*|2.*|3.0*) echo "Your version of Objective-Caml is $CAMLVERSION." if [ "$force_caml_version" = "yes" ]; then echo "*Warning* You are compiling Coq with an outdated version of Objective-Caml." else - echo " You need Objective-Caml 3.10.2 or later." + echo " You need Objective-Caml 3.10.0 or later." echo " Configuration script failed!" exit 1 fi;; - ?*) + 3.1*) CAMLP4COMPAT="-loc loc" echo "You have Objective-Caml $CAMLVERSION. Good!";; *) @@ -458,7 +491,7 @@ else HASNATDYNLINK=false fi -case $HASNATDYNLINK,`uname -s`,`uname -r`,$CAMLVERSION in +case $HASNATDYNLINK,$ARCH,`uname -r`,$CAMLVERSION in true,Darwin,9.*,3.11.*) # ocaml 3.11.0 dynlink on MacOS 10.5 is buggy NATDYNLINKFLAG=os5fixme;; #Possibly a problem on 10.6.0/10.6.1/10.6.2 @@ -483,75 +516,76 @@ esac # Camlp4 / Camlp5 configuration -if [ "$camlp5dir" != "" ]; then +# Assume that camlp(4|5) binaries are at the same place as ocaml ones +# (this should become configurable some day) +CAMLP4BIN=${CAMLBIN} + +if [ "$usecamlp5" = "yes" ]; then CAMLP4=camlp5 - CAMLP4LIB=$camlp5dir - if [ ! -f $camlp5dir/camlp5.cma ]; then - echo "Cannot find camlp5 libraries in $camlp5dir (camlp5.cma not found)." + CAMLP4MOD=gramlib + if [ "$camlp5dir" != "" ]; then + if [ -f "$camlp5dir/${CAMLP4MOD}.cma" ]; then + CAMLP4LIB=$camlp5dir + FULLCAMLP4LIB=$camlp5dir + else + echo "Cannot find camlp5 libraries in $camlp5dir (camlp5.cma not found)." + echo "Configuration script failed!" + exit 1 + fi + elif [ -f "${CAMLLIB}/camlp5/${CAMLP4MOD}.cma" ]; then + CAMLP4LIB=+camlp5 + FULLCAMLP4LIB=${CAMLLIB}/camlp5 + elif [ -f "${CAMLLIB}/site-lib/${CAMLP4MOD}.cma" ]; then + CAMLP4LIB=+site-lib/camlp5 + FULLCAMLP4LIB=${CAMLLIB}/site-lib/camlp5 + else + echo "Objective Caml $CAMLVERSION found but no Camlp5 installed." echo "Configuration script failed!" exit 1 fi + camlp4oexec=`echo $camlp4oexec | sed -e 's/4/5/'` -else - case $CAMLTAG in - OCAML31*) - if [ -x "${CAMLLIB}/camlp5" ]; then - CAMLP4LIB=+camlp5 - elif [ -x "${CAMLLIB}/site-lib/camlp5" ]; then - CAMLP4LIB=+site-lib/camlp5 - else - echo "Objective Caml $CAMLVERSION found but no Camlp5 installed." - echo "Configuration script failed!" - exit 1 - fi - CAMLP4=camlp5 - camlp4oexec=`echo $camlp4oexec | sed -e 's/4/5/'` - ;; - *) - CAMLP4=camlp4 - CAMLP4LIB=+camlp4 - ;; + case `$camlp4oexec -v 2>&1` in + *4.0*|*5.00*) + echo "Camlp5 version < 5.01 not supported." + echo "Configuration script failed!" + exit 1;; esac -fi -if [ "$CAMLP4" = "camlp5" ] && `$camlp4oexec -v 2>&1 | grep -q 5.00`; then - echo "Camlp5 version 5.00 not supported: versions 4.0x or >= 5.01 are OK" - echo "(depending also on your ocaml version)." - echo "Configuration script failed!" - exit 1 -fi +else # let's use camlp4 + CAMLP4=camlp4 + CAMLP4MOD=camlp4lib + CAMLP4LIB=+camlp4 + FULLCAMLP4LIB=${CAMLLIB}/camlp4 + if [ ! -f "${FULLCAMLP4LIB}/${CAMLP4MOD}.cma" ]; then + echo "Objective Caml $CAMLVERSION found but no Camlp4 installed." + echo "Configuration script failed!" + exit 1 + fi -case $CAMLP4LIB in - +*) FULLCAMLP4LIB=$CAMLLIB/`echo $CAMLP4LIB | cut -b 2-`;; - *) FULLCAMLP4LIB=$CAMLP4LIB;; -esac - -# Assume that camlp(4|5) binaries are at the same place as ocaml ones -# (this should become configurable some day) -CAMLP4BIN=${CAMLBIN} + camlp4oexec=${camlp4oexec}rf + if [ "`$camlp4oexec 2>&1`" != "" ]; then + echo "Error: $camlp4oexec not found or not executable." + echo "Configuration script failed!" + exit 1 + fi +fi # do we have a native compiler: test of ocamlopt and its version if [ "$best_compiler" = "opt" ] ; then if test -e "$nativecamlc" || test -e "`which $nativecamlc`"; then CAMLOPTVERSION=`"$nativecamlc" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` - if [ "`uname -s`" = "Darwin" -a "$ARCH" = "i386" ]; then - case $CAMLOPTVERSION in - 3.09.3|3.1?*) ;; - *) echo "Native compilation on MacOS X Pentium requires Objective-Caml >= 3.09.3," - best_compiler=byte - echo "only the bytecode version of Coq will be available." - esac - elif [ ! -f $FULLCAMLP4LIB/gramlib.cmxa ]; then + if [ ! -f "${FULLCAMLP4LIB}/${CAMLP4MOD}.cmxa" ]; then best_compiler=byte echo "Cannot find native-code $CAMLP4," echo "only the bytecode version of Coq will be available." else - if [ "$CAMLOPTVERSION" != "$CAMLVERSION" ] ; then - echo "Native and bytecode compilers do not have the same version!" - fi - echo "You have native-code compilation. Good!" + if [ "$CAMLOPTVERSION" != "$CAMLVERSION" ] ; then + echo "Native and bytecode compilers do not have the same version!" + fi + echo "You have native-code compilation. Good!" fi else best_compiler=byte @@ -569,7 +603,6 @@ case $ARCH in *) OS="Sun OS $OS" OSDEPLIBS="-cclib -lunix" esac;; - alpha) OSDEPLIBS="-cclib -lunix";; win32) OS="Win32" OSDEPLIBS="-cclib -lunix" cflags="-mno-cygwin $cflags";; @@ -578,6 +611,10 @@ esac # lablgtk2 and CoqIDE +IDEARCHFLAGS= +IDEARCHFILE= +IDEARCHDEF=X11 + # -byte-only should imply -coqide byte, unless the user decides otherwise if [ "$best_compiler" = "byte" -a "$coqide_spec" = "no" ]; then @@ -616,9 +653,21 @@ else elif [ ! -f "${CAMLLIB}/threads/threads.cmxa" ]; then echo "LablGtk2 found, no native threads: bytecode CoqIde will be available." COQIDE=byte - else - echo "LablGtk2 found, native threads: native CoqIde will be available." + else + echo "LablGtk2 found, native threads: native CoqIde will be available." COQIDE=opt + if [ "$nomacintegration_spec" = "no" ] && pkg-config --exists ige-mac-integration; + then + cflags=$cflags" `pkg-config --cflags ige-mac-integration`" + IDEARCHFLAGS='-ccopt "`pkg-config --libs ige-mac-integration`"' + IDEARCHFILE=ide/ide_mac_stubs.o + IDEARCHDEF=QUARTZ + elif [ "$ARCH" = "win32" ]; + then + IDEARCHFLAGS= + IDEARCHFILE=ide/ide_win32_stubs.o + IDEARCHDEF=WIN32 + fi fi fi @@ -627,8 +676,8 @@ case $COQIDE in case $lablgtkdir_spec in no) LABLGTKLIB=+lablgtk2 # Pour le message LABLGTKINCLUDES="-I $LABLGTKLIB";; # Pour le makefile - yes) LABLGTKLIB="$lablgtkdir" # Pour le message - LABLGTKINCLUDES="-I \"$LABLGTKLIB\"";; # Pour le makefile + yes) LABLGTKLIB=$lablgtkdir # Pour le message + LABLGTKINCLUDES="-I $LABLGTKLIB";; # Pour le makefile esac;; no) LABLGTKINCLUDES="";; esac @@ -639,9 +688,14 @@ case $ARCH in win32) # true -> strip : it exists under cygwin ! STRIPCOMMAND="strip";; + Darwin) if [ "$HASNATDYNLINK" = "true" ] + then + STRIPCOMMAND="true" + else + STRIPCOMMAND="strip" + fi;; *) - if [ "$coq_profile_flag" = "-p" ] || [ "$coq_debug_flag" = "-g" ] || - [ "`uname -s`" = "Darwin" -a "$HASNATDYNLINK" = "true" ] + if [ "$coq_profile_flag" = "-p" ] || [ "$coq_debug_flag" = "-g" ] then STRIPCOMMAND="true" else @@ -682,18 +736,23 @@ case $ARCH in win32) COQTOP=`cygpath -m ${COQTOP}` esac -case $ARCH in +case $ARCH$CYGWIN in win32) - bindir_def='C:\coq\bin' - libdir_def='C:\coq\lib' - mandir_def='C:\coq\man' - docdir_def='C:\coq\doc' - emacslib_def='C:\coq\emacs' - coqdocdir_def='C:\coq\latex';; + W32PREF='C:\\coq\\' + bindir_def=${W32PREF}bin + libdir_def=${W32PREF}lib + configdir_def=${W32PREF}config + datadir_def=${W32PREF}data + mandir_def=${W32PREF}man + docdir_def=${W32PREF}doc + emacslib_def=${W32PREF}emacs + coqdocdir_def=${W32PREF}latex;; *) bindir_def=/usr/local/bin libdir_def=/usr/local/lib/coq - mandir_def=/usr/local/man + configdir_def=/etc/xdg/coq + datadir_def=/usr/local/share/coq + mandir_def=/usr/local/share/man docdir_def=/usr/local/share/doc/coq emacslib_def=/usr/local/share/emacs/site-lisp coqdocdir_def=/usr/local/share/texmf/tex/latex/misc;; @@ -716,6 +775,7 @@ esac case $libdir_spec/$prefix_spec/$local in yes/*/*) LIBDIR=$libdir;; */yes/*) + libdir_spec=yes case $ARCH in win32) LIBDIR=$prefix ;; *) LIBDIR=$prefix/lib/coq ;; @@ -723,15 +783,57 @@ case $libdir_spec/$prefix_spec/$local in */*/true) LIBDIR=$COQTOP ;; *) printf "Where should I install the Coq library [$libdir_def]? " read LIBDIR + libdir_spec=yes case $LIBDIR in "") LIBDIR=$libdir_def;; *) true;; esac;; esac +case $libdir_spec in + yes) LIBDIR_OPTION="Some \"$LIBDIR\"";; + *) LIBDIR_OPTION="None";; +esac + +case $configdir_spec/$local in + yes/*) CONFIGDIR=$configdir;; + */true) CONFIGDIR=$COQTOP/ide + configdir_spec=yes;; + *) printf "Where should I install the Coqide configuration files [$configdir_def]? " + read CONFIGDIR + case $CONFIGDIR in + "") CONFIGDIR=$configdir_def;; + *) configdir_spec=yes;; + esac;; +esac + +case $configdir_spec in + yes) CONFIGDIR_OPTION="Some \"$CONFIGDIR\"";; + *) CONFIGDIR_OPTION="None";; +esac + +case $datadir_spec/$prefix_spec/$local in + yes/*/*) DATADIR=$datadir;; + */yes/*) DATADIR=$prefix/share/coq;; + */*/true) DATADIR=$COQTOP/ide + datadir_spec=yes;; + *) printf "Where should I install the Coqide data files [$datadir_def]? " + read DATADIR + case $DATADIR in + "") DATADIR=$datadir_def;; + *) datadir_spec=yes;; + esac;; +esac + +case $datadir_spec in + yes) DATADIR_OPTION="Some \"$DATADIR\"";; + *) DATADIR_OPTION="None";; +esac + + case $mandir_spec/$prefix_spec/$local in yes/*/*) MANDIR=$mandir;; - */yes/*) MANDIR=$prefix/man ;; + */yes/*) MANDIR=$prefix/share/man ;; */*/true) MANDIR=$COQTOP/man ;; *) printf "Where should I install the Coq man pages [$mandir_def]? " read MANDIR @@ -742,13 +844,13 @@ case $mandir_spec/$prefix_spec/$local in esac case $docdir_spec/$prefix_spec/$local in - yes/*/*) DOCDIR=$docdir; HTMLREFMANDIR=$DOCDIR/html/refman;; - */yes/*) DOCDIR=$prefix/share/doc/coq; HTMLREFMANDIR=$DOCDIR/html/refman;; - */*/true) DOCDIR=$COQTOP/doc; HTMLREFMANDIR=$DOCDIR/refman/html;; + yes/*/*) DOCDIR=$docdir;; + */yes/*) DOCDIR=$prefix/share/doc/coq;; + */*/true) DOCDIR=$COQTOP/doc;; *) printf "Where should I install the Coq documentation [$docdir_def]? " read DOCDIR case $DOCDIR in - "") DOCDIR=$docdir_def; HTMLREFMANDIR=$DOCDIR/html/refman;; + "") DOCDIR=$docdir_def;; *) true;; esac;; esac @@ -787,7 +889,7 @@ esac # Determine if we enable -custom by default (Windows and MacOS) CUSTOM_OS=no -if [ "$ARCH" = "win32" ] || [ "`uname -s`" = "Darwin" ]; then +if [ "$ARCH" = "win32" ] || [ "$ARCH" = "Darwin" ]; then CUSTOM_OS=yes fi @@ -841,6 +943,9 @@ fi if test "$COQIDE" != "no"; then echo " Lablgtk2 library in : $LABLGTKLIB" fi +if test "$IDEARCHDEF" = "QUARTZ"; then +echo " Mac OS integration is on" +fi if test "$with_doc" = "all"; then echo " Documentation : All" else @@ -854,6 +959,8 @@ echo "" echo " Paths for true installation:" echo " binaries will be copied in $BINDIR" echo " library will be copied in $LIBDIR" +echo " config files will be copied in $CONFIGDIR" +echo " data files will be copied in $DATADIR" echo " man pages will be copied in $MANDIR" echo " documentation will be copied in $DOCDIR" echo " emacs mode will be copied in $EMACSLIB" @@ -923,6 +1030,8 @@ case $ARCH in BINDIR=`echo $BINDIR |sed -e 's|\\\|\\\\\\\|g'` COQSRC=`cygpath -m $COQSRC |sed -e 's|\\\|\\\\\\\|g'` LIBDIR=`echo $LIBDIR |sed -e 's|\\\|\\\\\\\|g'` + CONFIGDIR=`echo $CONFIGDIR |sed -e 's|\\\|\\\\\\\|g'` + DATADIR=`echo $DATADIR |sed -e 's|\\\|\\\\\\\|g'` CAMLBIN=`echo $CAMLBIN |sed -e 's|\\\|\\\\\\\|g'` CAMLLIB=`echo $CAMLLIB |sed -e 's|\\\|\\\\\\\|g'` MANDIR=`echo $MANDIR |sed -e 's|\\\|\\\\\\\|g'` @@ -957,8 +1066,10 @@ cat << END_OF_COQ_CONFIG > $mlconfig_file let local = $local let coqrunbyteflags = "$COQRUNBYTEFLAGS" -let coqlib = "$LIBDIR" -let coqsrc = "$COQSRC" +let coqlib = $LIBDIR_OPTION +let configdir = $CONFIGDIR_OPTION +let datadir = $DATADIR_OPTION +let docdir = "$DOCDIR" let ocaml = "$ocamlexec" let ocamlc = "$bytecamlc" let ocamlopt = "$nativecamlc" @@ -979,6 +1090,7 @@ let cflags = "$cflags" let best = "$best_compiler" let arch = "$ARCH" let has_coqide = "$COQIDE" +let gtk_platform = \`$IDEARCHDEF let has_natdynlink = $HASNATDYNLINK let natdynlinkflag = "$NATDYNLINKFLAG" let osdeplibs = "$OSDEPLIBS" @@ -994,7 +1106,7 @@ let browser = "$BROWSER" let wwwcoq = "$WWWCOQ" let wwwrefman = wwwcoq ^ "distrib/" ^ version ^ "/refman/" let wwwstdlib = wwwcoq ^ "distrib/" ^ version ^ "/stdlib/" -let localwwwrefman = "file://$HTMLREFMANDIR/" +let localwwwrefman = "file:/" ^ docdir ^ "html/refman" END_OF_COQ_CONFIG @@ -1030,6 +1142,8 @@ sed -e "s|LOCALINSTALLATION|$local|" \ -e "s|COQVERSION|$VERSION|" \ -e "s|BINDIRDIRECTORY|$BINDIR|" \ -e "s|COQLIBDIRECTORY|$LIBDIR|" \ + -e "s|CONFIGDIRDIRECTORY|$CONFIGDIR|" \ + -e "s|DATADIRDIRECTORY|$DATADIR|" \ -e "s|BUILDLDPATH=|$BUILDLDPATH|" \ -e "s|MANDIRDIRECTORY|$MANDIR|" \ -e "s|DOCDIRDIRECTORY|$DOCDIR|" \ @@ -1042,6 +1156,7 @@ sed -e "s|LOCALINSTALLATION|$local|" \ -e "s|OSDEPENDENTP4OPTFLAGS|$OSDEPP4OPTFLAGS|" \ -e "s|CAMLLIBDIRECTORY|$CAMLLIB|" \ -e "s|CAMLTAG|$CAMLTAG|" \ + -e "s|CAMLP4VARIANT|$CAMLP4|" \ -e "s|CAMLP4BINDIRECTORY|$CAMLP4BIN|" \ -e "s|CAMLP4LIBDIRECTORY|$CAMLP4LIB|" \ -e "s|CAMLP4TOOL|$camlp4oexec|" \ @@ -1069,6 +1184,9 @@ sed -e "s|LOCALINSTALLATION|$local|" \ -e "s|RANLIBEXEC|$ranlib_exec|" \ -e "s|STRIPCOMMAND|$STRIPCOMMAND|" \ -e "s|COQIDEOPT|$COQIDE|" \ + -e "s|IDEARCHFLAGS|$IDEARCHFLAGS|" \ + -e "s|IDEARCHFILE|$IDEARCHFILE|" \ + -e "s|IDEARCHDEF|$IDEARCHDEF|" \ -e "s|CHECKEDOUTSOURCETREE|$checkedout|" \ -e "s|WITHDOCOPT|$with_doc|" \ -e "s|HASNATIVEDYNLINK|$NATDYNLINKFLAG|" \ @@ -1085,4 +1203,3 @@ echo echo "*Warning* To compile the system for a new architecture" echo " don't forget to do a 'make archclean' before './configure'." -# $Id: configure 14833 2011-12-19 21:57:30Z notin $ diff --git a/coq.itarget b/coq.itarget index 7488f421..dd8b2590 100644 --- a/coq.itarget +++ b/coq.itarget @@ -1,3 +1,8 @@ -binaries -plugins/plugins.otarget +# NB: for the moment we start with bytecode compilation +# for early error detection in .ml +binariesbyte +plugins/pluginsbyte.otarget +binariesopt +plugins/pluginsopt.otarget theories/theories.otarget +plugins/pluginsvo.otarget diff --git a/dev/Makefile.oug b/dev/Makefile.oug new file mode 100644 index 00000000..ee69ea80 --- /dev/null +++ b/dev/Makefile.oug @@ -0,0 +1,74 @@ +####################################################################### +# v # The Coq Proof Assistant / The Coq Development Team # +# " --useless-elements $@ + +core_intf.oug: + $(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(COREML) $(COREMLI) + +core_intf.useless: core_intf.oug + $(OUG) --load-data $< --no-reduce --print-loc --roots "" --useless-elements $@ + +# Analysis of coqchk, considering only files in the checker/ subdir + +CHECKERML:=$(call local_ml_of_cma,checker/check.cma) +CHECKERMLI:=$(call mli_of_ml,$(CHECKERML)) + +## BUG: in oug, include dirs have reversed priority compared with ocaml, cannot use CHKLIBS +MYCHKINCL:=$(MLINCLUDES) -I checker + +checker.oug: + $(OUG) --dump-data $@ -rectypes $(MYCHKINCL) $(CHECKERML) #$(CHECKERMLI) + +checker.useless: checker.oug + $(OUG) --load-data $< --no-reduce --print-loc --roots "" --useless-elements $@ + +# Analysis of extraction + +EXTRACTIONML:=$(call local_ml_of_cma,$(EXTRACTIONCMA)) +EXTRACTIONMLI:=$(call mli_of_ml,$(EXTRACTIONMLI)) + +extraction.oug: + $(OUG) --dump-data $@ -rectypes $(MLINCLUDES) $(EXTRACTIONML) #$(EXTRACTIONMLI) + +extraction.useless: extraction.oug + $(OUG) --load-data $< --no-reduce --print-loc --useless-elements $@ + +# More to come ... \ No newline at end of file diff --git a/dev/README b/dev/README index 0e40e820..5edf64c8 100644 --- a/dev/README +++ b/dev/README @@ -32,16 +32,14 @@ perf-analysis: analysis of perfs measured on the compilation of user contribs cic.dtd: official dtd of the calc. of ind. constr. for im/ex-portation -Documentation of ML interfaces using tex (directory ocamlweb-doc) +Documentation of ML interfaces using ocamldoc (directory ocamldoc/html) ---------------------------------------- - -go in directory and call "make" +"make mli-doc" in coq root directory. Other development tools (directory tools) ----------------------- -univdot: produces a graph of CIC universes Makefile.dir: makefile dedicated to intensive work in a given directory Makefile.subdir: makefile dedicated to intensive work in a given subdirectory Makefile.devel: utilities to automatically launch coq in various states diff --git a/dev/base_include b/dev/base_include index 05e87da1..d1125965 100644 --- a/dev/base_include +++ b/dev/base_include @@ -24,7 +24,6 @@ #install_printer (* identifier *) ppidset;; #install_printer (* Intset.t *) ppintset;; #install_printer (* label *) pplab;; -(*#install_printer (* mod_self_id *) ppmsid;;*) #install_printer (* mod_bound_id *) ppmbid;; #install_printer (* dir_path *) ppdir;; #install_printer (* module_path *) ppmp;; @@ -38,7 +37,6 @@ #install_printer (* values *) ppvalues;; #install_printer (* Idpred.t *) pp_idpred;; #install_printer (* Cpred.t *) pp_cpred;; -#install_printer (* transparent_state *) pp_transparent_state;; #install_printer ppzipper;; #install_printer ppstack;; #install_printer ppatom;; @@ -78,7 +76,8 @@ open Pretyping.Default.Cases open Cbv open Classops open Clenv -open Rawterm +open Clenvtac +open Glob_term open Coercion open Coercion.Default open Recordops @@ -110,11 +109,9 @@ open Topconstr open Prettyp open Search -open Clenvtac open Evar_refiner open Logic open Pfedit -open Proof_trees open Proof_type open Redexpr open Refiner @@ -172,7 +169,7 @@ let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;; let parse_tac = Pcoq.parse_string Pcoq.Tactic.tactic;; let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;; -(* build a term of type rawconstr without type-checking or resolution of +(* build a term of type glob_constr without type-checking or resolution of implicit syntax *) let e s = @@ -190,18 +187,22 @@ open Declarations;; let constbody_of_string s = let b = Global.lookup_constant (Nametab.locate_constant (qualid_of_string s)) in - Option.get b.const_body;; + Option.get (body_of_constant b);; (* Get the current goal *) - +(* let getgoal x = top_goal_of_pftreestate (Pfedit.get_pftreestate x);; let get_nth_goal n = nth_goal_of_pftreestate n (Pfedit.get_pftreestate ());; let current_goal () = get_nth_goal 1;; - +*) let pf_e gl s = Constrintern.interp_constr (project gl) (pf_env gl) (parse_constr s);; open Toplevel let go = loop +let _ = + print_string + ("\n\tOcaml toplevel with Coq printers and utilities (use go();; to exit)\n\n"); + flush_all() diff --git a/dev/db b/dev/db index 22b76605..63c98bb6 100644 --- a/dev/db +++ b/dev/db @@ -6,7 +6,6 @@ install_printer Top_printers.ppidset install_printer Top_printers.ppevarsubst install_printer Top_printers.ppintset install_printer Top_printers.pplab -install_printer Top_printers.ppmbid install_printer Top_printers.ppdir install_printer Top_printers.ppmp install_printer Top_printers.ppkn @@ -18,7 +17,7 @@ install_printer Top_printers.ppclindex install_printer Top_printers.ppbigint install_printer Top_printers.pppattern -install_printer Top_printers.pprawconstr +install_printer Top_printers.ppglob_constr install_printer Top_printers.ppconstr install_printer Top_printers.ppuni @@ -28,16 +27,13 @@ install_printer Top_printers.pptype install_printer Top_printers.ppj install_printer Top_printers.ppenv -install_printer Top_printers.ppgoal -install_printer Top_printers.ppsigmagoal -install_printer Top_printers.pproof install_printer Top_printers.ppmetas install_printer Top_printers.ppevm -install_printer Top_printers.ppclenv +install_printer Top_printers.ppgoal install_printer Top_printers.pptac install_printer Top_printers.ppobj install_printer Top_printers.pploc install_printer Top_printers.prsubst install_printer Top_printers.prdelta -install_printer Top_printers.ppconstr +install_printer Top_printers.ppfconstr diff --git a/dev/db_printers.ml b/dev/db_printers.ml index 883103c3..b3edd7d0 100644 --- a/dev/db_printers.ml +++ b/dev/db_printers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* `x+(-y) = 0` +Zabs_eq: (x:Z)`0 <= x`->`|x| = x` +Zeven_div2: (x:Z)(Zeven x)->`x = 2*(Zdiv2 x)` +Zodd_div2: (x:Z)`x >= 0`->(Zodd x)->`x = 2*(Zdiv2 x)+1` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zgt_left_rev: (x,y:Z)`x+(-y) > 0`->`x > y` +Zgt_left_gt: (x,y:Z)`x > y`->`x+(-y) > 0` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +Zlt_left_rev: (x,y:Z)`0 < y+(-x)`->`x < y` +Zlt_left_lt: (x,y:Z)`x < y`->`0 < y+(-x)` +Zlt_O_minus_lt: (n,m:Z)`0 < n-m`->`m < n` +>> +*) + +(** Lemmas ending by Zle *) +(** +<< +Zle_left: (x,y:Z)`x <= y`->`0 <= y+(-x)` +Zle_left_rev: (x,y:Z)`0 <= y+(-x)`->`x <= y` +Zlt_left: (x,y:Z)`x < y`->`0 <= y+(-1)+(-x)` +Zge_left: (x,y:Z)`x >= y`->`0 <= x+(-y)` +Zgt_left: (x,y:Z)`x > y`->`0 <= x+(-1)+(-y)` +>> +*) + +(** ** Conversion between nat comparisons and Z comparisons *) + +(** Lemmas ending by eq *) +(** +<< +inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)` +>> +*) + +(** Lemmas ending by Zge *) +(** +<< +inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)` +>> +*) + +(** Lemmas ending by Zle *) +(** +<< +inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)` +>> +*) + +(** ** Conversion between comparisons *) + +(** Lemmas ending by Zge *) +(** +<< +not_Zlt: (x,y:Z)~`x < y`->`x >= y` +Zle_ge: (m,n:Z)`m <= n`->`n >= m` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zle_gt_S: (n,p:Z)`n <= p`->`(Zs p) > n` +not_Zle: (x,y:Z)~`x <= y`->`x > y` +Zlt_gt: (m,n:Z)`m < n`->`n > m` +Zle_S_gt: (n,m:Z)`(Zs n) <= m`->`m > n` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +not_Zge: (x,y:Z)~`x >= y`->`x < y` +Zgt_lt: (m,n:Z)`m > n`->`n < m` +Zle_lt_n_Sm: (n,m:Z)`n <= m`->`n < (Zs m)` +>> +*) + +(** Lemmas ending by Zle *) +(** +<< +Zlt_ZERO_pred_le_ZERO: (x:Z)`0 < x`->`0 <= (Zpred x)` +not_Zgt: (x,y:Z)~`x > y`->`x <= y` +Zgt_le_S: (n,p:Z)`p > n`->`(Zs n) <= p` +Zgt_S_le: (n,p:Z)`(Zs p) > n`->`n <= p` +Zge_le: (m,n:Z)`m >= n`->`n <= m` +Zlt_le_S: (n,p:Z)`n < p`->`(Zs n) <= p` +Zlt_n_Sm_le: (n,m:Z)`n < (Zs m)`->`n <= m` +Zlt_le_weak: (n,m:Z)`n < m`->`n <= m` +Zle_refl: (n,m:Z)`n = m`->`n <= m` +>> +*) + +(** ** Irreversible simplification involving several comparaisons *) +(** useful with clear precedences *) + +(** Lemmas ending by Zlt *) +(** +<< +Zlt_le_reg :(a,b,c,d:Z)`a < b`->`c <= d`->`a+c < b+d` +Zle_lt_reg : (a,b,c,d:Z)`a <= b`->`c < d`->`a+c < b+d` +>> +*) + +(** ** What is decreasing here ? *) + +(** Lemmas ending by eq *) +(** +<< +Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)` +>> +*) + +(**********************************************************************) +(** * Useful Bottom-up lemmas *) + +(** ** Bottom-up simplification: should be used *) + +(** Lemmas ending by eq *) +(** +<< +Zeq_add_S: (n,m:Z)`(Zs n) = (Zs m)`->`n = m` +Zsimpl_plus_l: (n,m,p:Z)`n+m = n+p`->`m = p` +Zplus_unit_left: (n,m:Z)`n+0 = m`->`n = m` +Zplus_unit_right: (n,m:Z)`n = m+0`->`n = m` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zsimpl_gt_plus_l: (n,m,p:Z)`p+n > p+m`->`n > m` +Zsimpl_gt_plus_r: (n,m,p:Z)`n+p > m+p`->`n > m` +Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +Zsimpl_lt_plus_l: (n,m,p:Z)`p+n < p+m`->`n < m` +Zsimpl_lt_plus_r: (n,m,p:Z)`n+p < m+p`->`n < m` +Zlt_S_n: (n,m:Z)`(Zs n) < (Zs m)`->`n < m` +>> +*) + +(** Lemmas ending by Zle *) +(** << Zsimpl_le_plus_l: (p,n,m:Z)`p+n <= p+m`->`n <= m` +Zsimpl_le_plus_r: (p,n,m:Z)`n+p <= m+p`->`n <= m` +Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` >> *) + +(** ** Bottom-up irreversible (syntactic) simplification *) + +(** Lemmas ending by Zle *) +(** +<< +Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m` +>> +*) + +(** ** Other unclearly simplifying lemmas *) + +(** Lemmas ending by Zeq *) +(** +<< +Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0` +>> +*) + +(* Lemmas ending by Zgt *) +(** +<< +Zmult_gt: (x,y:Z)`x > 0`->`x*y > 0`->`y > 0` +>> +*) + +(* Lemmas ending by Zlt *) +(** +<< +pZmult_lt: (x,y:Z)`x > 0`->`0 < y*x`->`0 < y` +>> +*) + +(* Lemmas ending by Zle *) +(** +<< +Zmult_le: (x,y:Z)`x > 0`->`0 <= y*x`->`0 <= y` +OMEGA1: (x,y:Z)`x = y`->`0 <= x`->`0 <= y` +>> +*) + + +(**********************************************************************) +(** * Irreversible lemmas with meta-variables *) +(** To be used by EAuto *) + +(* Hints Immediate *) +(** Lemmas ending by eq *) +(** +<< +Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m` +>> +*) + +(** Lemmas ending by Zge *) +(** +<< +Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zgt_trans: (n,m,p:Z)`n > m`->`m > p`->`n > p` +Zgt_trans_S: (n,m,p:Z)`(Zs n) > m`->`m > p`->`n > p` +Zle_gt_trans: (n,m,p:Z)`m <= n`->`m > p`->`n > p` +Zgt_le_trans: (n,m,p:Z)`n > m`->`p <= m`->`n > p` +>> +*) + +(** Lemmas ending by Zlt *) +(** +<< +Zlt_trans: (n,m,p:Z)`n < m`->`m < p`->`n < p` +Zlt_le_trans: (n,m,p:Z)`n < m`->`m <= p`->`n < p` +Zle_lt_trans: (n,m,p:Z)`n <= m`->`m < p`->`n < p` +>> +*) + +(** Lemmas ending by Zle *) +(** +<< +Zle_trans: (n,m,p:Z)`n <= m`->`m <= p`->`n <= p` +>> +*) + + +(**********************************************************************) +(** * Unclear or too specific lemmas *) +(** Not to be used ? *) + +(** ** Irreversible and too specific (not enough regular) *) + +(** Lemmas ending by Zle *) +(** +<< +Zle_mult: (x,y:Z)`x > 0`->`0 <= y`->`0 <= y*x` +Zle_mult_approx: (x,y,z:Z)`x > 0`->`z > 0`->`0 <= y`->`0 <= y*x+z` +OMEGA6: (x,y,z:Z)`0 <= x`->`y = 0`->`0 <= x+y*z` +OMEGA7: (x,y,z,t:Z)`z > 0`->`t > 0`->`0 <= x`->`0 <= y`->`0 <= x*z+y*t` +>> +*) + +(** ** Expansion and too specific ? *) + +(** Lemmas ending by Zge *) +(** +<< +Zge_mult_simpl: (a,b,c:Z)`c > 0`->`a*c >= b*c`->`a >= b` +>> +*) + +(** Lemmas ending by Zgt *) +(** +<< +Zgt_mult_simpl: (a,b,c:Z)`c > 0`->`a*c > b*c`->`a > b` +Zgt_square_simpl: (x,y:Z)`x >= 0`->`y >= 0`->`x*x > y*y`->`x > y` +>> +*) + +(** Lemmas ending by Zle *) +(** +<< +Zle_mult_simpl: (a,b,c:Z)`c > 0`->`a*c <= b*c`->`a <= b` +Zmult_le_approx: (x,y,z:Z)`x > 0`->`x > z`->`0 <= y*x+z`->`0 <= y` +>> +*) + +(** ** Reversible but too specific ? *) + +(** Lemmas ending by Zlt *) +(** +<< +Zlt_minus: (n,m:Z)`0 < m`->`n-m < n` +>> +*) + +(**********************************************************************) +(** * Lemmas to be used as rewrite rules *) +(** but can also be used as hints *) + +(** Left-to-right simplification lemmas (a symbol disappears) *) + +(** +<< +Zcompare_n_S: (n,m:Z)(Zcompare (Zs n) (Zs m))=(Zcompare n m) +Zmin_n_n: (n:Z)`(Zmin n n) = n` +Zmult_1_n: (n:Z)`1*n = n` +Zmult_n_1: (n:Z)`n*1 = n` +Zminus_plus: (n,m:Z)`n+m-n = m` +Zle_plus_minus: (n,m:Z)`n+(m-n) = m` +Zopp_Zopp: (x:Z)`(-(-x)) = x` +Zero_left: (x:Z)`0+x = x` +Zero_right: (x:Z)`x+0 = x` +Zplus_inverse_r: (x:Z)`x+(-x) = 0` +Zplus_inverse_l: (x:Z)`(-x)+x = 0` +Zopp_intro: (x,y:Z)`(-x) = (-y)`->`x = y` +Zmult_one: (x:Z)`1*x = x` +Zero_mult_left: (x:Z)`0*x = 0` +Zero_mult_right: (x:Z)`x*0 = 0` +Zmult_Zopp_Zopp: (x,y:Z)`(-x)*(-y) = x*y` +>> +*) + +(** Right-to-left simplification lemmas (a symbol disappears) *) + +(** +<< +Zpred_Sn: (m:Z)`m = (Zpred (Zs m))` +Zs_pred: (n:Z)`n = (Zs (Zpred n))` +Zplus_n_O: (n:Z)`n = n+0` +Zmult_n_O: (n:Z)`0 = n*0` +Zminus_n_O: (n:Z)`n = n-0` +Zminus_n_n: (n:Z)`0 = n-n` +Zred_factor6: (x:Z)`x = x+0` +Zred_factor0: (x:Z)`x = x*1` +>> +*) + +(** Unclear orientation (no symbol disappears) *) + +(** +<< +Zplus_n_Sm: (n,m:Z)`(Zs (n+m)) = n+(Zs m)` +Zmult_n_Sm: (n,m:Z)`n*m+n = n*(Zs m)` +Zmin_SS: (n,m:Z)`(Zs (Zmin n m)) = (Zmin (Zs n) (Zs m))` +Zplus_assoc_l: (n,m,p:Z)`n+(m+p) = n+m+p` +Zplus_assoc_r: (n,m,p:Z)`n+m+p = n+(m+p)` +Zplus_permute: (n,m,p:Z)`n+(m+p) = m+(n+p)` +Zplus_Snm_nSm: (n,m:Z)`(Zs n)+m = n+(Zs m)` +Zminus_plus_simpl: (n,m,p:Z)`n-m = p+n-(p+m)` +Zminus_Sn_m: (n,m:Z)`(Zs (n-m)) = (Zs n)-m` +Zmult_plus_distr_l: (n,m,p:Z)`(n+m)*p = n*p+m*p` +Zmult_minus_distr: (n,m,p:Z)`(n-m)*p = n*p-m*p` +Zmult_assoc_r: (n,m,p:Z)`n*m*p = n*(m*p)` +Zmult_assoc_l: (n,m,p:Z)`n*(m*p) = n*m*p` +Zmult_permute: (n,m,p:Z)`n*(m*p) = m*(n*p)` +Zmult_Sm_n: (n,m:Z)`n*m+m = (Zs n)*m` +Zmult_Zplus_distr: (x,y,z:Z)`x*(y+z) = x*y+x*z` +Zmult_plus_distr: (n,m,p:Z)`(n+m)*p = n*p+m*p` +Zopp_Zplus: (x,y:Z)`(-(x+y)) = (-x)+(-y)` +Zplus_sym: (x,y:Z)`x+y = y+x` +Zplus_assoc: (x,y,z:Z)`x+(y+z) = x+y+z` +Zmult_sym: (x,y:Z)`x*y = y*x` +Zmult_assoc: (x,y,z:Z)`x*(y*z) = x*y*z` +Zopp_Zmult: (x,y:Z)`(-x)*y = (-(x*y))` +Zplus_S_n: (x,y:Z)`(Zs x)+y = (Zs (x+y))` +Zopp_one: (x:Z)`(-x) = x*(-1)` +Zopp_Zmult_r: (x,y:Z)`(-(x*y)) = x*(-y)` +Zmult_Zopp_left: (x,y:Z)`(-x)*y = x*(-y)` +Zopp_Zmult_l: (x,y:Z)`(-(x*y)) = (-x)*y` +Zred_factor1: (x:Z)`x+x = x*2` +Zred_factor2: (x,y:Z)`x+x*y = x*(1+y)` +Zred_factor3: (x,y:Z)`x*y+x = x*(1+y)` +Zred_factor4: (x,y,z:Z)`x*y+x*z = x*(y+z)` +Zminus_Zplus_compatible: (x,y,n:Z)`x+n-(y+n) = x-y` +Zmin_plus: (x,y,n:Z)`(Zmin (x+n) (y+n)) = (Zmin x y)+n` +>> +*) + +(** nat <-> Z *) +(** +<< +inj_S: (y:nat)`(inject_nat (S y)) = (Zs (inject_nat y))` +inj_plus: (x,y:nat)`(inject_nat (plus x y)) = (inject_nat x)+(inject_nat y)` +inj_mult: (x,y:nat)`(inject_nat (mult x y)) = (inject_nat x)*(inject_nat y)` +inj_minus1: + (x,y:nat)(le y x)->`(inject_nat (minus x y)) = (inject_nat x)-(inject_nat y)` +inj_minus2: (x,y:nat)(gt y x)->`(inject_nat (minus x y)) = 0` +>> +*) + +(** Too specific ? *) +(** +<< +Zred_factor5: (x,y:Z)`x*0+y = y` +>> +*) diff --git a/dev/doc/build-system.dev.txt b/dev/doc/build-system.dev.txt index d4014303..3d9cba14 100644 --- a/dev/doc/build-system.dev.txt +++ b/dev/doc/build-system.dev.txt @@ -1,6 +1,22 @@ + Since July 2007, Coq features a build system overhauled by Pierre Corbineau and Lionel Elie Mamane. +--------------------------------------------------------------------- +WARNING: +In March 2010 this build system has been heavily adapted by Pierre +Letouzey. In particular there no more explicit stage1,2. Stage3 +was removed some time ago when coqdep was splitted into coqdep_boot +and full coqdep. Ideas are still similar to what is describe below, +but: +1) .ml4 are explicitely turned into .ml files, which stay after build +2) we let "make" handle the inclusion of .d without trying to guess + what could be done at what time. Some initial inclusions hence + _fail_, but "make" tries again later and succeed. + +TODO: remove obsolete sections below and better describe the new approach +----------------------------------------------------------------------- + This file documents internals of the implementation of the build system. For what a Coq developer needs to know about the build system, see build-system.txt . diff --git a/dev/doc/build-system.txt b/dev/doc/build-system.txt index 9362aeeb..b243ebe2 100644 --- a/dev/doc/build-system.txt +++ b/dev/doc/build-system.txt @@ -1,12 +1,60 @@ Since July 2007, Coq features a build system overhauled by Pierre Corbineau and Lionel Elie Mamane. +--------------------------------------------------------------------- +WARNING: +In March 2010 this build system has been heavily adapted by Pierre +Letouzey. In particular there no more explicit stage1,2. Stage3 +was removed some time ago when coqdep was splitted into coqdep_boot +and full coqdep. Ideas are still similar to what is describe below, +but: +1) .ml4 are explicitely turned into .ml files, which stay after build +2) we let "make" handle the inclusion of .d without trying to guess + what could be done at what time. Some initial inclusions hence + _fail_, but "make" tries again later and succeed. + +TODO: remove obsolete sections below and better describe the new approach +----------------------------------------------------------------------- + This file documents what a Coq developer needs to know about the build system. If you want to enhance the build system itself (or are curious about its implementation details), see build-system.dev.txt . The build system is not at its optimal state, see TODO section. + +FAQ: special features used in this Makefile +------------------------------------------- + +* Order-only dependencies: | + +Dependencies placed after a bar (|) should be built before +the current rule, but having one of them is out-of-date do not +trigger a rebuild of the current rule. +See http://www.gnu.org/software/make/manual/make.htmlPrerequisite-Types + +* Annotation before commands: +/-/@ + +a command starting by - is always successful (errors are ignored) +a command starting by + is runned even if option -n is given to make +a command starting by @ is not echoed before being runned + +* Custom functions + +Definition via "define foo" followed by commands (arg is $(1) etc) +Call via "$(call foo,arg1)" + +* Useful builtin functions + +$(subst ...), $(patsubst ...), $(shell ...), $(foreach ...), $(if ...) + +* Behavior of -include + +If the file given to -include doesn't exist, make tries to build it, +but doesn't care if this build fails. This can be quite surprising, +see in particular the -include in Makefile.stage* + + Stages in build system ---------------------- diff --git a/dev/doc/changes.txt b/dev/doc/changes.txt index 069f7d42..322530e6 100644 --- a/dev/doc/changes.txt +++ b/dev/doc/changes.txt @@ -1,3 +1,42 @@ +========================================= += CHANGES BETWEEN COQ V8.3 AND COQ V8.4 = +========================================= + +** Functions in unification.ml have now the evar_map coming just after the env + +** Removal of Tacinterp.constr_of_id ** + +Use instead either global_reference or construct_reference in constrintern.ml. + +** Optimizing calls to Evd functions ** + +Evars are split into defined evars and undefined evars; for +efficiency, when an evar is known to be undefined, it is preferable to +use specific functions about undefined evars since these ones are +generally fewer than the defined ones. + +** Type changes in TACTIC EXTEND rules ** + +Arguments bound with tactic(_) in TACTIC EXTEND rules are now of type +glob_tactic_expr, instead of glob_tactic_expr * tactic. Only the first +component is kept, the second one can be obtained via +Tacinterp.eval_tactic. + +** ARGUMENT EXTEND ** + +It is now forbidden to use TYPED simultaneously with {RAW,GLOB}_TYPED +in ARGUMENT EXTEND statements. + +** Renaming of rawconstr to glob_constr ** + +The "rawconstr" type has been renamed to "glob_constr" for +consistency. The "raw" in everything related to former rawconstr has +been changed to "glob". For more details about the rationale and +scripts to migrate code using Coq's internals, see commits 13743, +13744, 13755, 13756, 13757, 13758, 13761 (by glondu, end of December +2010) in Subversion repository. Contribs have been fixed too, and +commit messages there might also be helpful for migrating. + ========================================= = CHANGES BETWEEN COQ V8.2 AND COQ V8.3 = ========================================= diff --git a/dev/doc/debugging.txt b/dev/doc/debugging.txt index 50b3b45c..2480b8ed 100644 --- a/dev/doc/debugging.txt +++ b/dev/doc/debugging.txt @@ -11,6 +11,12 @@ Debugging from Coq toplevel using Caml trace mechanism 6. Test your Coq command and observe the result of tracing your functions 7. Freely switch from Coq to Ocaml toplevels with 'Drop.' and 'go();;' + You can avoid typing #use "include" (or "base_include") after Drop + by adding the following lines in your $HOME/.ocamlinit : + + if Filename.basename Sys.argv.(0) = "coqtop.byte" + then ignore (Toploop.use_silently Format.std_formatter "include") + Hints: To remove high-level pretty-printing features (coercions, notations, ...), use "Set Printing All". It will affect the #trace printers too. diff --git a/dev/doc/perf-analysis b/dev/doc/perf-analysis index d23bf835..ac54fa6f 100644 --- a/dev/doc/perf-analysis +++ b/dev/doc/perf-analysis @@ -1,13 +1,32 @@ Performance analysis (trunk repository) --------------------------------------- +Jun 7, 2010: delayed re-typing of Ltac instances in matching + (-1% on HighSchoolGeometry, -2% on JordanCurveTheorem) + +Jun 4, 2010: improvement in eauto and type classes inference by removing + systematic preparation of debugging pretty-printing streams (std_ppcmds) + (-7% in ATBR, visible only on V8.3 logs since ATBR is broken in trunk; + -6% in HighSchoolGeometry) + +Apr 19, 2010: small improvement obtained by reducing evar instantiation + from O(n^3) to O(n^2) in the size of the instance (-2% in Compcert, + -2% AreaMethod, -15% in Ssreflect) + +Apr 17, 2010: small improvement obtained by not repeating unification + twice in auto (-2% in Compcert, -2% in Algebra) + +Feb 15, 2010: Global decrease due to unicode inefficiency repaired + +Jan 8, 2010: Global increase due to an inefficiency in unicode treatment + Dec 1, 2009 - Dec 19, 2009: Temporary addition of [forall x, P x] hints to exact (generally not significative but, e.g., +25% on Subst, +8% on ZFC, +5% on AreaMethod) Oct 19, 2009: Change in modules (CoLoR +35%) -Aug 9, 2009: new files added in AreaMethod +Aug 9, 2009: new files added in AreaMethod May 21, 2008: New version of CoRN (needs +84% more time to compile) diff --git a/dev/doc/unification.txt b/dev/doc/unification.txt new file mode 100644 index 00000000..6d05bcf5 --- /dev/null +++ b/dev/doc/unification.txt @@ -0,0 +1,208 @@ +Some notes about the use of unification in Coq +---------------------------------------------- + +There are several applications of unification and pattern-matching + +** Unification of types ** + +- For type inference, inference of implicit arguments + * this basically amounts to solve problems of the form T <= U or T = U + where T and U are types coming from a given typing problem + * this kind of problem has to succeed and all the power of unification is + a priori expected (full beta/delta/iota/zeta/nu/mu, pattern-unification, + pruning, imitation/projection heuristics, ...) + +- For lemma application (apply, auto, ...) + * these are also problems of the form T <= U on types but with T + coming from a lemma and U from the goal + * it is not obvious that we always want unification and not matching + * it is not clear which amounts of delta one wants to use + +** Looking for subterms ** + +- For tactics applying on subterms: induction, destruct, rewrite + +- As part of unification of types in the presence of higher-order + evars (e.g. when applying a lemma of conclusion "?P t") + + +---------------------------------------------------------------------- +Here are examples of features one may want or not when looking for subterms + +A- REWRITING + +1- Full conversion on closed terms + +1a- Full conversion on closed terms in the presence of at least one evars (meta) + +Section A1. +Variable y: nat. +Hypothesis H: forall x, x+2 = 0. +Goal y+(1+1) = 0. +rewrite H. +(* 0 = 0 *) +Abort. + +Goal 2+(1+1) = 0. +rewrite H. +(* 0 = 0 *) +Abort. + +(* This exists since the very beginning of Chet's unification for tactics *) +(* But this fails for setoid rewrite *) + +1b- Full conversion on closed terms without any evars in the lemma + +1b.1- Fails on rewrite (because Unification.w_unify_to_subterm_list replaces + unification by check for a syntactic subterm if terms has no evar/meta) + +Goal 0+1 = 0 -> 0+(1+0) = 0. +intros H; rewrite H. +(* fails *) +Abort. + +1b.2- Works with setoid rewrite + +Require Import Setoid. +Goal 0+1 = 0 -> 0+(1+0) = 0. +intros H; rewrite H at 1. +(* 0 = 0 *) +Abort. + +2- Using known instances in full conversion on closed terms + +Section A2. +Hypothesis H: forall x, x+(2+x) = 0. +Goal 1+(1+2) = 0. +rewrite H. +Abort. +End A2. + +(* This exists since 8.2 (HH) *) + +3- Pattern-unification on Rels + +Section A3a. +Variable F: (nat->nat->nat)->nat. +Goal exists f, F (fun x y => f x y) = 0 -> F (fun x y => plus y x) = 0. +eexists. intro H; rewrite H. +(* 0 = 0 *) +Abort. +End A3a. + +(* Works since pattern unification on Meta applied to Rel was introduced *) +(* in unification.ml (8.1, Sep 2006, HH) *) + +Section A3b. +Variables x y: nat. +Variable H: forall f, f x y = 0. +Goal plus y x = 0. +rewrite H. +(* 0 = 0 *) +Abort. +End A3b. + +(* Works since pattern unification on all Meta was supported *) +(* in unification.ml (8.4, Jun 2011, HH) *) + +4- Unification with open terms + +Section A4. +Hypothesis H: forall x, S x = 0. +Goal S 0 = 0. +rewrite (H _). +(* 0 = 0 *) +Abort. +End A4. + +(* Works since unification on Evar was introduced so as to support rewriting *) +(* with open terms (8.2, MS, r11543, Unification.w_unify_to_subterm_list ) *) + +5- Unification of pre-existing evars + +5a- Basic unification of pre-existing evars + +Section A4. +Variables x y: nat. +Goal exists z, S z = 0 -> S (plus y x) = 0. +eexists. intro H; rewrite H. +(* 0 = 0 *) +Abort. +End A4. + +(* This worked in 8.2 and 8.3 as a side-effect of support for rewriting *) +(* with open terms (8.2, MS, r11543) *) + +5b- Pattern-unification of pre-existing evars in rewriting lemma + +Goal exists f, forall x y, f x y = 0 -> plus y x = 0. +eexists. intros x y H; rewrite H. +(* 0 = 0 *) +Abort. + +(* Works since pattern-unification on Evar was introduced *) +(* in unification.ml (8.3, HH, r12229) *) +(* currently governed by a flag: use_evars_pattern_unification *) + +5c- Pattern-unification of pre-existing evars in goal + +Goal exists f, forall x y, plus x y = 0 -> f y x = 0. +eexists. intros x y H; rewrite H. +(* 0 = 0 *) +Abort. + +(* This worked in 8.2 and 8.3 but was removed for autorewrite in 8.4 *) + +5d- Mixing pattern-unification of pre-existing evars in goal and evars in lemma + +Goal exists f, forall x, (forall y, plus x y = 0) -> forall y:nat, f y x = 0. +eexists. intros x H y. rewrite H. +(* 0 = 0 *) +Abort. + +(* This worked in 8.2 and 8.3 but was removed for autorewrite in 8.4 *) + +6- Multiple non-identical but convertible occurrences + +Tactic rewrite only considers the first one, from left-to-right, e.g.: + +Section A6. +Variable y: nat. +Hypothesis H: forall x, x+2 = 0. +Goal (y+(2+0))+(y+(1+1)) = (y+(1+1))+(y+(2+0)). +rewrite H. +(* 0+(y+(1+1)) = y+(1+1)+0 *) +Abort. +End A6. + +Tactic setoid rewrite first looks for syntactically equal terms and if +not uses the leftmost occurrence modulo delta. + +Require Import Setoid. +Section A6. +Variable y: nat. +Hypothesis H: forall x, x+2 = 0. +Goal (y+(2+0))+(y+2) = (y+2)+(y+(2+0)). +rewrite H at 1 2 3 4. +(* (y+(2+0))+0 = 0+(y+(2+0)) *) +Abort. + +Goal (y+(2+0))+(y+(1+1)) = (y+(1+1))+(y+(2+0)). +rewrite H at 1 2 3 4. +(* 0+(y+(1+1)) = y+(1+1)+0 *) +Abort. +End A6. + +7- Conversion + +Section A6. +Variable y: nat. +Hypothesis H: forall x, S x = 0. +Goal id 1 = 0. +rewrite H. + + +B- ELIMINATION (INDUCTION / CASE ANALYSIS) + +This is simpler because open terms are not allowed and no unification +is involved (8.3). diff --git a/dev/doc/universes.txt b/dev/doc/universes.txt index 65c1e522..a40706e9 100644 --- a/dev/doc/universes.txt +++ b/dev/doc/universes.txt @@ -1,32 +1,26 @@ How to debug universes? -1. There is a command Dump Universes in Coq toplevel +1. There is a command Print Universes in Coq toplevel - Dump Universes. + Print Universes. prints the graph of universes in the form of constraints - Dump Universes "file". + Print Universes "file". produces the "file" containing universe constraints in the form univ1 # univ2 ; where # can be either > >= or = - - The file produced by the latter command can be transformed using - the script univdot to dot format. - For example - univdot file | dot -Tps > file.ps - - produces a graph of universes in ps format. - > arrows are red, >= blue, and = black. + If "file" ends with .gv or .dot, the resulting file will be in + dot format. *) for dot see http://www.research.att.com/sw/tools/graphviz/ 2. There is a printing option - - Termast.print_universes : bool ref - which, when set (in ocaml after Drop), makes all pretty-printed - Type's annotated with the name of the universe. + {Set,Unset} Printing Universes. + + which, when set, makes all pretty-printed Type's annotated with the + name of the universe. diff --git a/dev/include b/dev/include index 251a969b..69ac3c41 100644 --- a/dev/include +++ b/dev/include @@ -1,6 +1,19 @@ (* File to include to install the pretty-printers in the ocaml toplevel *) +(* Typical usage : + + $ coqtop.byte # or even better : rlwrap coqtop.byte + Coq < Drop. + # #use "include";; + + Alternatively, you can avoid typing #use "include" after each Drop + by adding the following lines in your $HOME/.ocamlinit : + + if Filename.basename Sys.argv.(0) = "coqtop.byte" + then ignore (Toploop.use_silently Format.std_formatter "include") +*) + (* For OCaml 3.10.x: clflags.cmi (a ocaml compilation by-product) must be in the library path. On Debian, install ocaml-compiler-libs, and uncomment the following: @@ -14,7 +27,7 @@ #install_printer (* pp_stdcmds *) pppp;; #install_printer (* pattern *) pppattern;; -#install_printer (* rawconstr *) pprawconstr;; +#install_printer (* glob_constr *) ppglob_constr;; #install_printer (* constr *) ppconstr;; #install_printer (* constr_substituted *) ppsconstr;; @@ -24,12 +37,14 @@ #install_printer (* judgement *) ppj;; #install_printer (* hint_db *) print_hint_db;; +(*#install_printer (* hints_path *) pphintspath;;*) #install_printer (* goal *) ppgoal;; -#install_printer (* sigma goal *) ppsigmagoal;; -#install_printer (* proof *) pproof;; -#install_printer (* pftreestate *) pppftreestate;; +(*#install_printer (* sigma goal *) ppsigmagoal;;*) +(*#install_printer (* proof *) pproof;;*) +#install_printer (* Goal.goal *) ppgoalgoal;; #install_printer (* metaset.t *) ppmetas;; #install_printer (* evar_map *) ppevm;; +#install_printer (* ExistentialSet.t *) ppexistentialset;; #install_printer (* clenv *) ppclenv;; #install_printer (* env *) ppenv;; diff --git a/dev/ocamldoc/docintro b/dev/ocamldoc/docintro new file mode 100644 index 00000000..33d20fc8 --- /dev/null +++ b/dev/ocamldoc/docintro @@ -0,0 +1,49 @@ +{!indexlist} + +This is Coq, a proof assistant for the Calculus of Inductive Constructions. +This document describes the implementation of Coq. +It has been automatically generated from the source of +Coq using {{:http://caml.inria.fr/}ocamldoc}. +The source files are organized in several directories ordered like that: + +{ol {- Utility libraries : lib + +describes the various utility libraries used in the code +of Coq.} +{- Kernel : kernel + +describes the Coq kernel, which is a type checker for the Calculus +of Inductive Constructions.} +{- Library : library + +describes the Coq library, which is made of two parts: +- a general mechanism to keep a trace of all operations and of + the state of the system, with backtrack capabilities; +- a global environment for the CCI, with functions to export and + import compiled modules. + +} +{- Pretyping : pretyping + +} +{- Front abstract syntax of terms : interp + +describes the translation from Coq context-dependent +front abstract syntax of terms {v constr_expr v} to and from the +context-free, untyped, globalized form of constructions {v glob_constr v}.} +{- Parsers and printers : parsing + +describes the implementation of the Coq parsers and printers.} +{- Proof engine : proofs + +describes the Coq proof engine, which is also called +the ``refiner'', since it provides a way to build terms by successive +refining steps. Those steps are either primitive rules or higher-level +tactics.} +{- Tacticts : tactics + +describes the Coq main tactics.} +{- Toplevel : toplevel + +describes the highest modules of the Coq system.} +} diff --git a/dev/ocamldoc/html/style.css b/dev/ocamldoc/html/style.css new file mode 100644 index 00000000..c2c45b62 --- /dev/null +++ b/dev/ocamldoc/html/style.css @@ -0,0 +1,220 @@ +a:visited { + color: #416DFF; text-decoration: none; +} + +a:link { + color: #416DFF; text-decoration: none; +} + +a:hover { + color: Red; text-decoration: none; background-color: #5FFF88 +} + +a:active { + color: Red; text-decoration: underline; +} + +.keyword { + font-weight: bold; color: Red +} + +.keywordsign { + color: #C04600 +} + +.superscript { + font-size: 8 +} + +.subscript { + font-size: 8 +} + +.comment { + color: Green +} + +.constructor { + color: Blue +} + +.type { + color: #5C6585 +} + +.string { + color: Maroon +} + +.warning { + color: Red; font-weight: bold +} + +.info { + margin-left: 3em; margin-right: 3em +} + +.param_info { + margin-top: 4px; margin-left: 3em; margin-right: 3em +} + +.code { + color: #465F91; +} + +h1 { + font-size: 20pt; text-align: center; +} + +h5, h6, div.h7, div.h8, div.h9 { + font-size: 20pt; + border: 1px solid #000000; + margin-top: 5px; + margin-bottom: 2px; + text-align: center; + padding: 2px; +} + +h5 { + background-color: #90FDFF; +} + +h6 { + background-color: #016699; + color: white; +} + +div.h7 { + background-color: #E0FFFF; +} + +div.h8 { + background-color: #F0FFFF; +} + +div.h9 { + background-color: #FFFFFF; +} + +.typetable, .indextable, .paramstable { + border-style: hidden; +} + +.paramstable { + padding: 5pt 5pt; +} + +body { + background-color: white; +} + +tr { + background-color: white; +} + +td.typefieldcomment { + background-color: #FFFFFF; + font-size: smaller; +} + +pre { + margin-bottom: 4px; +} + +div.sig_block { + margin-left: 2em; +} + + +h2 { + font-family: Arial, Helvetica, sans-serif; + font-size: 16pt; + font-weight: normal; + border-bottom: 1px solid #dadada; + border-top: 1px solid #dadada; + color: #101010; + background: #eeeeff; + margin: 25px 0px 10px 0px; + padding: 1px 1px 1px 1px; +} + +h3 { + font-family: Arial, Helvetica, sans-serif; + font-size: 12pt; + color: #016699; + font-weight: bold; + padding: 15px 0 0 0ex; + margin: 5px 0 0 0; +} + +h4 { + font-family: Arial, Helvetica, sans-serif; + font-size: 10pt; + color: #016699; + padding: 15px 0 0 0ex; + margin: 5px 0 0 0; +} + +/* Here starts the overwrite of default rules to give a better look */ + +body { + font-family: Calibri, Georgia, Garamond, Baskerville, serif; + font-size: 12pt; + background-color: white; +} + +a:link, a { + color: #6895c3 !important; +} + +a:hover { + color: #2F4459 !important; + background-color: white; +} + +hr { + height: 1px; + color: #016699; + background-color: #016699; + border-width: 0; +} + +h1, h1 a:link, h1 a:visited, h1 a { + font-family: Cambria, Georgia, Garamond, Baskerville, serif; + color: #016699; +} + +.navbar { + float: left; +} + +.navbar a, .navbar a:link, .navbar a:visited { + color: #016699; + font-family: Arial, Helvetica, sans-serif; + font-weight: bold; + font-size: 80%; +} + +.keyword { + color: #c13939; +} + +.constructor { + color: #3c8f7e; +} + +pre, code { + font-family: "DejaVu Sans Mono", "Bitstream Vera Mono", "Courrier New", monospace; + white-space: normal; + font-size: 9pt; + font-weight: bold; +} + +.type br { + display: none; +} + +.info { + margin-left: 1em; + font-size: 12pt; +} diff --git a/dev/ocamlweb-doc/Makefile b/dev/ocamlweb-doc/Makefile deleted file mode 100644 index 3189d7c5..00000000 --- a/dev/ocamlweb-doc/Makefile +++ /dev/null @@ -1,90 +0,0 @@ -include ../../config/Makefile - -LOCALINCLUDES=-I ../../config -I ../../tools -I ../../tools/coqdoc \ - -I ../../scripts -I ../../lib -I ../../kernel -I ../../kernel/byterun -I ../../library \ - -I ../../proofs -I ../../tactics -I ../../pretyping \ - -I ../../interp -I ../../toplevel -I ../../parsing -I ../../ide/utils -I ../../ide \ - -I ../../plugins/omega -I ../../plugins/romega \ - -I ../../plugins/ring -I ../../plugins/dp -I ../../plugins/setoid_ring \ - -I ../../plugins/xml -I ../../plugins/extraction \ - -I ../../plugins/fourier \ - -I ../../plugins/cc \ - -I ../../plugins/funind -I ../../plugins/firstorder \ - -I ../../plugins/field -I ../../plugins/subtac -I ../../plugins/rtauto \ - -I ../../plugins/recdef - -MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB) - - -all:: newparse coq.ps minicop.ps -#newsyntax.dvi minicoq.dvi - - -OBJS=lex.cmo ast.cmo parse.cmo syntax.cmo - -newparse: $(OBJS) syntax.mli lex.ml syntax.ml - ocamlc -o newparse $(OBJS) - -%.cmo: %.ml - ocamlc -c $< - -%.cmi: %.mli - ocamlc -c $< - -%.ml: %.mll - ocamllex $< - -%.ml: %.mly - ocamlyacc -v $< - -%.mli: %.mly - ocamlyacc -v $< - -clean:: - rm -f *.cm* *.output syntax.ml syntax.mli lex.ml newparse - -parse.cmo: ast.cmo -syntax.cmi: parse.cmo -syntax.cmo: lex.cmo parse.cmo syntax.cmi -lex.cmo: syntax.cmi -ast.cmo: ast.ml - -newsyntax.dvi: newsyntax.tex - latex $< - latex $< - -coq.dvi: coq.tex - latex coq - latex coq - -coq.tex:: - ocamlweb -p "\usepackage{epsfig}" \ - macros.tex intro.tex \ - ../../lib/{doc.tex,*.mli} ../../kernel/{doc.tex,*.mli} ../../library/{doc.tex,*.mli} \ - ../../pretyping/{doc.tex,*.mli} ../../interp/{doc.tex,*.mli} \ - ../../parsing/{doc.tex,*.mli} ../../proofs/{doc.tex,*.mli} \ - ../../tactics/{doc.tex,*.mli} ../../toplevel/{doc.tex,*.mli} \ - -o coq.tex - - -depend:: kernel.dep.ps library.dep.ps pretyping.dep.ps parsing.dep.ps \ - proofs.dep.ps tactics.dep.ps toplevel.dep.ps interp.dep.ps - -%.dot: ../../% - ocamldoc -rectypes $(MLINCLUDES) -t $* -dot -dot-reduce ../../$*/*.ml ../../$*/*.mli -o $@ - -%.dep.ps: %.dot - dot -Tps $< -o $@ - -clean:: - rm -f *~ *.log *.aux - -.SUFFIXES: .tex .dvi .ps .cmo .cmi .mli .ml .mll .mly - -%.dvi: %.tex - latex $< && latex $< - -%.ps: %.dvi - dvips $< -o $@ - - diff --git a/dev/ocamlweb-doc/ast.ml b/dev/ocamlweb-doc/ast.ml deleted file mode 100644 index 4eb135d8..00000000 --- a/dev/ocamlweb-doc/ast.ml +++ /dev/null @@ -1,47 +0,0 @@ - -type constr_ast = - Pair of constr_ast * constr_ast -| Prod of binder list * constr_ast -| Lambda of binder list * constr_ast -| Let of string * constr_ast * constr_ast -| LetCase of binder list * constr_ast * constr_ast -| IfCase of constr_ast * constr_ast * constr_ast -| Eval of red_fun * constr_ast -| Infix of string * constr_ast * constr_ast -| Prefix of string * constr_ast -| Postfix of string * constr_ast -| Appl of constr_ast * constr_arg list -| ApplExpl of string list * constr_ast list -| Scope of string * constr_ast -| Qualid of string list -| Prop | Set | Type -| Int of string -| Hole -| Meta of string -| Fixp of fix_kind * - (string * binder list * constr_ast * string option * constr_ast) list * - string -| Match of case_item list * constr_ast option * - (pattern list * constr_ast) list - -and red_fun = Simpl - -and binder = string * constr_ast - -and constr_arg = string option * constr_ast - -and fix_kind = Fix | CoFix - -and case_item = constr_ast * (string option * constr_ast option) - -and pattern = - PatAs of pattern * string -| PatType of pattern * constr_ast -| PatConstr of string * pattern list -| PatVar of string - -let mk_cast c t = - if t=Hole then c else Infix(":",c,t) - -let mk_lambda bl t = - if bl=[] then t else Lambda(bl,t) diff --git a/dev/ocamlweb-doc/interp.dep.ps b/dev/ocamlweb-doc/interp.dep.ps deleted file mode 100644 index fda7a33c..00000000 --- a/dev/ocamlweb-doc/interp.dep.ps +++ /dev/null @@ -1,545 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: Graphviz version 2.12 (Tue Oct 23 13:46:12 UTC 2007) -%%For: (notin) Jean-Marc Notin,,, -%%Title: G -%%Pages: (atend) -%%BoundingBox: (atend) -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval -EncodingVector 45 /hyphen put - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -setupLatin1 -%%Page: 1 1 -%%PageBoundingBox: 36 36 576 753 -%%PageOrientation: Landscape -gsave -36 36 576 753 boxprim clip newpath -0 0 1 beginpage -0.985401 0.985401 set_scale 90 rotate 40.5333 -580.533 translate -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 544 lineto -724 544 lineto -724 -4 lineto -closepath fill -0.985401 setlinewidth -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 544 lineto -724 544 lineto -724 -4 lineto -closepath stroke -% Constrextern -gsave -0.502 1.000 0.820 nodecolor -172 417 49.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -172 417 49.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -172 412 moveto 72 -0.5 (Constrextern) alignedtext -grestore -% Reserve -gsave -0.502 1.000 0.820 nodecolor -264 319 35.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -264 319 35.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -264 314 moveto 44 -0.5 (Reserve) alignedtext -grestore -% Constrextern->Reserve -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 188 400 moveto -203 384 225 361 242 343 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 245.049 344.831 moveto -249 335 lineto -239.781 340.221 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 245.049 344.831 moveto -249 335 lineto -239.781 340.221 lineto -closepath stroke -grestore -% Notation -gsave -0.502 1.000 0.820 nodecolor -268 122 37.1753 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -268 122 37.1753 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -268 117 moveto 49 -0.5 (Notation) alignedtext -grestore -% Constrextern->Notation -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 178 399 moveto -194 349 240 209 259 150 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 262.479 150.584 moveto -262 140 lineto -255.774 148.573 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 262.479 150.584 moveto -262 140 lineto -255.774 148.573 lineto -closepath stroke -grestore -% Topconstr -gsave -0.502 1.000 0.820 nodecolor -82 24 41.1755 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -82 24 41.1755 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -82 19 moveto 57 -0.5 (Topconstr) alignedtext -grestore -% Notation->Topconstr -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 243 109 moveto -211 91 154 62 117 43 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 118.441 39.7969 moveto -108 38 lineto -115.042 45.916 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 118.441 39.7969 moveto -108 38 lineto -115.042 45.916 lineto -closepath stroke -grestore -% Ppextend -gsave -0.502 1.000 0.820 nodecolor -278 24 39.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -278 24 39.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -278 19 moveto 52 -0.5 (Ppextend) alignedtext -grestore -% Notation->Ppextend -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 270 104 moveto -272 89 273 68 275 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 278.488 52.2987 moveto -276 42 lineto -271.522 51.6021 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 278.488 52.2987 moveto -276 42 lineto -271.522 51.6021 lineto -closepath stroke -grestore -% Constrintern -gsave -0.502 1.000 0.820 nodecolor -472 417 48.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -472 417 48.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -472 412 moveto 70 -0.5 (Constrintern) alignedtext -grestore -% Constrintern->Reserve -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 442 403 moveto -404 385 340 355 299 335 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 300.56 331.863 moveto -290 331 lineto -297.717 338.26 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 300.56 331.863 moveto -290 331 lineto -297.717 338.26 lineto -closepath stroke -grestore -% Implicit_quantifiers -gsave -0.502 1.000 0.820 nodecolor -508 319 69.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -508 319 69.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -508 314 moveto 112 -0.5 (Implicit_quantifiers) alignedtext -grestore -% Constrintern->Implicit_quantifiers -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 479 399 moveto -484 385 492 364 498 347 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 501.479 347.584 moveto -501 337 lineto -494.774 345.573 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 501.479 347.584 moveto -501 337 lineto -494.774 345.573 lineto -closepath stroke -grestore -% Syntax_def -gsave -0.502 1.000 0.820 nodecolor -396 220 45.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -396 220 45.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -396 215 moveto 64 -0.5 (Syntax_def) alignedtext -grestore -% Implicit_quantifiers->Syntax_def -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 488 302 moveto -469 285 442 261 422 244 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 424.546 241.596 moveto -415 237 lineto -419.596 246.546 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 424.546 241.596 moveto -415 237 lineto -419.596 246.546 lineto -closepath stroke -grestore -% Coqlib -gsave -0.502 1.000 0.820 nodecolor -656 515 32.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -656 515 32.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -656 510 moveto 38 -0.5 (Coqlib) alignedtext -grestore -% Genarg -gsave -0.502 1.000 0.820 nodecolor -82 122 33.175 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -82 122 33.175 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -82 117 moveto 41 -0.5 (Genarg) alignedtext -grestore -% Genarg->Topconstr -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 82 104 moveto -82 89 82 69 82 52 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 85.5001 52 moveto -82 42 lineto -78.5001 52 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 85.5001 52 moveto -82 42 lineto -78.5001 52 lineto -closepath stroke -grestore -% Syntax_def->Notation -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 375 204 moveto -354 187 320 161 296 143 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 298.1 140.2 moveto -288 137 lineto -293.9 145.8 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 298.1 140.2 moveto -288 137 lineto -293.9 145.8 lineto -closepath stroke -grestore -% Modintern -gsave -0.502 1.000 0.820 nodecolor -472 515 42.1756 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -472 515 42.1756 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -472 510 moveto 59 -0.5 (Modintern) alignedtext -grestore -% Modintern->Constrintern -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 472 497 moveto -472 482 472 462 472 445 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 475.5 445 moveto -472 435 lineto -468.5 445 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 475.5 445 moveto -472 435 lineto -468.5 445 lineto -closepath stroke -grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -%%BoundingBox: 36 36 576 753 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/intro.tex b/dev/ocamlweb-doc/intro.tex deleted file mode 100644 index 4cec8673..00000000 --- a/dev/ocamlweb-doc/intro.tex +++ /dev/null @@ -1,25 +0,0 @@ - -\ocwsection This is \Coq, a proof assistant for the \CCI. -This document describes the implementation of \Coq. -It has been automatically generated from the source of -\Coq\ using \textsf{ocamlweb}, a literate programming tool for -\textsf{Objective Caml}\footnote{\Coq, \textsf{Objective Caml} and - \textsf{ocamlweb} are all freely available at - \textsf{http://coq.inria.fr/}, \textsf{http://caml.inria.fr/} and - \textsf{http://www.lri.fr/\~{}filliatr/ocamlweb}.}. -The source files are organized in several directories, which are -described here as separate chapters. - -\begin{center} - \begin{tabular}{p{10cm}rr} - Chapter & section & page \\[0.5em] - \hline\\[0.2em] - Utility libraries \dotfill & \refsec{lib} & \pageref{lib} \\[0.5em] - Kernel \dotfill & \refsec{kernel} & \pageref{kernel} \\[0.5em] - Library \dotfill & \refsec{library} & \pageref{library} \\[0.5em] - Pretyping \dotfill & \refsec{pretyping} & \pageref{pretyping} \\[0.5em] - Proof engine \dotfill & \refsec{proofs} & \pageref{proofs} \\[0.5em] - Tactics \dotfill & \refsec{tactics} & \pageref{tactics} \\[0.5em] - Toplevel \dotfill & \refsec{toplevel}& \pageref{toplevel}\\[0.5em] - \end{tabular} -\end{center} \ No newline at end of file diff --git a/dev/ocamlweb-doc/kernel.dep.ps b/dev/ocamlweb-doc/kernel.dep.ps deleted file mode 100644 index b7b4137b..00000000 --- a/dev/ocamlweb-doc/kernel.dep.ps +++ /dev/null @@ -1,1431 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: Graphviz version 2.12 (Tue Oct 23 13:46:12 UTC 2007) -%%For: (notin) Jean-Marc Notin,,, -%%Title: G -%%Pages: (atend) -%%BoundingBox: (atend) -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval -EncodingVector 45 /hyphen put - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -setupLatin1 -%%Page: 1 1 -%%PageBoundingBox: 36 36 535 756 -%%PageOrientation: Landscape -gsave -36 36 535 756 boxprim clip newpath -0 0 1 beginpage -0.393658 0.393658 set_scale 90 rotate 95.45 -1355.45 translate -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 1264 lineto -1825 1264 lineto -1825 -4 lineto -closepath fill -0.393658 setlinewidth -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 1264 lineto -1825 1264 lineto -1825 -4 lineto -closepath stroke -% Cbytecodes -gsave -0.502 1.000 0.820 nodecolor -1258 234 45.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1258 234 45.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1258 229 moveto 64 -0.5 (Cbytecodes) alignedtext -grestore -% Term -gsave -0.502 1.000 0.820 nodecolor -1093 162 28.1746 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1093 162 28.1746 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1093 157 moveto 31 -0.5 (Term) alignedtext -grestore -% Cbytecodes->Term -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1227 221 moveto -1198 208 1155 189 1125 176 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1126.56 172.863 moveto -1116 172 lineto -1123.72 179.26 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1126.56 172.863 moveto -1116 172 lineto -1123.72 179.26 lineto -closepath stroke -grestore -% Esubst -gsave -0.502 1.000 0.820 nodecolor -1093 90 31.1748 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1093 90 31.1748 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1093 85 moveto 37 -0.5 (Esubst) alignedtext -grestore -% Term->Esubst -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1093 144 moveto -1093 136 1093 127 1093 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1096.5 118 moveto -1093 108 lineto -1089.5 118 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1096.5 118 moveto -1093 108 lineto -1089.5 118 lineto -closepath stroke -grestore -% Univ -gsave -0.502 1.000 0.820 nodecolor -580 90 27.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -580 90 27.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -580 85 moveto 28 -0.5 (Univ) alignedtext -grestore -% Term->Univ -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1065 158 moveto -979 145 714 109 616 95 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 616.299 91.5125 moveto -606 94 lineto -615.602 98.4778 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 616.299 91.5125 moveto -606 94 lineto -615.602 98.4778 lineto -closepath stroke -grestore -% Cbytegen -gsave -0.502 1.000 0.820 nodecolor -1148 522 39.1754 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1148 522 39.1754 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1148 517 moveto 53 -0.5 (Cbytegen) alignedtext -grestore -% Pre_env -gsave -0.502 1.000 0.820 nodecolor -1148 450 36.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1148 450 36.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1148 445 moveto 46 -0.5 (Pre_env) alignedtext -grestore -% Cbytegen->Pre_env -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1148 504 moveto -1148 496 1148 487 1148 478 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1151.5 478 moveto -1148 468 lineto -1144.5 478 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1151.5 478 moveto -1148 468 lineto -1144.5 478 lineto -closepath stroke -grestore -% Declarations -gsave -0.502 1.000 0.820 nodecolor -1148 378 48.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1148 378 48.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1148 373 moveto 70 -0.5 (Declarations) alignedtext -grestore -% Pre_env->Declarations -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1148 432 moveto -1148 424 1148 415 1148 406 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1151.5 406 moveto -1148 396 lineto -1144.5 406 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1151.5 406 moveto -1148 396 lineto -1144.5 406 lineto -closepath stroke -grestore -% Cemitcodes -gsave -0.502 1.000 0.820 nodecolor -663 306 45.1757 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -663 306 45.1757 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -663 301 moveto 65 -0.5 (Cemitcodes) alignedtext -grestore -% Cemitcodes->Cbytecodes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 706 301 moveto -813 287 1088 254 1205 240 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1205.4 243.478 moveto -1215 239 lineto -1204.7 236.512 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1205.4 243.478 moveto -1215 239 lineto -1204.7 236.512 lineto -closepath stroke -grestore -% Copcodes -gsave -0.502 1.000 0.820 nodecolor -786 234 40.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -786 234 40.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -786 229 moveto 54 -0.5 (Copcodes) alignedtext -grestore -% Cemitcodes->Copcodes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 688 291 moveto -707 281 732 266 752 253 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 753.958 255.916 moveto -761 248 lineto -750.559 249.797 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 753.958 255.916 moveto -761 248 lineto -750.559 249.797 lineto -closepath stroke -grestore -% Mod_subst -gsave -0.502 1.000 0.820 nodecolor -325 234 43.1756 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -325 234 43.1756 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -325 229 moveto 61 -0.5 (Mod_subst) alignedtext -grestore -% Cemitcodes->Mod_subst -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 623 298 moveto -561 284 441 259 374 244 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 374.492 240.529 moveto -364 242 lineto -373.119 247.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 374.492 240.529 moveto -364 242 lineto -373.119 247.393 lineto -closepath stroke -grestore -% Mod_subst->Term -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 367 230 moveto -502 217 925 178 1055 166 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1055.4 169.478 moveto -1065 165 lineto -1054.7 162.512 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1055.4 169.478 moveto -1065 165 lineto -1054.7 162.512 lineto -closepath stroke -grestore -% Closure -gsave -0.502 1.000 0.820 nodecolor -713 666 34.1751 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -713 666 34.1751 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -713 661 moveto 43 -0.5 (Closure) alignedtext -grestore -% Environ -gsave -0.502 1.000 0.820 nodecolor -1148 594 36.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1148 594 36.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1148 589 moveto 46 -0.5 (Environ) alignedtext -grestore -% Closure->Environ -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 746 661 moveto -823 648 1016 616 1104 602 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1104.88 605.393 moveto -1114 600 lineto -1103.51 598.529 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1104.88 605.393 moveto -1114 600 lineto -1103.51 598.529 lineto -closepath stroke -grestore -% Environ->Cbytegen -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1148 576 moveto -1148 568 1148 559 1148 550 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1151.5 550 moveto -1148 540 lineto -1144.5 550 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1151.5 550 moveto -1148 540 lineto -1144.5 550 lineto -closepath stroke -grestore -% Conv_oracle -gsave -0.502 1.000 0.820 nodecolor -383 522 48.1758 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -383 522 48.1758 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -383 517 moveto 71 -0.5 (Conv_oracle) alignedtext -grestore -% Names -gsave -0.502 1.000 0.820 nodecolor -288 18 32.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -288 18 32.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -288 13 moveto 38 -0.5 (Names) alignedtext -grestore -% Conv_oracle->Names -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 339 515 moveto -238 497 0 449 0 378 curveto -0 378 0 378 0 162 curveto -0 53 166 26 246 20 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 246.398 23.4778 moveto -256 19 lineto -245.701 16.5125 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 246.398 23.4778 moveto -256 19 lineto -245.701 16.5125 lineto -closepath stroke -grestore -% Cooking -gsave -0.502 1.000 0.820 nodecolor -960 1026 37.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -960 1026 37.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -960 1021 moveto 48 -0.5 (Cooking) alignedtext -grestore -% Typeops -gsave -0.502 1.000 0.820 nodecolor -960 954 37.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -960 954 37.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -960 949 moveto 48 -0.5 (Typeops) alignedtext -grestore -% Cooking->Typeops -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 960 1008 moveto -960 1000 960 991 960 982 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 963.5 982 moveto -960 972 lineto -956.5 982 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 963.5 982 moveto -960 972 lineto -956.5 982 lineto -closepath stroke -grestore -% Entries -gsave -0.502 1.000 0.820 nodecolor -1391 882 33.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1391 882 33.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1391 877 moveto 40 -0.5 (Entries) alignedtext -grestore -% Typeops->Entries -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 995 948 moveto -1074 935 1265 903 1349 889 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1349.88 892.393 moveto -1359 887 lineto -1348.51 885.529 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1349.88 892.393 moveto -1359 887 lineto -1348.51 885.529 lineto -closepath stroke -grestore -% Inductive -gsave -0.502 1.000 0.820 nodecolor -837 882 39.1754 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -837 882 39.1754 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -837 877 moveto 53 -0.5 (Inductive) alignedtext -grestore -% Typeops->Inductive -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 936 940 moveto -918 929 891 914 871 901 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 872.441 897.797 moveto -862 896 lineto -869.042 903.916 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 872.441 897.797 moveto -862 896 lineto -869.042 903.916 lineto -closepath stroke -grestore -% Csymtable -gsave -0.502 1.000 0.820 nodecolor -1148 666 42.1756 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1148 666 42.1756 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1148 661 moveto 59 -0.5 (Csymtable) alignedtext -grestore -% Csymtable->Environ -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1148 648 moveto -1148 640 1148 631 1148 622 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1151.5 622 moveto -1148 612 lineto -1144.5 622 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1151.5 622 moveto -1148 612 lineto -1144.5 622 lineto -closepath stroke -grestore -% Vm -gsave -0.502 1.000 0.820 nodecolor -731 594 27 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -731 594 27 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -731 589 moveto 21 -0.5 (Vm) alignedtext -grestore -% Csymtable->Vm -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1109 659 moveto -1029 645 845 614 767 600 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 767.492 596.529 moveto -757 598 lineto -766.119 603.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 767.492 596.529 moveto -757 598 lineto -766.119 603.393 lineto -closepath stroke -grestore -% Vm->Cemitcodes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 727 576 moveto -716 527 684 392 669 334 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 672.393 333.119 moveto -667 324 lineto -665.529 334.492 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 672.393 333.119 moveto -667 324 lineto -665.529 334.492 lineto -closepath stroke -grestore -% Vm->Conv_oracle -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 705 589 moveto -648 577 510 549 435 533 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 435.492 529.529 moveto -425 531 lineto -434.119 536.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 435.492 529.529 moveto -425 531 lineto -434.119 536.393 lineto -closepath stroke -grestore -% Declarations->Cemitcodes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1103 371 moveto -1013 358 811 328 715 314 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 715.492 310.529 moveto -705 312 lineto -714.119 317.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 715.492 310.529 moveto -705 312 lineto -714.119 317.393 lineto -closepath stroke -grestore -% Sign -gsave -0.502 1.000 0.820 nodecolor -1697 306 27 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1697 306 27 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1697 301 moveto 26 -0.5 (Sign) alignedtext -grestore -% Declarations->Sign -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1193 372 moveto -1300 359 1563 324 1660 311 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1660.4 314.478 moveto -1670 310 lineto -1659.7 307.512 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1660.4 314.478 moveto -1670 310 lineto -1659.7 307.512 lineto -closepath stroke -grestore -% Retroknowledge -gsave -0.502 1.000 0.820 nodecolor -1221 306 59.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1221 306 59.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1221 301 moveto 92 -0.5 (Retroknowledge) alignedtext -grestore -% Declarations->Retroknowledge -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1165 361 moveto -1175 352 1186 341 1197 330 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1199.4 332.546 moveto -1204 323 lineto -1194.45 327.596 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1199.4 332.546 moveto -1204 323 lineto -1194.45 327.596 lineto -closepath stroke -grestore -% Sign->Term -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1671 300 moveto -1576 277 1241 197 1130 170 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1130.49 166.529 moveto -1120 168 lineto -1129.12 173.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1130.49 166.529 moveto -1120 168 lineto -1129.12 173.393 lineto -closepath stroke -grestore -% Retroknowledge->Cbytecodes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1230 288 moveto -1234 280 1239 270 1244 261 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1247.2 262.441 moveto -1249 252 lineto -1241.08 259.042 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1247.2 262.441 moveto -1249 252 lineto -1241.08 259.042 lineto -closepath stroke -grestore -% Entries->Sign -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1411 868 moveto -1442 844 1496 795 1496 738 curveto -1496 738 1496 738 1496 450 curveto -1496 370 1604 330 1661 314 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1661.88 317.393 moveto -1671 312 lineto -1660.51 310.529 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1661.88 317.393 moveto -1671 312 lineto -1660.51 310.529 lineto -closepath stroke -grestore -% Indtypes -gsave -0.502 1.000 0.820 nodecolor -539 1026 37.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -539 1026 37.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -539 1021 moveto 48 -0.5 (Indtypes) alignedtext -grestore -% Indtypes->Typeops -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 574 1020 moveto -650 1008 831 977 915 962 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 915.881 965.393 moveto -925 960 lineto -914.508 958.529 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 915.881 965.393 moveto -925 960 lineto -914.508 958.529 lineto -closepath stroke -grestore -% Type_errors -gsave -0.502 1.000 0.820 nodecolor -713 810 47.1758 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -713 810 47.1758 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -713 805 moveto 69 -0.5 (Type_errors) alignedtext -grestore -% Inductive->Type_errors -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 813 868 moveto -794 858 769 843 748 830 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 749.441 826.797 moveto -739 825 lineto -746.042 832.916 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 749.441 826.797 moveto -739 825 lineto -746.042 832.916 lineto -closepath stroke -grestore -% Reduction -gsave -0.502 1.000 0.820 nodecolor -713 738 41.1755 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -713 738 41.1755 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -713 733 moveto 57 -0.5 (Reduction) alignedtext -grestore -% Type_errors->Reduction -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 713 792 moveto -713 784 713 775 713 766 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 716.5 766 moveto -713 756 lineto -709.5 766 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 716.5 766 moveto -713 756 lineto -709.5 766 lineto -closepath stroke -grestore -% Modops -gsave -0.502 1.000 0.820 nodecolor -1404 954 35.1752 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1404 954 35.1752 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1404 949 moveto 45 -0.5 (Modops) alignedtext -grestore -% Modops->Environ -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1439 951 moveto -1511 943 1670 914 1670 810 curveto -1670 810 1670 810 1670 738 curveto -1670 639 1322 606 1194 597 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1194.3 593.512 moveto -1184 596 lineto -1193.6 600.478 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1194.3 593.512 moveto -1184 596 lineto -1193.6 600.478 lineto -closepath stroke -grestore -% Modops->Entries -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1401 936 moveto -1400 928 1398 919 1396 910 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1399.39 909.119 moveto -1394 900 lineto -1392.53 910.492 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1399.39 909.119 moveto -1394 900 lineto -1392.53 910.492 lineto -closepath stroke -grestore -% Mod_typing -gsave -0.502 1.000 0.820 nodecolor -1157 1170 47.1758 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1157 1170 47.1758 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1157 1165 moveto 69 -0.5 (Mod_typing) alignedtext -grestore -% Subtyping -gsave -0.502 1.000 0.820 nodecolor -1404 1026 42.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1404 1026 42.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1404 1021 moveto 58 -0.5 (Subtyping) alignedtext -grestore -% Mod_typing->Subtyping -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1183 1155 moveto -1227 1129 1320 1075 1370 1046 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1371.96 1048.92 moveto -1379 1041 lineto -1368.56 1042.8 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1371.96 1048.92 moveto -1379 1041 lineto -1368.56 1042.8 lineto -closepath stroke -grestore -% Term_typing -gsave -0.502 1.000 0.820 nodecolor -960 1098 50.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -960 1098 50.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -960 1093 moveto 74 -0.5 (Term_typing) alignedtext -grestore -% Mod_typing->Term_typing -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1123 1157 moveto -1090 1145 1040 1127 1005 1114 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1005.58 1110.52 moveto -995 1111 lineto -1003.57 1117.23 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1005.58 1110.52 moveto -995 1111 lineto -1003.57 1117.23 lineto -closepath stroke -grestore -% Subtyping->Typeops -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1365 1020 moveto -1282 1007 1092 975 1005 962 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1005.49 958.529 moveto -995 960 lineto -1004.12 965.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1005.49 958.529 moveto -995 960 lineto -1004.12 965.393 lineto -closepath stroke -grestore -% Subtyping->Modops -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1404 1008 moveto -1404 1000 1404 991 1404 982 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1407.5 982 moveto -1404 972 lineto -1400.5 982 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1407.5 982 moveto -1404 972 lineto -1400.5 982 lineto -closepath stroke -grestore -% Term_typing->Cooking -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 960 1080 moveto -960 1072 960 1063 960 1054 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 963.5 1054 moveto -960 1044 lineto -956.5 1054 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 963.5 1054 moveto -960 1044 lineto -956.5 1054 lineto -closepath stroke -grestore -% Term_typing->Indtypes -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 915 1090 moveto -833 1077 665 1048 584 1034 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 584.492 1030.53 moveto -574 1032 lineto -583.119 1037.39 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 584.492 1030.53 moveto -574 1032 lineto -583.119 1037.39 lineto -closepath stroke -grestore -% Reduction->Closure -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 713 720 moveto -713 712 713 703 713 694 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 716.5 694 moveto -713 684 lineto -709.5 694 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 716.5 694 moveto -713 684 lineto -709.5 694 lineto -closepath stroke -grestore -% Reduction->Conv_oracle -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 690 723 moveto -633 686 482 587 415 544 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 417.1 541.2 moveto -407 538 lineto -412.9 546.8 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 417.1 541.2 moveto -407 538 lineto -412.9 546.8 lineto -closepath stroke -grestore -% Safe_typing -gsave -0.502 1.000 0.820 nodecolor -1157 1242 47.1777 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1157 1242 47.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1157 1237 moveto 68 -0.5 (Safe_typing) alignedtext -grestore -% Safe_typing->Mod_typing -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1157 1224 moveto -1157 1216 1157 1207 1157 1198 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1160.5 1198 moveto -1157 1188 lineto -1153.5 1198 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1160.5 1198 moveto -1157 1188 lineto -1153.5 1198 lineto -closepath stroke -grestore -% Univ->Names -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 555 84 moveto -504 71 388 42 327 27 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 327.492 23.5292 moveto -317 25 lineto -326.119 30.3933 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 327.492 23.5292 moveto -317 25 lineto -326.119 30.3933 lineto -closepath stroke -grestore -% Vconv -gsave -0.502 1.000 0.820 nodecolor -1152 810 31.1748 18 ellipse_path fill -0.393658 setlinewidth -filled -0.502 1.000 0.820 nodecolor -1152 810 31.1748 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -1152 805 moveto 37 -0.5 (Vconv) alignedtext -grestore -% Vconv->Csymtable -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1151 792 moveto -1150 767 1149 723 1148 694 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 1151.5 694 moveto -1148 684 lineto -1144.5 694 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 1151.5 694 moveto -1148 684 lineto -1144.5 694 lineto -closepath stroke -grestore -% Vconv->Reduction -gsave -0.393658 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1122 805 moveto -1047 792 852 760 761 746 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 761.492 742.529 moveto -751 744 lineto -760.119 749.393 lineto -closepath fill -0.393658 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 761.492 742.529 moveto -751 744 lineto -760.119 749.393 lineto -closepath stroke -grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -%%BoundingBox: 36 36 535 756 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/lex.mll b/dev/ocamlweb-doc/lex.mll deleted file mode 100644 index 059526d9..00000000 --- a/dev/ocamlweb-doc/lex.mll +++ /dev/null @@ -1,81 +0,0 @@ - -{ - open Lexing - open Syntax - - let chan_out = ref stdout - - let comment_depth = ref 0 - let print s = output_string !chan_out s - - exception Fin_fichier - -} - -let space = [' ' '\t' '\n'] -let letter = ['a'-'z' 'A'-'Z'] -let digit = ['0'-'9'] - -let identifier = letter (letter | digit | ['_' '\''])* -let number = digit+ -let oper = ['-' '+' '/' '*' '|' '>' '<' '=' '%' '#' '$' ':' '\\' '?' - '.' '!' '@' ]+ - -rule token = parse - | "let" {LET} - | "in" {IN} - | "match" {MATCH} - | "with" {WITH} - | "end" {END} - | "and" {AND} - | "fun" {FUN} - | "if" {IF} - | "then" {THEN} - | "else" {ELSE} - | "eval" {EVAL} - | "for" {FOR} - | "Prop" {PROP} - | "Set" {SET} - | "Type" {TYPE} - | "fix" {FIX} - | "cofix" {COFIX} - | "struct" {STRUCT} - | "as" {AS} - - | "Simpl" {SIMPL} - - | "_" {WILDCARD} - | "(" {LPAR} - | ")" {RPAR} - | "{" {LBRACE} - | "}" {RBRACE} - | "!" {BANG} - | "@" {AT} - | ":" {COLON} - | ":=" {COLONEQ} - | "." {DOT} - | "," {COMMA} - | "->" {OPER "->"} - | "=>" {RARROW} - | "|" {BAR} - | "%" {PERCENT} - - | '?' { META(ident lexbuf)} - | number { INT(Lexing.lexeme lexbuf) } - | oper { OPER(Lexing.lexeme lexbuf) } - | identifier { IDENT (Lexing.lexeme lexbuf) } - | "(*" (*"*)"*) { comment_depth := 1; - comment lexbuf; - token lexbuf } - | space+ { token lexbuf} - | eof { EOF } - -and ident = parse - | identifier { Lexing.lexeme lexbuf } - -and comment = parse - | "(*" (*"*)"*) { incr comment_depth; comment lexbuf } - | (*"(*"*) "*)" - { decr comment_depth; if !comment_depth > 0 then comment lexbuf } - | eof { raise Fin_fichier } - | _ { comment lexbuf } diff --git a/dev/ocamlweb-doc/library.dep.ps b/dev/ocamlweb-doc/library.dep.ps deleted file mode 100644 index c9bb351e..00000000 --- a/dev/ocamlweb-doc/library.dep.ps +++ /dev/null @@ -1,773 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: Graphviz version 2.12 (Tue Oct 23 13:46:12 UTC 2007) -%%For: (notin) Jean-Marc Notin,,, -%%Title: G -%%Pages: (atend) -%%BoundingBox: (atend) -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval -EncodingVector 45 /hyphen put - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -setupLatin1 -%%Page: 1 1 -%%PageBoundingBox: 36 36 576 752 -%%PageOrientation: Landscape -gsave -36 36 576 752 boxprim clip newpath -0 0 1 beginpage -0.985401 0.985401 set_scale 90 rotate 40.5333 -580.533 translate -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 544 lineto -723 544 lineto -723 -4 lineto -closepath fill -0.985401 setlinewidth -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 544 lineto -723 544 lineto -723 -4 lineto -closepath stroke -% Declare -gsave -0.502 1.000 0.820 nodecolor -488 436 34.1751 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -488 436 34.1751 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -488 431 moveto 43 -0.5 (Declare) alignedtext -grestore -% Dischargedhypsmap -gsave -0.502 1.000 0.820 nodecolor -488 353 69.1764 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -488 353 69.1764 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -488 348 moveto 113 -0.5 (Dischargedhypsmap) alignedtext -grestore -% Declare->Dischargedhypsmap -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 488 418 moveto -488 407 488 393 488 381 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 491.5 381 moveto -488 371 lineto -484.5 381 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 491.5 381 moveto -488 371 lineto -484.5 381 lineto -closepath stroke -grestore -% Impargs -gsave -0.502 1.000 0.820 nodecolor -201 353 36.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -201 353 36.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -201 348 moveto 46 -0.5 (Impargs) alignedtext -grestore -% Declare->Impargs -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 458 427 moveto -407 412 301 382 242 365 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 242.584 361.521 moveto -232 362 lineto -240.573 368.226 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 242.584 361.521 moveto -232 362 lineto -240.573 368.226 lineto -closepath stroke -grestore -% Decl_kinds -gsave -0.502 1.000 0.820 nodecolor -661 353 44.1757 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -661 353 44.1757 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -661 348 moveto 63 -0.5 (Decl_kinds) alignedtext -grestore -% Declare->Decl_kinds -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 514 424 moveto -543 410 590 388 624 372 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 625.958 374.916 moveto -633 367 lineto -622.559 368.797 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 625.958 374.916 moveto -633 367 lineto -622.559 368.797 lineto -closepath stroke -grestore -% Lib -gsave -0.502 1.000 0.820 nodecolor -219 270 27 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -219 270 27 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -219 265 moveto 20 -0.5 (Lib) alignedtext -grestore -% Dischargedhypsmap->Lib -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 443 339 moveto -390 323 302 296 254 281 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 254.584 277.521 moveto -244 278 lineto -252.573 284.226 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 254.584 277.521 moveto -244 278 lineto -252.573 284.226 lineto -closepath stroke -grestore -% Global -gsave -0.502 1.000 0.820 nodecolor -82 270 32.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -82 270 32.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -82 265 moveto 38 -0.5 (Global) alignedtext -grestore -% Impargs->Global -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 180 338 moveto -161 325 132 305 110 290 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 112.1 287.2 moveto -102 284 lineto -107.9 292.8 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 112.1 287.2 moveto -102 284 lineto -107.9 292.8 lineto -closepath stroke -grestore -% Impargs->Lib -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 205 335 moveto -207 324 210 310 213 298 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 216.471 298.492 moveto -215 288 lineto -209.607 297.119 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 216.471 298.492 moveto -215 288 lineto -209.607 297.119 lineto -closepath stroke -grestore -% Declaremods -gsave -0.502 1.000 0.820 nodecolor -65 353 49.1759 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -65 353 49.1759 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -65 348 moveto 73 -0.5 (Declaremods) alignedtext -grestore -% Declaremods->Global -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 69 335 moveto -71 324 74 310 76 298 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 79.4708 298.492 moveto -78 288 lineto -72.6067 297.119 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 79.4708 298.492 moveto -78 288 lineto -72.6067 297.119 lineto -closepath stroke -grestore -% Declaremods->Lib -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 93 338 moveto -120 324 161 301 189 286 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 190.958 288.916 moveto -198 281 lineto -187.559 282.797 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 190.958 288.916 moveto -198 281 lineto -187.559 282.797 lineto -closepath stroke -grestore -% Summary -gsave -0.502 1.000 0.820 nodecolor -69 103 40.1755 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -69 103 40.1755 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -69 98 moveto 55 -0.5 (Summary) alignedtext -grestore -% Global->Summary -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 81 252 moveto -78 223 74 166 71 131 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 74.4778 130.602 moveto -70 121 lineto -67.5125 131.299 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 74.4778 130.602 moveto -70 121 lineto -67.5125 131.299 lineto -closepath stroke -grestore -% Libnames -gsave -0.502 1.000 0.820 nodecolor -203 103 40.1755 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -203 103 40.1755 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -203 98 moveto 55 -0.5 (Libnames) alignedtext -grestore -% Global->Libnames -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 94 253 moveto -115 224 159 164 184 129 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 186.8 131.1 moveto -190 121 lineto -181.2 126.9 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 186.8 131.1 moveto -190 121 lineto -181.2 126.9 lineto -closepath stroke -grestore -% Nametab -gsave -0.502 1.000 0.820 nodecolor -203 186 38.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -203 186 38.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -203 181 moveto 50 -0.5 (Nametab) alignedtext -grestore -% Lib->Nametab -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 216 252 moveto -214 241 211 226 209 214 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 212.393 213.119 moveto -207 204 lineto -205.529 214.492 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 212.393 213.119 moveto -207 204 lineto -205.529 214.492 lineto -closepath stroke -grestore -% Libobject -gsave -0.502 1.000 0.820 nodecolor -329 186 40.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -329 186 40.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -329 181 moveto 54 -0.5 (Libobject) alignedtext -grestore -% Lib->Libobject -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 237 256 moveto -254 243 280 223 300 208 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 302.1 210.8 moveto -308 202 lineto -297.9 205.2 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 302.1 210.8 moveto -308 202 lineto -297.9 205.2 lineto -closepath stroke -grestore -% Nameops -gsave -0.502 1.000 0.820 nodecolor -203 20 39.1777 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -203 20 39.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -203 15 moveto 52 -0.5 (Nameops) alignedtext -grestore -% Libnames->Nameops -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 203 85 moveto -203 74 203 60 203 48 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 206.5 48 moveto -203 38 lineto -199.5 48 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 206.5 48 moveto -203 38 lineto -199.5 48 lineto -closepath stroke -grestore -% Goptions -gsave -0.502 1.000 0.820 nodecolor -322 353 38.1754 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -322 353 38.1754 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -322 348 moveto 51 -0.5 (Goptions) alignedtext -grestore -% Goptions->Lib -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 303 337 moveto -287 324 263 305 245 291 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 246.831 287.951 moveto -237 284 lineto -242.221 293.219 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 246.831 287.951 moveto -237 284 lineto -242.221 293.219 lineto -closepath stroke -grestore -% Nametab->Summary -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 180 172 moveto -158 159 125 138 101 123 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 102.441 119.797 moveto -92 118 lineto -99.0418 125.916 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 102.441 119.797 moveto -92 118 lineto -99.0418 125.916 lineto -closepath stroke -grestore -% Nametab->Libnames -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 203 168 moveto -203 157 203 143 203 131 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 206.5 131 moveto -203 121 lineto -199.5 131 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 206.5 131 moveto -203 121 lineto -199.5 131 lineto -closepath stroke -grestore -% Libobject->Libnames -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 306 171 moveto -286 158 256 138 235 124 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 236.262 120.635 moveto -226 118 lineto -232.379 126.459 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 236.262 120.635 moveto -226 118 lineto -232.379 126.459 lineto -closepath stroke -grestore -% Library -gsave -0.502 1.000 0.820 nodecolor -65 436 34.1751 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -65 436 34.1751 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -65 431 moveto 43 -0.5 (Library) alignedtext -grestore -% Library->Declaremods -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 65 418 moveto -65 407 65 393 65 381 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 68.5001 381 moveto -65 371 lineto -61.5001 381 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 68.5001 381 moveto -65 371 lineto -61.5001 381 lineto -closepath stroke -grestore -% States -gsave -0.502 1.000 0.820 nodecolor -65 519 29.1747 18 ellipse_path fill -0.985401 setlinewidth -filled -0.502 1.000 0.820 nodecolor -65 519 29.1747 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -65 514 moveto 33 -0.5 (States) alignedtext -grestore -% States->Library -gsave -0.985401 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 65 501 moveto -65 490 65 476 65 464 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 68.5001 464 moveto -65 454 lineto -61.5001 464 lineto -closepath fill -0.985401 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 68.5001 464 moveto -65 454 lineto -61.5001 464 lineto -closepath stroke -grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -%%BoundingBox: 36 36 576 752 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/macros.tex b/dev/ocamlweb-doc/macros.tex deleted file mode 100644 index 6beacf7b..00000000 --- a/dev/ocamlweb-doc/macros.tex +++ /dev/null @@ -1,7 +0,0 @@ - -% macros for coq.tex - -\newcommand{\Coq}{\textsf{Coq}} -\newcommand{\CCI}{Calculus of Inductive Constructions} - -\newcommand{\refsec}[1]{\textbf{\ref{#1}}} \ No newline at end of file diff --git a/dev/ocamlweb-doc/parse.ml b/dev/ocamlweb-doc/parse.ml deleted file mode 100644 index b145fffd..00000000 --- a/dev/ocamlweb-doc/parse.ml +++ /dev/null @@ -1,183 +0,0 @@ - -open Ast - -type assoc = L | R | N - -let level = function - | "--" -> 70,L - | "=" -> 70,N - | "+" -> 60,L - | "++" -> 60,R - | "+++" -> 60,R - | "-" -> 60,L - | "*" -> 50,L - | "/" -> 50,L - | "**" -> 40,R - | ":" -> (100,R) - | "->" -> (90,R) - | s -> failwith ("unknowm operator '"^s^"'") - -let fixity = function - | "--" -> [L] - | "=" -> [N] - | ("+"|"-"|"*"|"/") -> [L;N] - | "++" -> [R] - | _ -> [L;N;R] - -let ground_oper = function - ("-"|"+") -> true - | _ -> false - -let is_prefix op = List.mem L (fixity op) -let is_infix op = List.mem N (fixity op) -let is_postfix op = List.mem R (fixity op) - -let mk_inf op t1 t2 = - if not (is_infix op) then failwith (op^" not infix"); - Infix(op,t1,t2) - -let mk_post op t = - if not (is_postfix op) then failwith (op^" not postfix"); - Postfix(op,t) - - -(* Pb avec ground_oper: pas de diff entre -1 et -(1) *) -let mk_pre op t = - if not (is_prefix op) then failwith (op^" not prefix"); - if ground_oper op then - match t with - | Int i -> Int (op^i) - | _ -> Prefix(op,t) - else Prefix(op,t) - -(* teste si on peut reduire op suivi d'un op de niveau (n,a) - si la reponse est false, c'est que l'op (n,a) doit se reduire - avant *) -let red_left_op (nl,al) (nr,ar) = - if nl < nr then true - else - if nl = nr then - match al,ar with - | (L|N), L -> true - | R, (R|N) -> false - | R, L -> failwith "conflit d'assoc: ambigu" - | (L|N), (R|N) -> failwith "conflit d'assoc: blocage" - else false - - -type level = int * assoc -type stack = - | PrefixOper of string list - | Term of constr_ast * stack - | Oper of string list * string * constr_ast * stack - -let rec str_ast = function - | Infix(op,t1,t2) -> str_ast t1 ^ " " ^ op ^ " " ^ str_ast t2 - | Postfix(op,t) -> str_ast t ^ " " ^ op - | Prefix(op,t) -> op ^ " " ^ str_ast t - | _ -> "_" - -let rec str_stack = function - | PrefixOper ops -> String.concat " " (List.rev ops) - | Term (t,s) -> str_stack s ^ " (" ^ str_ast t ^ ")" - | Oper(ops,lop,t,s) -> - str_stack (Term(t,s)) ^ " " ^ lop ^ " " ^ - String.concat " " (List.rev ops) - -let pps s = prerr_endline (str_stack s) -let err s stk = failwith (s^": "^str_stack stk) - - -let empty = PrefixOper [] - -let check_fixity_term stk = - match stk with - Term _ -> err "2 termes successifs" stk - | _ -> () - -let shift_term t stk = - check_fixity_term stk; - Term(t,stk) - -let shift_oper op stk = - match stk with - | Oper(ops,lop,t,s) -> Oper(op::ops,lop,t,s) - | Term(t,s) -> Oper([],op,t,s) - | PrefixOper ops -> PrefixOper (op::ops) - -let is_reducible lv stk = - match stk with - | Oper([],iop,_,_) -> red_left_op (level iop) lv - | Oper(op::_,_,_,_) -> red_left_op (level op) lv - | PrefixOper(op::_) -> red_left_op (level op) lv - | _ -> false - -let reduce_head (t,stk) = - match stk with - | Oper([],iop,t1,s) -> - (Infix(iop,t1,t), s) - | Oper(op::ops,lop,t',s) -> - (mk_pre op t, Oper(ops,lop,t',s)) - | PrefixOper(op::ops) -> - (Prefix(op,t), PrefixOper ops) - | _ -> assert false - -let rec reduce_level lv (t,s) = - if is_reducible lv s then reduce_level lv (reduce_head (t, s)) - else (t, s) - -let reduce_post op (t,s) = - let (t',s') = reduce_level (level op) (t,s) in - (mk_post op t', s') - -let reduce_posts stk = - match stk with - Oper(ops,iop,t,s) -> - let pts1 = reduce_post iop (t,s) in - List.fold_right reduce_post ops pts1 - | Term(t,s) -> (t,s) - | PrefixOper _ -> failwith "reduce_posts" - - -let shift_infix op stk = - let (t,s) = reduce_level (level op) (reduce_posts stk) in - Oper([],op,t,s) - -let is_better_infix op stk = - match stk with - | Oper(ops,iop,t,s) -> - is_postfix iop && - List.for_all is_postfix ops && - (not (is_prefix op) || red_left_op (level iop) (level op)) - | Term _ -> false - | _ -> assert false - -let parse_oper op stk = - match stk with - | PrefixOper _ -> - if is_prefix op then shift_oper op stk else failwith "prefix_oper" - | Oper _ -> - if is_infix op then - if is_better_infix op stk then shift_infix op stk - else shift_oper op stk - else if is_prefix op then shift_oper op stk - else if is_postfix op then - let (t,s) = reduce_post op (reduce_posts stk) in - Term(t,s) - else assert false - | Term(t,s) -> - if is_infix op then shift_infix op stk - else if is_postfix op then - let (t2,s2) = reduce_post op (t,s) in Term(t2,s2) - else failwith "infix/postfix" - -let parse_term = shift_term - -let rec close_stack stk = - match stk with - Term(t,PrefixOper []) -> t - | PrefixOper _ -> failwith "expression sans atomes" - | _ -> - let (t,s) = reduce_head (reduce_posts stk) in - close_stack (Term(t,s)) - diff --git a/dev/ocamlweb-doc/parsing.dep.ps b/dev/ocamlweb-doc/parsing.dep.ps deleted file mode 100644 index 723d8c69..00000000 --- a/dev/ocamlweb-doc/parsing.dep.ps +++ /dev/null @@ -1,1115 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005) -%%For: (herbelin) Hugo Herbelin -%%Title: G -%%Pages: (atend) -%%BoundingBox: 35 35 577 314 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 577 314 -%%PageOrientation: Portrait -gsave -35 35 542 279 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0.6027 set_scale -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% Pcoq -gsave 10 dict begin -557 280 27 18 ellipse_path -stroke -gsave 10 dict begin -543 275 moveto -(Pcoq) -[7.68 6.24 6.96 6.96] -xshow -end grestore -end grestore - -% Extend -gsave 10 dict begin -664 226 33 18 ellipse_path -stroke -gsave 10 dict begin -643 221 moveto -(Extend) -[8.4 6.96 3.84 6.24 6.96 6.96] -xshow -end grestore -end grestore - -% Pcoq -> Extend -newpath 579 269 moveto -593 261 613 252 630 243 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 632 246 moveto -639 238 lineto -629 240 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 632 246 moveto -639 238 lineto -629 240 lineto -closepath -stroke -end grestore - -% Ast -gsave 10 dict begin -764 172 27 18 ellipse_path -stroke -gsave 10 dict begin -753 167 moveto -(Ast) -[10.08 5.28 3.84] -xshow -end grestore -end grestore - -% Extend -> Ast -newpath 688 213 moveto -701 206 719 196 734 188 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 736 191 moveto -743 183 lineto -733 185 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 736 191 moveto -743 183 lineto -733 185 lineto -closepath -stroke -end grestore - -% Lexer -gsave 10 dict begin -764 226 29 18 ellipse_path -stroke -gsave 10 dict begin -747 221 moveto -(Lexer) -[8.4 5.76 6.48 6.24 4.56] -xshow -end grestore -end grestore - -% Extend -> Lexer -newpath 698 226 moveto -706 226 715 226 724 226 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 724 230 moveto -734 226 lineto -724 223 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 724 230 moveto -734 226 lineto -724 223 lineto -closepath -stroke -end grestore - -% Termast -gsave 10 dict begin -557 172 35 18 ellipse_path -stroke -gsave 10 dict begin -534 167 moveto -(Termast) -[7.2 6.24 4.8 10.8 6.24 5.28 3.84] -xshow -end grestore -end grestore - -% Termast -> Ast -newpath 593 172 moveto -630 172 689 172 727 172 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 727 176 moveto -737 172 lineto -727 169 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 727 176 moveto -737 172 lineto -727 169 lineto -closepath -stroke -end grestore - -% Coqast -gsave 10 dict begin -863 172 32 18 ellipse_path -stroke -gsave 10 dict begin -843 167 moveto -(Coqast) -[9.36 6.96 6.96 6.24 5.28 3.84] -xshow -end grestore -end grestore - -% Ast -> Coqast -newpath 791 172 moveto -800 172 810 172 820 172 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 820 176 moveto -830 172 lineto -820 169 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 820 176 moveto -830 172 lineto -820 169 lineto -closepath -stroke -end grestore - -% Tactic_printer -gsave 10 dict begin -53 126 52 18 ellipse_path -stroke -gsave 10 dict begin -13 121 moveto -(Tactic_printer) -[7.44 6.24 6.24 3.84 3.84 6.24 6.96 6.96 4.8 3.84 6.96 3.84 6.24 4.56] -xshow -end grestore -end grestore - -% Pptactic -gsave 10 dict begin -178 126 36 18 ellipse_path -stroke -gsave 10 dict begin -155 121 moveto -(Pptactic) -[7.68 6.96 4.08 6.24 6.24 3.84 3.84 6.24] -xshow -end grestore -end grestore - -% Tactic_printer -> Pptactic -newpath 106 126 moveto -114 126 123 126 132 126 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 132 130 moveto -142 126 lineto -132 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 132 130 moveto -142 126 lineto -132 123 lineto -closepath -stroke -end grestore - -% Printer -gsave 10 dict begin -289 72 32 18 ellipse_path -stroke -gsave 10 dict begin -269 67 moveto -(Printer) -[7.68 4.8 3.84 6.96 3.84 6.24 4.56] -xshow -end grestore -end grestore - -% Pptactic -> Printer -newpath 204 113 moveto -219 105 238 96 255 88 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 256 91 moveto -264 84 lineto -253 85 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 256 91 moveto -264 84 lineto -253 85 lineto -closepath -stroke -end grestore - -% Search -gsave 10 dict begin -178 72 32 18 ellipse_path -stroke -gsave 10 dict begin -159 67 moveto -(Search) -[7.68 6.24 6.24 4.56 6 6.96] -xshow -end grestore -end grestore - -% Search -> Printer -newpath 210 72 moveto -221 72 234 72 246 72 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 246 76 moveto -256 72 lineto -246 69 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 246 76 moveto -256 72 lineto -246 69 lineto -closepath -stroke -end grestore - -% Printer -> Termast -newpath 316 62 moveto -355 48 430 30 484 58 curveto -518 77 538 117 548 144 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 545 146 moveto -552 154 lineto -552 143 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 545 146 moveto -552 154 lineto -552 143 lineto -closepath -stroke -end grestore - -% Esyntax -gsave 10 dict begin -557 226 36 18 ellipse_path -stroke -gsave 10 dict begin -533 221 moveto -(Esyntax) -[8.4 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% Printer -> Esyntax -newpath 322 71 moveto -370 70 460 72 484 91 curveto -489 95 516 193 520 197 curveto -527 204 532 203 538 204 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 536 207 moveto -547 208 lineto -539 201 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 536 207 moveto -547 208 lineto -539 201 lineto -closepath -stroke -end grestore - -% Ppconstr -gsave 10 dict begin -424 388 37 18 ellipse_path -stroke -gsave 10 dict begin -399 383 moveto -(Ppconstr) -[7.68 6.96 6.24 6.96 6.96 5.28 3.84 4.56] -xshow -end grestore -end grestore - -% Printer -> Ppconstr -newpath 292 90 moveto -300 147 329 319 364 361 curveto -369 367 375 371 382 375 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 380 378 moveto -391 379 lineto -383 372 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 380 378 moveto -391 379 lineto -383 372 lineto -closepath -stroke -end grestore - -% Esyntax -> Extend -newpath 594 226 moveto -602 226 611 226 620 226 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 620 230 moveto -630 226 lineto -620 223 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 620 230 moveto -630 226 lineto -620 223 lineto -closepath -stroke -end grestore - -% Ppconstr -> Pcoq -newpath 454 377 moveto -464 373 475 368 484 361 curveto -506 345 526 322 540 304 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 543 306 moveto -546 296 lineto -537 302 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 543 306 moveto -546 296 lineto -537 302 lineto -closepath -stroke -end grestore - -% Prettyp -gsave 10 dict begin -178 18 33 18 ellipse_path -stroke -gsave 10 dict begin -158 13 moveto -(Prettyp) -[7.68 4.56 6 3.84 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Prettyp -> Printer -newpath 203 30 moveto -218 38 238 47 255 55 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 254 58 moveto -264 60 lineto -257 52 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 254 58 moveto -264 60 lineto -257 52 lineto -closepath -stroke -end grestore - -% Printmod -gsave 10 dict begin -289 18 39 18 ellipse_path -stroke -gsave 10 dict begin -263 13 moveto -(Printmod) -[7.68 4.8 3.84 6.96 3.84 10.8 6.96 6.96] -xshow -end grestore -end grestore - -% Prettyp -> Printmod -newpath 211 18 moveto -220 18 230 18 240 18 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 240 22 moveto -250 18 lineto -240 15 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 240 22 moveto -250 18 lineto -240 15 lineto -closepath -stroke -end grestore - -% G_zsyntax -gsave 10 dict begin -424 172 43 18 ellipse_path -stroke -gsave 10 dict begin -393 167 moveto -(G_zsyntax) -[10.08 6.96 6.24 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% G_zsyntax -> Pcoq -newpath 458 183 moveto -467 188 476 193 484 199 curveto -507 218 501 233 520 253 curveto -523 256 526 259 530 261 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 528 264 moveto -538 267 lineto -532 258 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 528 264 moveto -538 267 lineto -532 258 lineto -closepath -stroke -end grestore - -% G_zsyntax -> Termast -newpath 468 172 moveto -482 172 497 172 511 172 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 511 176 moveto -521 172 lineto -511 169 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 511 176 moveto -521 172 lineto -511 169 lineto -closepath -stroke -end grestore - -% G_zsyntax -> Esyntax -newpath 455 185 moveto -474 193 499 203 520 211 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 518 214 moveto -529 215 lineto -521 208 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 518 214 moveto -529 215 lineto -521 208 lineto -closepath -stroke -end grestore - -% G_string_syntax -gsave 10 dict begin -424 280 59 18 ellipse_path -stroke -gsave 10 dict begin -377 275 moveto -(G_string_syntax) -[10.08 6.96 5.28 3.84 4.8 3.84 6.96 6.96 6.96 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% G_string_syntax -> Pcoq -newpath 484 280 moveto -496 280 509 280 520 280 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 520 284 moveto -530 280 lineto -520 277 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 520 284 moveto -530 280 lineto -520 277 lineto -closepath -stroke -end grestore - -% G_string_syntax -> Esyntax -newpath 460 266 moveto -478 258 501 249 520 242 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 521 245 moveto -529 238 lineto -518 239 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 521 245 moveto -529 238 lineto -518 239 lineto -closepath -stroke -end grestore - -% G_rsyntax -gsave 10 dict begin -424 118 42 18 ellipse_path -stroke -gsave 10 dict begin -394 113 moveto -(G_rsyntax) -[10.08 6.96 4.56 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% G_rsyntax -> Pcoq -newpath 459 128 moveto -468 132 477 138 484 145 curveto -518 183 491 213 520 253 curveto -523 256 526 259 529 262 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 527 265 moveto -537 268 lineto -531 259 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 527 265 moveto -537 268 lineto -531 259 lineto -closepath -stroke -end grestore - -% G_rsyntax -> Termast -newpath 455 131 moveto -474 139 499 149 520 157 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 518 160 moveto -529 161 lineto -521 154 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 518 160 moveto -529 161 lineto -521 154 lineto -closepath -stroke -end grestore - -% G_rsyntax -> Esyntax -newpath 457 129 moveto -467 133 476 139 484 145 curveto -507 164 501 179 520 199 curveto -522 201 525 203 527 205 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 525 208 moveto -535 212 lineto -530 203 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 525 208 moveto -535 212 lineto -530 203 lineto -closepath -stroke -end grestore - -% G_natsyntax -gsave 10 dict begin -424 226 48 18 ellipse_path -stroke -gsave 10 dict begin -388 221 moveto -(G_natsyntax) -[10.08 6.96 6.96 6.24 3.84 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% G_natsyntax -> Pcoq -newpath 457 239 moveto -478 248 504 259 525 266 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 523 269 moveto -534 270 lineto -526 263 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 523 269 moveto -534 270 lineto -526 263 lineto -closepath -stroke -end grestore - -% G_natsyntax -> Termast -newpath 457 213 moveto -476 205 500 195 520 187 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 521 190 moveto -529 183 lineto -518 184 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 521 190 moveto -529 183 lineto -518 184 lineto -closepath -stroke -end grestore - -% G_natsyntax -> Esyntax -newpath 473 226 moveto -485 226 498 226 510 226 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 510 230 moveto -520 226 lineto -510 223 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 510 230 moveto -520 226 lineto -510 223 lineto -closepath -stroke -end grestore - -% G_ascii_syntax -gsave 10 dict begin -424 334 56 18 ellipse_path -stroke -gsave 10 dict begin -380 329 moveto -(G_ascii_syntax) -[10.08 6.96 6.24 5.52 6.24 3.84 3.84 6.96 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% G_ascii_syntax -> Pcoq -newpath 459 320 moveto -479 311 504 301 525 293 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 526 296 moveto -534 289 lineto -523 290 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 526 296 moveto -534 289 lineto -523 290 lineto -closepath -stroke -end grestore - -% G_ascii_syntax -> Esyntax -newpath 462 321 moveto -470 317 478 312 484 307 curveto -507 288 501 273 520 253 curveto -522 251 524 249 527 247 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 529 250 moveto -535 241 lineto -525 244 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 529 250 moveto -535 241 lineto -525 244 lineto -closepath -stroke -end grestore - -% Egrammar -gsave 10 dict begin -424 442 43 18 ellipse_path -stroke -gsave 10 dict begin -394 437 moveto -(Egrammar) -[8.4 7.2 4.56 6.24 10.8 10.8 6.24 4.56] -xshow -end grestore -end grestore - -% Egrammar -> Pcoq -newpath 458 431 moveto -467 427 477 422 484 415 curveto -516 385 537 337 548 308 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 551 309 moveto -551 298 lineto -545 307 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 551 309 moveto -551 298 lineto -545 307 lineto -closepath -stroke -end grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/preamble.tex b/dev/ocamlweb-doc/preamble.tex deleted file mode 100644 index 2cd21f02..00000000 --- a/dev/ocamlweb-doc/preamble.tex +++ /dev/null @@ -1,8 +0,0 @@ -\documentclass[11pt]{article} -\usepackage[latin1]{inputenc} -\usepackage[T1]{fontenc} -\usepackage{ocamlweb} -\pagestyle{ocamlweb} -\usepackage{fullpage} -\usepackage{epsfig} -\begin{document} diff --git a/dev/ocamlweb-doc/pretyping.dep.ps b/dev/ocamlweb-doc/pretyping.dep.ps deleted file mode 100644 index 02d1b8b5..00000000 --- a/dev/ocamlweb-doc/pretyping.dep.ps +++ /dev/null @@ -1,1259 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005) -%%For: (herbelin) Hugo Herbelin -%%Title: G -%%Pages: (atend) -%%BoundingBox: 35 35 577 146 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 577 146 -%%PageOrientation: Portrait -gsave -35 35 542 111 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0.3600 set_scale -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% Unification -gsave 10 dict begin -610 118 45 18 ellipse_path -stroke -gsave 10 dict begin -577 113 moveto -(Unification) -[9.6 6.96 3.84 4.8 3.84 6.24 6.24 3.84 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Evarutil -gsave 10 dict begin -728 72 36 18 ellipse_path -stroke -gsave 10 dict begin -705 67 moveto -(Evarutil) -[8.4 6.72 6.24 4.8 6.96 3.84 3.84 3.84] -xshow -end grestore -end grestore - -% Unification -> Evarutil -newpath 643 105 moveto -657 99 674 93 689 87 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 691 90 moveto -699 83 lineto -688 83 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 691 90 moveto -699 83 lineto -688 83 lineto -closepath -stroke -end grestore - -% Pattern -gsave 10 dict begin -728 210 33 18 ellipse_path -stroke -gsave 10 dict begin -708 205 moveto -(Pattern) -[7.44 6.24 3.84 3.84 6.24 4.8 6.96] -xshow -end grestore -end grestore - -% Unification -> Pattern -newpath 631 134 moveto -650 150 680 173 701 189 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 699 192 moveto -709 195 lineto -703 186 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 699 192 moveto -709 195 lineto -703 186 lineto -closepath -stroke -end grestore - -% Retyping -gsave 10 dict begin -839 118 38 18 ellipse_path -stroke -gsave 10 dict begin -813 113 moveto -(Retyping) -[9.12 6 3.84 6.96 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Unification -> Retyping -newpath 656 118 moveto -695 118 750 118 790 118 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 790 122 moveto -800 118 lineto -790 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 790 122 moveto -800 118 lineto -790 115 lineto -closepath -stroke -end grestore - -% Typing -gsave 10 dict begin -839 64 32 18 ellipse_path -stroke -gsave 10 dict begin -819 59 moveto -(Typing) -[6.96 6.96 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Evarutil -> Typing -newpath 764 69 moveto -775 68 786 67 797 67 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 797 70 moveto -807 66 lineto -797 64 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 797 70 moveto -807 66 lineto -797 64 lineto -closepath -stroke -end grestore - -% Rawterm -gsave 10 dict begin -1109 110 39 18 ellipse_path -stroke -gsave 10 dict begin -1083 105 moveto -(Rawterm) -[9.36 5.76 10.08 3.84 6.24 4.8 10.8] -xshow -end grestore -end grestore - -% Pattern -> Rawterm -newpath 759 216 moveto -816 226 939 239 1024 191 curveto -1049 176 1038 155 1060 138 curveto -1069 131 1077 130 1084 129 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1085 132 moveto -1094 127 lineto -1084 126 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1085 132 moveto -1094 127 lineto -1084 126 lineto -closepath -stroke -end grestore - -% Inductiveops -gsave 10 dict begin -1109 164 49 18 ellipse_path -stroke -gsave 10 dict begin -1073 159 moveto -(Inductiveops) -[4.56 6.96 6.96 6.96 6.24 3.84 3.84 6.48 6.24 6.96 6.96 5.52] -xshow -end grestore -end grestore - -% Retyping -> Inductiveops -newpath 878 120 moveto -915 122 974 126 1024 137 curveto -1037 139 1051 144 1064 148 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1063 151 moveto -1074 151 lineto -1065 145 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1063 151 moveto -1074 151 lineto -1065 145 lineto -closepath -stroke -end grestore - -% Pretype_errors -gsave 10 dict begin -969 72 54 18 ellipse_path -stroke -gsave 10 dict begin -927 67 moveto -(Pretype_errors) -[7.68 4.56 6 3.84 6.96 6.96 6.24 6.96 6.24 5.04 4.56 6.96 4.56 5.52] -xshow -end grestore -end grestore - -% Typing -> Pretype_errors -newpath 871 66 moveto -881 67 893 68 905 68 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 905 71 moveto -915 69 lineto -905 65 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 905 71 moveto -915 69 lineto -905 65 lineto -closepath -stroke -end grestore - -% Pretype_errors -> Inductiveops -newpath 998 87 moveto -1007 92 1016 98 1024 104 curveto -1042 116 1043 124 1060 137 curveto -1063 139 1067 142 1071 144 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1070 147 moveto -1080 149 lineto -1073 141 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1070 147 moveto -1080 149 lineto -1073 141 lineto -closepath -stroke -end grestore - -% Pretype_errors -> Rawterm -newpath 1011 84 moveto -1029 88 1048 94 1065 98 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1064 101 moveto -1075 101 lineto -1066 95 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1064 101 moveto -1075 101 lineto -1066 95 lineto -closepath -stroke -end grestore - -% Tacred -gsave 10 dict begin -728 18 32 18 ellipse_path -stroke -gsave 10 dict begin -709 13 moveto -(Tacred) -[7.44 6.24 6.24 4.56 6.24 6.96] -xshow -end grestore -end grestore - -% Tacred -> Retyping -newpath 748 32 moveto -754 36 759 41 764 45 curveto -783 63 782 73 800 91 curveto -802 93 805 95 808 97 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 806 100 moveto -816 103 lineto -810 94 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 806 100 moveto -816 103 lineto -810 94 lineto -closepath -stroke -end grestore - -% Tacred -> Typing -newpath 754 29 moveto -769 35 787 43 803 49 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 802 53 moveto -813 53 lineto -805 46 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 802 53 moveto -813 53 lineto -805 46 lineto -closepath -stroke -end grestore - -% Cbv -gsave 10 dict begin -1246 41 27 18 ellipse_path -stroke -gsave 10 dict begin -1234 36 moveto -(Cbv) -[9.36 6.48 6.96] -xshow -end grestore -end grestore - -% Tacred -> Cbv -newpath 760 19 moveto -852 23 1111 35 1209 40 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1209 44 moveto -1219 40 lineto -1209 37 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1209 44 moveto -1219 40 lineto -1209 37 lineto -closepath -stroke -end grestore - -% Evd -gsave 10 dict begin -1361 110 27 18 ellipse_path -stroke -gsave 10 dict begin -1349 105 moveto -(Evd) -[8.4 6.96 6.96] -xshow -end grestore -end grestore - -% Cbv -> Evd -newpath 1266 53 moveto -1284 64 1312 80 1332 93 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1331 96 moveto -1341 98 lineto -1334 90 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1331 96 moveto -1341 98 lineto -1334 90 lineto -closepath -stroke -end grestore - -% Reductionops -gsave 10 dict begin -1246 164 51 18 ellipse_path -stroke -gsave 10 dict begin -1207 159 moveto -(Reductionops) -[9.12 6.24 6.96 6.96 6.24 3.84 3.84 6.96 6.96 6.96 6.96 5.52] -xshow -end grestore -end grestore - -% Inductiveops -> Reductionops -newpath 1158 164 moveto -1167 164 1175 164 1184 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1184 168 moveto -1194 164 lineto -1184 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1184 168 moveto -1194 164 lineto -1184 161 lineto -closepath -stroke -end grestore - -% Reductionops -> Evd -newpath 1277 150 moveto -1294 142 1313 133 1330 125 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1331 128 moveto -1339 121 lineto -1328 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1331 128 moveto -1339 121 lineto -1328 122 lineto -closepath -stroke -end grestore - -% Termops -gsave 10 dict begin -1462 110 37 18 ellipse_path -stroke -gsave 10 dict begin -1437 105 moveto -(Termops) -[7.2 6.24 4.8 10.8 6.96 6.96 5.52] -xshow -end grestore -end grestore - -% Evd -> Termops -newpath 1388 110 moveto -1396 110 1405 110 1414 110 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1414 114 moveto -1424 110 lineto -1414 107 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1414 114 moveto -1424 110 lineto -1414 107 lineto -closepath -stroke -end grestore - -% Recordops -gsave 10 dict begin -485 24 43 18 ellipse_path -stroke -gsave 10 dict begin -455 19 moveto -(Recordops) -[9.12 6.24 6.24 6.96 4.32 6.96 6.96 6.96 5.52] -xshow -end grestore -end grestore - -% Classops -gsave 10 dict begin -610 20 38 18 ellipse_path -stroke -gsave 10 dict begin -584 15 moveto -(Classops) -[9.36 3.84 6.24 5.52 5.52 6.96 6.96 5.52] -xshow -end grestore -end grestore - -% Recordops -> Classops -newpath 528 23 moveto -538 22 550 22 561 22 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 561 25 moveto -571 21 lineto -561 19 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 561 25 moveto -571 21 lineto -561 19 lineto -closepath -stroke -end grestore - -% Classops -> Tacred -newpath 649 19 moveto -661 19 674 19 686 19 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 686 23 moveto -696 19 lineto -686 16 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 686 23 moveto -696 19 lineto -686 16 lineto -closepath -stroke -end grestore - -% Rawterm -> Evd -newpath 1148 110 moveto -1196 110 1277 110 1324 110 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1324 114 moveto -1334 110 lineto -1324 107 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1324 114 moveto -1334 110 lineto -1324 107 lineto -closepath -stroke -end grestore - -% Pretyping -gsave 10 dict begin -40 183 40 18 ellipse_path -stroke -gsave 10 dict begin -13 178 moveto -(Pretyping) -[7.68 4.56 6 3.84 6.96 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Pretyping -> Pattern -newpath 78 189 moveto -121 194 191 202 251 202 curveto -251 202 251 202 485 202 curveto -556 202 636 205 685 208 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 685 212 moveto -695 208 lineto -685 205 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 685 212 moveto -695 208 lineto -685 205 lineto -closepath -stroke -end grestore - -% Cases -gsave 10 dict begin -146 64 30 18 ellipse_path -stroke -gsave 10 dict begin -129 59 moveto -(Cases) -[9.36 6.24 5.52 6.24 5.52] -xshow -end grestore -end grestore - -% Pretyping -> Cases -newpath 53 166 moveto -68 147 93 115 116 91 curveto -118 89 119 88 121 86 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 124 88 moveto -129 79 lineto -119 83 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 124 88 moveto -129 79 lineto -119 83 lineto -closepath -stroke -end grestore - -% Detyping -gsave 10 dict begin -969 164 39 18 ellipse_path -stroke -gsave 10 dict begin -942 159 moveto -(Detyping) -[10.08 6 3.84 6.96 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Pretyping -> Detyping -newpath 78 177 moveto -121 172 191 164 251 164 curveto -251 164 251 164 728 164 curveto -794 164 870 164 919 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 919 168 moveto -929 164 lineto -919 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 919 168 moveto -929 164 lineto -919 161 lineto -closepath -stroke -end grestore - -% Indrec -gsave 10 dict begin -251 271 31 18 ellipse_path -stroke -gsave 10 dict begin -233 266 moveto -(Indrec) -[4.56 6.96 6.96 4.56 6.24 6.24] -xshow -end grestore -end grestore - -% Pretyping -> Indrec -newpath 69 195 moveto -83 202 101 209 116 216 curveto -150 230 188 246 216 257 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 214 260 moveto -225 261 lineto -217 254 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 214 260 moveto -225 261 lineto -217 254 lineto -closepath -stroke -end grestore - -% Coercion -gsave 10 dict begin -251 67 39 18 ellipse_path -stroke -gsave 10 dict begin -225 62 moveto -(Coercion) -[9.36 6.96 6.24 4.56 6.24 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Cases -> Coercion -newpath 176 65 moveto -184 65 193 66 202 66 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 202 70 moveto -212 66 lineto -202 63 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 202 70 moveto -212 66 lineto -202 63 lineto -closepath -stroke -end grestore - -% Detyping -> Inductiveops -newpath 1009 164 moveto -1022 164 1036 164 1050 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1050 168 moveto -1060 164 lineto -1050 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1050 168 moveto -1060 164 lineto -1050 161 lineto -closepath -stroke -end grestore - -% Detyping -> Rawterm -newpath 999 152 moveto -1020 144 1047 133 1069 125 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1070 128 moveto -1079 122 lineto -1068 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1070 128 moveto -1079 122 lineto -1068 122 lineto -closepath -stroke -end grestore - -% Indrec -> Inductiveops -newpath 281 276 moveto -325 283 412 294 485 294 curveto -485 294 485 294 839 294 curveto -937 294 1036 225 1082 188 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1085 190 moveto -1090 181 lineto -1080 185 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1085 190 moveto -1090 181 lineto -1080 185 lineto -closepath -stroke -end grestore - -% Matching -gsave 10 dict begin -610 248 40 18 ellipse_path -stroke -gsave 10 dict begin -582 243 moveto -(Matching) -[12.48 6.24 3.84 6 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Matching -> Pattern -newpath 643 237 moveto -658 232 675 227 689 222 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 690 225 moveto -699 219 lineto -688 219 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 690 225 moveto -699 219 lineto -688 219 lineto -closepath -stroke -end grestore - -% Matching -> Reductionops -newpath 650 250 moveto -696 253 773 256 839 256 curveto -839 256 839 256 969 256 curveto -1059 256 1159 212 1210 184 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1212 187 moveto -1219 179 lineto -1209 181 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1212 187 moveto -1219 179 lineto -1209 181 lineto -closepath -stroke -end grestore - -% Evarconv -gsave 10 dict begin -366 67 40 18 ellipse_path -stroke -gsave 10 dict begin -339 62 moveto -(Evarconv) -[8.4 6.72 6.24 4.56 6.24 6.96 6.48 6.96] -xshow -end grestore -end grestore - -% Evarconv -> Evarutil -newpath 406 68 moveto -474 69 610 71 682 72 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 682 76 moveto -692 72 lineto -682 69 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 682 76 moveto -692 72 lineto -682 69 lineto -closepath -stroke -end grestore - -% Evarconv -> Recordops -newpath 397 56 moveto -411 51 428 45 442 39 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 443 42 moveto -452 36 lineto -441 36 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 443 42 moveto -452 36 lineto -441 36 lineto -closepath -stroke -end grestore - -% Coercion -> Evarconv -newpath 290 67 moveto -299 67 307 67 316 67 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 316 71 moveto -326 67 lineto -316 64 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 316 71 moveto -326 67 lineto -316 64 lineto -closepath -stroke -end grestore - -% Clenv -gsave 10 dict begin -146 118 30 18 ellipse_path -stroke -gsave 10 dict begin -129 113 moveto -(Clenv) -[9.36 3.84 6.24 6.48 6.96] -xshow -end grestore -end grestore - -% Clenv -> Unification -newpath 176 118 moveto -252 118 455 118 554 118 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 554 122 moveto -564 118 lineto -554 115 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 554 122 moveto -564 118 lineto -554 115 lineto -closepath -stroke -end grestore - -% Clenv -> Coercion -newpath 170 107 moveto -183 100 200 93 215 85 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 217 88 moveto -224 80 lineto -214 82 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 217 88 moveto -224 80 lineto -214 82 lineto -closepath -stroke -end grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/proofs.dep.ps b/dev/ocamlweb-doc/proofs.dep.ps deleted file mode 100644 index 4dd045ce..00000000 --- a/dev/ocamlweb-doc/proofs.dep.ps +++ /dev/null @@ -1,649 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: Graphviz version 2.12 (Tue Oct 23 13:46:12 UTC 2007) -%%For: (notin) Jean-Marc Notin,,, -%%Title: G -%%Pages: (atend) -%%BoundingBox: (atend) -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval -EncodingVector 45 /hyphen put - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -setupLatin1 -%%Page: 1 1 -%%PageBoundingBox: 36 36 576 753 -%%PageOrientation: Landscape -gsave -36 36 576 753 boxprim clip newpath -0 0 1 beginpage -0.870968 0.870968 set_scale 90 rotate 45.3333 -657.333 translate -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 616 lineto -819 616 lineto -819 -4 lineto -closepath fill -0.870968 setlinewidth -0.000 0.000 1.000 graphcolor -newpath -4 -4 moveto --4 616 lineto -819 616 lineto -819 -4 lineto -closepath stroke -% Clenvtac -gsave -0.502 1.000 0.820 nodecolor -451 522 37.1753 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -451 522 37.1753 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -451 517 moveto 49 -0.5 (Clenvtac) alignedtext -grestore -% Evar_refiner -gsave -0.502 1.000 0.820 nodecolor -439 450 49.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 450 49.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 445 moveto 72 -0.5 (Evar_refiner) alignedtext -grestore -% Clenvtac->Evar_refiner -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 448 504 moveto -447 496 445 487 444 478 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 447.393 477.119 moveto -442 468 lineto -440.529 478.492 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 447.393 477.119 moveto -442 468 lineto -440.529 478.492 lineto -closepath stroke -grestore -% Tacmach -gsave -0.502 1.000 0.820 nodecolor -711 450 38.1754 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -711 450 38.1754 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -711 445 moveto 51 -0.5 (Tacmach) alignedtext -grestore -% Clenvtac->Tacmach -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 483 513 moveto -530 500 616 476 668 462 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 669.427 465.226 moveto -678 459 lineto -667.416 458.521 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 669.427 465.226 moveto -678 459 lineto -667.416 458.521 lineto -closepath stroke -grestore -% Refiner -gsave -0.502 1.000 0.820 nodecolor -439 378 34.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 378 34.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 373 moveto 42 -0.5 (Refiner) alignedtext -grestore -% Evar_refiner->Refiner -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 432 moveto -439 424 439 415 439 406 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 406 moveto -439 396 lineto -435.5 406 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 406 moveto -439 396 lineto -435.5 406 lineto -closepath stroke -grestore -% Tacmach->Refiner -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 678 441 moveto -628 428 533 403 480 389 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 480.584 385.521 moveto -470 386 lineto -478.573 392.226 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 480.584 385.521 moveto -470 386 lineto -478.573 392.226 lineto -closepath stroke -grestore -% Redexpr -gsave -0.502 1.000 0.820 nodecolor -711 378 36.1752 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -711 378 36.1752 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -711 373 moveto 47 -0.5 (Redexpr) alignedtext -grestore -% Tacmach->Redexpr -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 711 432 moveto -711 424 711 415 711 406 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 714.5 406 moveto -711 396 lineto -707.5 406 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 714.5 406 moveto -711 396 lineto -707.5 406 lineto -closepath stroke -grestore -% Decl_mode -gsave -0.502 1.000 0.820 nodecolor -698 594 45.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -698 594 45.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -698 589 moveto 64 -0.5 (Decl_mode) alignedtext -grestore -% Pfedit -gsave -0.502 1.000 0.820 nodecolor -698 522 30.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -698 522 30.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -698 517 moveto 34 -0.5 (Pfedit) alignedtext -grestore -% Decl_mode->Pfedit -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 698 576 moveto -698 568 698 559 698 550 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 701.5 550 moveto -698 540 lineto -694.5 550 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 701.5 550 moveto -698 540 lineto -694.5 550 lineto -closepath stroke -grestore -% Pfedit->Evar_refiner -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 671 514 moveto -628 503 543 479 488 464 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 488.584 460.521 moveto -478 461 lineto -486.573 467.226 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 488.584 460.521 moveto -478 461 lineto -486.573 467.226 lineto -closepath stroke -grestore -% Pfedit->Tacmach -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 701 504 moveto -702 496 704 487 706 478 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 709.471 478.492 moveto -708 468 lineto -702.607 477.119 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 709.471 478.492 moveto -708 468 lineto -702.607 477.119 lineto -closepath stroke -grestore -% Logic -gsave -0.502 1.000 0.820 nodecolor -439 306 29.1747 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 306 29.1747 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 301 moveto 33 -0.5 (Logic) alignedtext -grestore -% Refiner->Logic -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 360 moveto -439 352 439 343 439 334 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 334 moveto -439 324 lineto -435.5 334 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 334 moveto -439 324 lineto -435.5 334 lineto -closepath stroke -grestore -% Proof_trees -gsave -0.502 1.000 0.820 nodecolor -439 234 45.1757 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 234 45.1757 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 229 moveto 65 -0.5 (Proof_trees) alignedtext -grestore -% Logic->Proof_trees -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 288 moveto -439 280 439 271 439 262 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 262 moveto -439 252 lineto -435.5 262 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 262 moveto -439 252 lineto -435.5 262 lineto -closepath stroke -grestore -% Proof_type -gsave -0.502 1.000 0.820 nodecolor -439 162 44.1757 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 162 44.1757 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 157 moveto 63 -0.5 (Proof_type) alignedtext -grestore -% Proof_trees->Proof_type -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 216 moveto -439 208 439 199 439 190 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 190 moveto -439 180 lineto -435.5 190 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 190 moveto -439 180 lineto -435.5 190 lineto -closepath stroke -grestore -% Decl_expr -gsave -0.502 1.000 0.820 nodecolor -439 90 42.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 90 42.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 85 moveto 58 -0.5 (Decl_expr) alignedtext -grestore -% Proof_type->Decl_expr -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 144 moveto -439 136 439 127 439 118 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 118 moveto -439 108 lineto -435.5 118 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 118 moveto -439 108 lineto -435.5 118 lineto -closepath stroke -grestore -% Tacexpr -gsave -0.502 1.000 0.820 nodecolor -439 18 36.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -439 18 36.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -439 13 moveto 46 -0.5 (Tacexpr) alignedtext -grestore -% Decl_expr->Tacexpr -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 439 72 moveto -439 64 439 55 439 46 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 442.5 46 moveto -439 36 lineto -435.5 46 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 442.5 46 moveto -439 36 lineto -435.5 46 lineto -closepath stroke -grestore -% Tactic_debug -gsave -0.502 1.000 0.820 nodecolor -133 450 51.1777 18 ellipse_path fill -0.870968 setlinewidth -filled -0.502 1.000 0.820 nodecolor -133 450 51.1777 18 ellipse_path stroke -0.000 0.000 0.000 nodecolor -14.00 /Times-Roman set_font -133 445 moveto 76 -0.5 (Tactic_debug) alignedtext -grestore -% Tactic_debug->Refiner -gsave -0.870968 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 176 440 moveto -234 426 339 401 398 387 curveto -stroke -0.000 0.000 0.000 edgecolor -newpath 398.881 390.393 moveto -408 385 lineto -397.508 383.529 lineto -closepath fill -0.870968 setlinewidth -solid -0.000 0.000 0.000 edgecolor -newpath 398.881 390.393 moveto -408 385 lineto -397.508 383.529 lineto -closepath stroke -grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -%%BoundingBox: 36 36 576 753 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/syntax.mly b/dev/ocamlweb-doc/syntax.mly deleted file mode 100644 index bfc7d5cc..00000000 --- a/dev/ocamlweb-doc/syntax.mly +++ /dev/null @@ -1,224 +0,0 @@ -%{ -open Ast -open Parse -%} - -%token META INT IDENT -%token OPER -%token LPAR RPAR BAR COMMA COLON BANG FUN DOT RARROW LET COLONEQ IN IF -%token THEN ELSE EVAL AT FOR PROP SET TYPE WILDCARD FIX -%token COFIX MATCH WITH END AND LBRACE RBRACE STRUCT AS SIMPL PERCENT -%token EOF - -%start main -%type main - -%start constr -%type constr - -%start simple_constr -%type simple_constr - -%% - -main: - constr EOF { $1 } -; - - -paren_constr: - constr COMMA paren_constr { Pair($1,$3) } - | constr { $1 } -; - -constr: - binder_constr { $1 } - | oper_constr { close_stack $1 } -; - -binder_constr: - BANG ne_binders DOT constr { Prod($2, $4) } - | FUN ne_binders type_cstr RARROW constr { Lambda($2,mk_cast $5 $3) } - | LET IDENT binders type_cstr COLONEQ constr IN constr - { Let($2,mk_lambda $3 (mk_cast $6 $4),$8) } - | LET LPAR comma_binders RPAR COLONEQ constr IN constr - { LetCase($3,$6,$8) } - | IF constr THEN constr ELSE constr { IfCase($2,$4,$6) } - | fix_constr { $1 } - | EVAL rfun IN constr { Eval($2,$4) } -; - -comma_binders: - ne_comma_binders { $1 } - | { [] } -; - -ne_comma_binders: - binder COMMA ne_comma_binders { $1 :: $3 } - | binder { [$1] } -; - -rfun: - SIMPL { Simpl } -; - - -/* 2 Conflits shift/reduce */ -oper_constr: - oper_constr oper appl_constr - { parse_term $3 (parse_oper $2 $1) } - | oper_constr oper binder_constr - { parse_term $3 (parse_oper $2 $1) } - | oper_constr oper { parse_oper $2 $1 } - | { empty } - | appl_constr { parse_term $1 empty } -; - -oper: - OPER {$1} - | COLON {":"} -; - -appl_constr: - simple_constr ne_appl_args { Appl($1,$2) } - | AT global simple_constrs { ApplExpl($2,$3) } - | simple_constr { $1 } -; - -appl_arg: - AT INT COLONEQ simple_constr { (Some $2,$4) } - | simple_constr { (None,$1) } -; - -ne_appl_args: - appl_arg { [$1] } - | appl_arg ne_appl_args { $1::$2 } -; - -simple_constr: - atomic_constr { $1 } - | match_constr { $1 } - | LPAR paren_constr RPAR { $2 } - | simple_constr PERCENT IDENT { Scope($3,$1) } -; - -simple_constrs: - simple_constr simple_constrs { $1::$2 } - | { [] } -; - -atomic_constr: - global { Qualid $1 } - | PROP { Prop } - | SET { Set } - | TYPE { Type } - | INT { Int $1 } - | WILDCARD { Hole } - | META { Meta $1 } -; - -global: - IDENT DOT global { $1 :: $3 } - | IDENT { [$1] } -; - -/* Conflit normal */ -fix_constr: - fix_kw fix_decl - { let (id,_,_,_,_ as fx) = $2 in Fixp($1,[fx],id) } - | fix_kw fix_decl fix_decls FOR IDENT { Fixp($1, $2::$3, $5) } -; - -fix_kw: FIX {Fix} | COFIX {CoFix} -; - -fix_decl: - IDENT binders type_cstr annot COLONEQ constr { ($1,$2,$3,$4,$6) } -; - -fix_decls: - AND fix_decl fix_decls { $2::$3 } - | AND fix_decl { [$2] } -; - -annot: - LBRACE STRUCT IDENT RBRACE { Some $3 } - | { None } -; - -match_constr: - MATCH case_items case_type WITH branches END { Match($2,$3,$5) } -; - -case_items: - case_item { [$1] } - | case_item COMMA case_items { $1::$3 } -; - -case_item: - constr pred_pattern { ($1,$2) } -; - -case_type: - RARROW constr { Some $2 } - | { None } -; - -pred_pattern: - AS IDENT COLON constr { (Some $2, Some $4) } - | AS IDENT { (Some $2, None) } - | COLON constr { (None, Some $2) } - | { (None,None) } -; - -branches: - BAR branch_list { $2 } - | branch_list { $1 } - | { [] } -; - -branch_list: - patterns RARROW constr { [$1, $3] } - | patterns RARROW constr BAR branch_list { ($1,$3)::$5 } -; - -patterns: - pattern { [$1] } - | pattern COMMA patterns { $1::$3 } -; - -pattern: - pattern AS IDENT { PatAs($1,$3) } - | pattern COLON constr { PatType($1,$3) } - | IDENT simple_patterns { PatConstr($1,$2) } - | simple_pattern { $1 } -; - -simple_pattern: - IDENT { PatVar $1 } - | LPAR pattern RPAR { $2 } -; - -simple_patterns: - simple_pattern { [$1] } - | simple_pattern simple_patterns { $1::$2 } -; - -binder: - IDENT { ($1,Hole) } - | LPAR IDENT type_cstr RPAR { ($2,$3) } -; - -binders: - ne_binders { $1 } - | { [] } - -ne_binders: - binder { [$1] } - | binder ne_binders { $1::$2 } -; - -type_cstr: - COLON constr { $2 } - | { Hole } -; diff --git a/dev/ocamlweb-doc/tactics.dep.ps b/dev/ocamlweb-doc/tactics.dep.ps deleted file mode 100644 index f4de22b7..00000000 --- a/dev/ocamlweb-doc/tactics.dep.ps +++ /dev/null @@ -1,991 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005) -%%For: (herbelin) Hugo Herbelin -%%Title: G -%%Pages: (atend) -%%BoundingBox: 35 35 577 165 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 577 165 -%%PageOrientation: Portrait -gsave -35 35 542 130 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0.4696 set_scale -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% Extraargs -gsave 10 dict begin -483 110 40 18 ellipse_path -stroke -gsave 10 dict begin -455 105 moveto -(Extraargs) -[8.4 6.96 3.84 4.56 6.24 6.24 4.32 6.96 5.52] -xshow -end grestore -end grestore - -% Setoid_replace -gsave 10 dict begin -615 64 54 18 ellipse_path -stroke -gsave 10 dict begin -573 59 moveto -(Setoid_replace) -[7.68 6 3.84 6.96 3.84 6.96 6.96 4.56 6.24 6.96 3.84 6.24 6.24 6.24] -xshow -end grestore -end grestore - -% Extraargs -> Setoid_replace -newpath 515 99 moveto -531 93 550 87 567 81 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 569 84 moveto -577 77 lineto -566 77 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 569 84 moveto -577 77 lineto -566 77 lineto -closepath -stroke -end grestore - -% Tactics -gsave 10 dict begin -884 110 33 18 ellipse_path -stroke -gsave 10 dict begin -864 105 moveto -(Tactics) -[7.44 6.24 6.24 3.84 3.84 6.24 5.52] -xshow -end grestore -end grestore - -% Setoid_replace -> Tactics -newpath 669 66 moveto -709 68 764 72 810 83 curveto -823 85 837 90 848 94 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 847 98 moveto -858 98 lineto -850 91 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 847 98 moveto -858 98 lineto -850 91 lineto -closepath -stroke -end grestore - -% Termdn -gsave 10 dict begin -998 256 35 18 ellipse_path -stroke -gsave 10 dict begin -976 251 moveto -(Termdn) -[7.2 6.24 4.8 10.8 6.96 6.96] -xshow -end grestore -end grestore - -% Dn -gsave 10 dict begin -1112 256 27 18 ellipse_path -stroke -gsave 10 dict begin -1102 251 moveto -(Dn) -[10.08 6.96] -xshow -end grestore -end grestore - -% Termdn -> Dn -newpath 1033 256 moveto -1047 256 1061 256 1075 256 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1075 260 moveto -1085 256 lineto -1075 253 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1075 260 moveto -1085 256 lineto -1075 253 lineto -closepath -stroke -end grestore - -% Hipattern -gsave 10 dict begin -998 110 40 18 ellipse_path -stroke -gsave 10 dict begin -971 105 moveto -(Hipattern) -[10.08 3.84 6.96 6.24 3.84 3.84 6.24 4.8 6.96] -xshow -end grestore -end grestore - -% Tactics -> Hipattern -newpath 917 110 moveto -927 110 938 110 948 110 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 948 114 moveto -958 110 lineto -948 107 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 948 114 moveto -958 110 lineto -948 107 lineto -closepath -stroke -end grestore - -% Tacticals -gsave 10 dict begin -1112 110 38 18 ellipse_path -stroke -gsave 10 dict begin -1087 105 moveto -(Tacticals) -[7.44 6.24 6.24 3.84 3.84 6.24 6.24 3.84 5.52] -xshow -end grestore -end grestore - -% Hipattern -> Tacticals -newpath 1038 110 moveto -1047 110 1055 110 1064 110 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1064 114 moveto -1074 110 lineto -1064 107 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1064 114 moveto -1074 110 lineto -1064 107 lineto -closepath -stroke -end grestore - -% Tacinterp -gsave 10 dict begin -170 191 39 18 ellipse_path -stroke -gsave 10 dict begin -143 186 moveto -(Tacinterp) -[7.44 6.24 6.24 3.84 6.96 3.84 6.24 4.8 6.96] -xshow -end grestore -end grestore - -% Auto -gsave 10 dict begin -483 218 27 18 ellipse_path -stroke -gsave 10 dict begin -468 213 moveto -(Auto) -[9.6 6.96 3.84 6.96] -xshow -end grestore -end grestore - -% Tacinterp -> Auto -newpath 209 194 moveto -269 200 386 210 445 215 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 445 218 moveto -455 216 lineto -445 212 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 445 218 moveto -455 216 lineto -445 212 lineto -closepath -stroke -end grestore - -% Leminv -gsave 10 dict begin -281 166 35 18 ellipse_path -stroke -gsave 10 dict begin -259 161 moveto -(Leminv) -[8.4 6.24 10.8 3.84 6.48 6.96] -xshow -end grestore -end grestore - -% Tacinterp -> Leminv -newpath 205 183 moveto -216 181 228 178 239 175 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 240 178 moveto -249 173 lineto -239 172 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 240 178 moveto -249 173 lineto -239 172 lineto -closepath -stroke -end grestore - -% Hiddentac -gsave 10 dict begin -615 164 42 18 ellipse_path -stroke -gsave 10 dict begin -585 159 moveto -(Hiddentac) -[10.08 3.84 6.96 6.96 6.24 6.96 4.08 6.24 6.24] -xshow -end grestore -end grestore - -% Auto -> Hiddentac -newpath 507 208 moveto -526 200 553 189 574 181 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 576 184 moveto -584 177 lineto -573 177 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 576 184 moveto -584 177 lineto -573 177 lineto -closepath -stroke -end grestore - -% Dhyp -gsave 10 dict begin -615 218 29 18 ellipse_path -stroke -gsave 10 dict begin -599 213 moveto -(Dhyp) -[10.08 6.48 6.96 6.96] -xshow -end grestore -end grestore - -% Auto -> Dhyp -newpath 511 218 moveto -530 218 555 218 576 218 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 576 222 moveto -586 218 lineto -576 215 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 576 222 moveto -586 218 lineto -576 215 lineto -closepath -stroke -end grestore - -% Inv -gsave 10 dict begin -379 164 27 18 ellipse_path -stroke -gsave 10 dict begin -369 159 moveto -(Inv) -[4.56 6.48 6.96] -xshow -end grestore -end grestore - -% Leminv -> Inv -newpath 316 165 moveto -324 165 333 165 342 165 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 342 169 moveto -352 165 lineto -342 162 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 342 169 moveto -352 165 lineto -342 162 lineto -closepath -stroke -end grestore - -% Refine -gsave 10 dict begin -758 110 32 18 ellipse_path -stroke -gsave 10 dict begin -739 105 moveto -(Refine) -[9.12 6.24 4.8 3.84 6.96 6.24] -xshow -end grestore -end grestore - -% Refine -> Tactics -newpath 790 110 moveto -805 110 824 110 841 110 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 841 114 moveto -851 110 lineto -841 107 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 841 114 moveto -851 110 lineto -841 107 lineto -closepath -stroke -end grestore - -% Nbtermdn -gsave 10 dict begin -758 256 42 18 ellipse_path -stroke -gsave 10 dict begin -729 251 moveto -(Nbtermdn) -[10.08 6.96 3.84 6.24 4.8 10.8 6.96 6.96] -xshow -end grestore -end grestore - -% Btermdn -gsave 10 dict begin -884 256 38 18 ellipse_path -stroke -gsave 10 dict begin -859 251 moveto -(Btermdn) -[9.36 3.84 6.24 4.8 10.8 6.96 6.96] -xshow -end grestore -end grestore - -% Nbtermdn -> Btermdn -newpath 800 256 moveto -812 256 824 256 836 256 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 836 260 moveto -846 256 lineto -836 253 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 836 260 moveto -846 256 lineto -836 253 lineto -closepath -stroke -end grestore - -% Btermdn -> Termdn -newpath 922 256 moveto -932 256 943 256 953 256 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 953 260 moveto -963 256 lineto -953 253 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 953 260 moveto -963 256 lineto -953 253 lineto -closepath -stroke -end grestore - -% Elim -gsave 10 dict begin -483 164 27 18 ellipse_path -stroke -gsave 10 dict begin -468 159 moveto -(Elim) -[8.4 3.84 3.84 10.8] -xshow -end grestore -end grestore - -% Inv -> Elim -newpath 406 164 moveto -418 164 432 164 445 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 445 168 moveto -455 164 lineto -445 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 445 168 moveto -455 164 lineto -445 161 lineto -closepath -stroke -end grestore - -% Equality -gsave 10 dict begin -483 56 37 18 ellipse_path -stroke -gsave 10 dict begin -459 51 moveto -(Equality) -[8.4 6.72 6.96 6.24 3.84 3.84 3.84 6.96] -xshow -end grestore -end grestore - -% Inv -> Equality -newpath 390 147 moveto -401 130 421 102 442 83 curveto -445 80 448 78 451 76 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 453 79 moveto -459 70 lineto -449 73 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 453 79 moveto -459 70 lineto -449 73 lineto -closepath -stroke -end grestore - -% Elim -> Hiddentac -newpath 511 164 moveto -526 164 545 164 562 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 562 168 moveto -572 164 lineto -562 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 562 168 moveto -572 164 lineto -562 161 lineto -closepath -stroke -end grestore - -% Equality -> Setoid_replace -newpath 520 58 moveto -530 59 540 60 551 60 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 551 63 moveto -561 61 lineto -551 57 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 551 63 moveto -561 61 lineto -551 57 lineto -closepath -stroke -end grestore - -% Evar_tactics -gsave 10 dict begin -758 164 48 18 ellipse_path -stroke -gsave 10 dict begin -722 159 moveto -(Evar_tactics) -[8.4 6.72 6.24 4.56 6.96 4.08 6.24 6.24 3.84 3.84 6.24 5.52] -xshow -end grestore -end grestore - -% Hiddentac -> Evar_tactics -newpath 658 164 moveto -671 164 685 164 699 164 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 699 168 moveto -709 164 lineto -699 161 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 699 168 moveto -709 164 lineto -699 161 lineto -closepath -stroke -end grestore - -% Evar_tactics -> Tactics -newpath 790 150 moveto -808 142 830 132 849 125 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 850 128 moveto -858 121 lineto -847 122 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 850 128 moveto -858 121 lineto -847 122 lineto -closepath -stroke -end grestore - -% Dhyp -> Tactics -newpath 644 219 moveto -684 220 756 217 810 191 curveto -844 175 855 163 872 137 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 875 138 moveto -877 128 lineto -869 135 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 875 138 moveto -877 128 lineto -869 135 lineto -closepath -stroke -end grestore - -% Dhyp -> Nbtermdn -newpath 642 225 moveto -662 230 689 238 712 244 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 712 247 moveto -722 246 lineto -713 241 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 712 247 moveto -722 246 lineto -713 241 lineto -closepath -stroke -end grestore - -% Contradiction -gsave 10 dict begin -758 18 51 18 ellipse_path -stroke -gsave 10 dict begin -719 13 moveto -(Contradiction) -[9.36 6.96 6.96 3.84 4.56 6.24 6.96 3.84 6.24 3.84 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Contradiction -> Tactics -newpath 784 34 moveto -793 39 802 44 810 50 curveto -827 62 845 76 859 88 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 857 91 moveto -867 95 lineto -862 86 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 857 91 moveto -867 95 lineto -862 86 lineto -closepath -stroke -end grestore - -% Autorewrite -gsave 10 dict begin -47 191 47 18 ellipse_path -stroke -gsave 10 dict begin -13 186 moveto -(Autorewrite) -[9.6 6.96 3.84 6.96 4.56 5.76 10.08 4.8 3.84 3.84 6.24] -xshow -end grestore -end grestore - -% Autorewrite -> Tacinterp -newpath 94 191 moveto -102 191 111 191 120 191 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 120 195 moveto -130 191 lineto -120 188 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 120 195 moveto -130 191 lineto -120 188 lineto -closepath -stroke -end grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF diff --git a/dev/ocamlweb-doc/toplevel.dep.ps b/dev/ocamlweb-doc/toplevel.dep.ps deleted file mode 100644 index e0355aac..00000000 --- a/dev/ocamlweb-doc/toplevel.dep.ps +++ /dev/null @@ -1,971 +0,0 @@ -%!PS-Adobe-2.0 -%%Creator: dot version 2.2 (Wed Jan 19 21:09:25 UTC 2005) -%%For: (herbelin) Hugo Herbelin -%%Title: G -%%Pages: (atend) -%%BoundingBox: 35 35 577 166 -%%EndComments -save -%%BeginProlog -/DotDict 200 dict def -DotDict begin - -/setupLatin1 { -mark -/EncodingVector 256 array def - EncodingVector 0 - -ISOLatin1Encoding 0 255 getinterval putinterval - -EncodingVector - dup 306 /AE - dup 301 /Aacute - dup 302 /Acircumflex - dup 304 /Adieresis - dup 300 /Agrave - dup 305 /Aring - dup 303 /Atilde - dup 307 /Ccedilla - dup 311 /Eacute - dup 312 /Ecircumflex - dup 313 /Edieresis - dup 310 /Egrave - dup 315 /Iacute - dup 316 /Icircumflex - dup 317 /Idieresis - dup 314 /Igrave - dup 334 /Udieresis - dup 335 /Yacute - dup 376 /thorn - dup 337 /germandbls - dup 341 /aacute - dup 342 /acircumflex - dup 344 /adieresis - dup 346 /ae - dup 340 /agrave - dup 345 /aring - dup 347 /ccedilla - dup 351 /eacute - dup 352 /ecircumflex - dup 353 /edieresis - dup 350 /egrave - dup 355 /iacute - dup 356 /icircumflex - dup 357 /idieresis - dup 354 /igrave - dup 360 /dcroat - dup 361 /ntilde - dup 363 /oacute - dup 364 /ocircumflex - dup 366 /odieresis - dup 362 /ograve - dup 365 /otilde - dup 370 /oslash - dup 372 /uacute - dup 373 /ucircumflex - dup 374 /udieresis - dup 371 /ugrave - dup 375 /yacute - dup 377 /ydieresis - -% Set up ISO Latin 1 character encoding -/starnetISO { - dup dup findfont dup length dict begin - { 1 index /FID ne { def }{ pop pop } ifelse - } forall - /Encoding EncodingVector def - currentdict end definefont -} def -/Times-Roman starnetISO def -/Times-Italic starnetISO def -/Times-Bold starnetISO def -/Times-BoldItalic starnetISO def -/Helvetica starnetISO def -/Helvetica-Oblique starnetISO def -/Helvetica-Bold starnetISO def -/Helvetica-BoldOblique starnetISO def -/Courier starnetISO def -/Courier-Oblique starnetISO def -/Courier-Bold starnetISO def -/Courier-BoldOblique starnetISO def -cleartomark -} bind def - -%%BeginResource: procset graphviz 0 0 -/coord-font-family /Times-Roman def -/default-font-family /Times-Roman def -/coordfont coord-font-family findfont 8 scalefont def - -/InvScaleFactor 1.0 def -/set_scale { - dup 1 exch div /InvScaleFactor exch def - dup scale -} bind def - -% styles -/solid { [] 0 setdash } bind def -/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def -/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def -/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def -/bold { 2 setlinewidth } bind def -/filled { } bind def -/unfilled { } bind def -/rounded { } bind def -/diagonals { } bind def - -% hooks for setting color -/nodecolor { sethsbcolor } bind def -/edgecolor { sethsbcolor } bind def -/graphcolor { sethsbcolor } bind def -/nopcolor {pop pop pop} bind def - -/beginpage { % i j npages - /npages exch def - /j exch def - /i exch def - /str 10 string def - npages 1 gt { - gsave - coordfont setfont - 0 0 moveto - (\() show i str cvs show (,) show j str cvs show (\)) show - grestore - } if -} bind def - -/set_font { - findfont exch - scalefont setfont -} def - -% draw aligned label in bounding box aligned to current point -/alignedtext { % width adj text - /text exch def - /adj exch def - /width exch def - gsave - width 0 gt { - text stringwidth pop adj mul 0 rmoveto - } if - [] 0 setdash - text show - grestore -} def - -/boxprim { % xcorner ycorner xsize ysize - 4 2 roll - moveto - 2 copy - exch 0 rlineto - 0 exch rlineto - pop neg 0 rlineto - closepath -} bind def - -/ellipse_path { - /ry exch def - /rx exch def - /y exch def - /x exch def - matrix currentmatrix - newpath - x y translate - rx ry scale - 0 0 1 0 360 arc - setmatrix -} bind def - -/endpage { showpage } bind def -/showpage { } def - -/layercolorseq - [ % layer color sequence - darkest to lightest - [0 0 0] - [.2 .8 .8] - [.4 .8 .8] - [.6 .8 .8] - [.8 .8 .8] - ] -def - -/layerlen layercolorseq length def - -/setlayer {/maxlayer exch def /curlayer exch def - layercolorseq curlayer 1 sub layerlen mod get - aload pop sethsbcolor - /nodecolor {nopcolor} def - /edgecolor {nopcolor} def - /graphcolor {nopcolor} def -} bind def - -/onlayer { curlayer ne {invis} if } def - -/onlayers { - /myupper exch def - /mylower exch def - curlayer mylower lt - curlayer myupper gt - or - {invis} if -} def - -/curlayer 0 def - -%%EndResource -%%EndProlog -%%BeginSetup -14 default-font-family set_font -1 setmiterlimit -% /arrowlength 10 def -% /arrowwidth 5 def - -% make sure pdfmark is harmless for PS-interpreters other than Distiller -/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse -% make '<<' and '>>' safe on PS Level 1 devices -/languagelevel where {pop languagelevel}{1} ifelse -2 lt { - userdict (<<) cvn ([) cvn load put - userdict (>>) cvn ([) cvn load put -} if - -%%EndSetup -%%Page: 1 1 -%%PageBoundingBox: 36 36 577 166 -%%PageOrientation: Portrait -gsave -35 35 542 131 boxprim clip newpath -36 36 translate -0 0 1 beginpage -0.4180 set_scale -0 0 translate 0 rotate -0.000 0.000 0.000 graphcolor -14.00 /Times-Roman set_font - -% Vernac -gsave 10 dict begin -562 145 33 18 ellipse_path -stroke -gsave 10 dict begin -541 140 moveto -(Vernac) -[8.88 6.24 4.8 6.96 6.24 6.24] -xshow -end grestore -end grestore - -% Vernacentries -gsave 10 dict begin -724 158 52 18 ellipse_path -stroke -gsave 10 dict begin -685 153 moveto -(Vernacentries) -[8.88 6.24 4.8 6.96 6.24 6.24 6.24 6.96 3.84 4.8 3.84 6.24 5.52] -xshow -end grestore -end grestore - -% Vernac -> Vernacentries -newpath 595 148 moveto -615 149 640 151 663 153 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 663 156 moveto -673 154 lineto -663 150 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 663 156 moveto -673 154 lineto -663 150 lineto -closepath -stroke -end grestore - -% Vernacinterp -gsave 10 dict begin -862 158 50 18 ellipse_path -stroke -gsave 10 dict begin -825 153 moveto -(Vernacinterp) -[8.88 6.24 4.8 6.96 6.24 6.24 3.84 6.96 3.84 6.24 4.8 6.96] -xshow -end grestore -end grestore - -% Vernacentries -> Vernacinterp -newpath 776 158 moveto -785 158 793 158 802 158 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 802 162 moveto -812 158 lineto -802 155 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 802 162 moveto -812 158 lineto -802 155 lineto -closepath -stroke -end grestore - -% Discharge -gsave 10 dict begin -862 212 42 18 ellipse_path -stroke -gsave 10 dict begin -833 207 moveto -(Discharge) -[10.08 3.84 5.52 6 6.96 6.24 4.32 6.72 6.24] -xshow -end grestore -end grestore - -% Vernacentries -> Discharge -newpath 758 171 moveto -777 179 801 188 822 196 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 820 199 moveto -831 200 lineto -823 193 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 820 199 moveto -831 200 lineto -823 193 lineto -closepath -stroke -end grestore - -% Mltop -gsave 10 dict begin -862 104 31 18 ellipse_path -stroke -gsave 10 dict begin -844 99 moveto -(Mltop) -[12.48 3.84 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Vernacentries -> Mltop -newpath 758 145 moveto -779 137 805 126 826 118 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 828 121 moveto -836 114 lineto -825 114 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 828 121 moveto -836 114 lineto -825 114 lineto -closepath -stroke -end grestore - -% Record -gsave 10 dict begin -862 281 33 18 ellipse_path -stroke -gsave 10 dict begin -842 276 moveto -(Record) -[9.12 6.24 6.24 6.96 4.32 6.96] -xshow -end grestore -end grestore - -% Vernacentries -> Record -newpath 742 175 moveto -760 192 788 217 812 239 curveto -819 246 828 253 835 259 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 833 262 moveto -843 266 lineto -838 257 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 833 262 moveto -843 266 lineto -838 257 lineto -closepath -stroke -end grestore - -% Himsg -gsave 10 dict begin -991 85 32 18 ellipse_path -stroke -gsave 10 dict begin -971 80 moveto -(Himsg) -[10.08 3.84 10.8 5.52 6.96] -xshow -end grestore -end grestore - -% Vernacinterp -> Himsg -newpath 890 143 moveto -897 139 905 135 912 131 curveto -929 123 946 112 960 103 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 962 106 moveto -969 98 lineto -959 100 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 962 106 moveto -969 98 lineto -959 100 lineto -closepath -stroke -end grestore - -% Vernacexpr -gsave 10 dict begin -1246 221 45 18 ellipse_path -stroke -gsave 10 dict begin -1213 216 moveto -(Vernacexpr) -[8.88 6.24 4.8 6.96 6.24 6.24 5.76 6.96 6.96 4.56] -xshow -end grestore -end grestore - -% Vernacinterp -> Vernacexpr -newpath 912 159 moveto -947 160 994 163 1034 169 curveto -1092 178 1158 195 1200 207 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1199 210 moveto -1210 210 lineto -1201 204 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1199 210 moveto -1210 210 lineto -1201 204 lineto -closepath -stroke -end grestore - -% Class -gsave 10 dict begin -1117 238 28 18 ellipse_path -stroke -gsave 10 dict begin -1101 233 moveto -(Class) -[9.36 3.84 6.24 5.52 5.52] -xshow -end grestore -end grestore - -% Discharge -> Class -newpath 902 217 moveto -917 219 933 221 948 223 curveto -992 228 1044 232 1079 235 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1079 238 moveto -1089 236 lineto -1079 232 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1079 238 moveto -1089 236 lineto -1079 232 lineto -closepath -stroke -end grestore - -% Recordobj -gsave 10 dict begin -991 196 42 18 ellipse_path -stroke -gsave 10 dict begin -962 191 moveto -(Recordobj) -[9.12 6.24 6.24 6.96 4.32 6.96 6.96 6.96 3.84] -xshow -end grestore -end grestore - -% Discharge -> Recordobj -newpath 902 207 moveto -914 205 927 204 940 202 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 940 205 moveto -950 201 lineto -940 199 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 940 205 moveto -950 201 lineto -940 199 lineto -closepath -stroke -end grestore - -% Command -gsave 10 dict begin -991 288 42 18 ellipse_path -stroke -gsave 10 dict begin -961 283 moveto -(Command) -[9.36 6.96 10.8 10.8 6.24 6.96 6.96] -xshow -end grestore -end grestore - -% Record -> Command -newpath 895 283 moveto -908 284 923 285 938 285 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 938 288 moveto -948 286 lineto -938 282 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 938 288 moveto -948 286 lineto -938 282 lineto -closepath -stroke -end grestore - -% Toplevel -gsave 10 dict begin -255 72 37 18 ellipse_path -stroke -gsave 10 dict begin -231 67 moveto -(Toplevel) -[7.2 6.96 6.96 3.84 5.76 6.48 6.24 3.84] -xshow -end grestore -end grestore - -% Protectedtoplevel -gsave 10 dict begin -390 72 61 18 ellipse_path -stroke -gsave 10 dict begin -341 67 moveto -(Protectedtoplevel) -[7.68 4.56 6.72 3.84 6.24 6.24 3.84 6.24 6.96 3.84 6.96 6.96 3.84 5.76 6.48 6.24 3.84] -xshow -end grestore -end grestore - -% Toplevel -> Protectedtoplevel -newpath 292 72 moveto -300 72 309 72 318 72 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 318 76 moveto -328 72 lineto -318 69 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 318 76 moveto -328 72 lineto -318 69 lineto -closepath -stroke -end grestore - -% Protectedtoplevel -> Vernac -newpath 425 87 moveto -455 100 497 117 527 130 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 525 133 moveto -536 134 lineto -528 127 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 525 133 moveto -536 134 lineto -528 127 lineto -closepath -stroke -end grestore - -% Cerrors -gsave 10 dict begin -724 65 34 18 ellipse_path -stroke -gsave 10 dict begin -702 60 moveto -(Cerrors) -[9.36 6.24 5.04 4.56 6.96 4.56 5.52] -xshow -end grestore -end grestore - -% Protectedtoplevel -> Cerrors -newpath 452 71 moveto -518 70 621 67 679 66 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 679 70 moveto -689 66 lineto -679 63 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 679 70 moveto -689 66 lineto -679 63 lineto -closepath -stroke -end grestore - -% Line_oriented_parser -gsave 10 dict begin -562 26 73 18 ellipse_path -stroke -gsave 10 dict begin -501 21 moveto -(Line_oriented_parser) -[8.4 3.84 6.96 6.24 6.96 6.96 4.8 3.84 6.24 6.96 3.84 6.24 6.96 6.96 6.96 6.24 4.56 5.52 6.24 4.56] -xshow -end grestore -end grestore - -% Protectedtoplevel -> Line_oriented_parser -newpath 436 60 moveto -457 55 481 48 502 42 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 503 45 moveto -512 39 lineto -501 39 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 503 45 moveto -512 39 lineto -501 39 lineto -closepath -stroke -end grestore - -% Metasyntax -gsave 10 dict begin -1117 292 46 18 ellipse_path -stroke -gsave 10 dict begin -1083 287 moveto -(Metasyntax) -[12.48 6 4.08 6.24 5.52 6.96 6.96 4.08 6.24 6.96] -xshow -end grestore -end grestore - -% Command -> Metasyntax -newpath 1034 289 moveto -1043 290 1052 290 1061 290 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1061 293 moveto -1071 291 lineto -1061 287 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1061 293 moveto -1071 291 lineto -1061 287 lineto -closepath -stroke -end grestore - -% Command -> Class -newpath 1022 276 moveto -1041 268 1065 259 1084 252 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1085 255 moveto -1093 248 lineto -1082 249 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1085 255 moveto -1093 248 lineto -1082 249 lineto -closepath -stroke -end grestore - -% Cerrors -> Himsg -newpath 758 67 moveto -796 69 859 73 912 77 curveto -924 78 937 79 949 80 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 949 83 moveto -959 81 lineto -949 77 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 949 83 moveto -959 81 lineto -949 77 lineto -closepath -stroke -end grestore - -% Minicoq -gsave 10 dict begin -38 126 37 18 ellipse_path -stroke -gsave 10 dict begin -13 121 moveto -(Minicoq) -[12.48 3.84 6.96 3.84 6.24 6.96 6.96] -xshow -end grestore -end grestore - -% Fhimsg -gsave 10 dict begin -147 126 34 18 ellipse_path -stroke -gsave 10 dict begin -125 121 moveto -(Fhimsg) -[7.68 6.96 3.84 10.8 5.52 6.96] -xshow -end grestore -end grestore - -% Minicoq -> Fhimsg -newpath 76 126 moveto -84 126 93 126 102 126 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 102 130 moveto -112 126 lineto -102 123 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 102 130 moveto -112 126 lineto -102 123 lineto -closepath -stroke -end grestore - -% Metasyntax -> Vernacexpr -newpath 1144 277 moveto -1163 267 1189 252 1210 241 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 1212 244 moveto -1219 236 lineto -1209 238 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 1212 244 moveto -1219 236 lineto -1209 238 lineto -closepath -stroke -end grestore - -% Coqtop -gsave 10 dict begin -38 45 34 18 ellipse_path -stroke -gsave 10 dict begin -17 40 moveto -(Coqtop) -[9.36 6.96 6.96 3.84 6.96 6.96] -xshow -end grestore -end grestore - -% Coqinit -gsave 10 dict begin -147 72 34 18 ellipse_path -stroke -gsave 10 dict begin -126 67 moveto -(Coqinit) -[9.36 6.96 6.96 3.84 6.96 3.84 3.84] -xshow -end grestore -end grestore - -% Coqtop -> Coqinit -newpath 69 53 moveto -81 56 94 59 106 62 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 105 65 moveto -116 65 lineto -107 59 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 105 65 moveto -116 65 lineto -107 59 lineto -closepath -stroke -end grestore - -% Usage -gsave 10 dict begin -147 18 31 18 ellipse_path -stroke -gsave 10 dict begin -129 13 moveto -(Usage) -[10.08 5.52 6.24 6.72 6.24] -xshow -end grestore -end grestore - -% Coqtop -> Usage -newpath 69 37 moveto -81 34 95 31 108 28 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 109 31 moveto -118 25 lineto -107 25 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 109 31 moveto -118 25 lineto -107 25 lineto -closepath -stroke -end grestore - -% Coqinit -> Toplevel -newpath 181 72 moveto -190 72 199 72 208 72 curveto -stroke -gsave 10 dict begin -solid -1 setlinewidth -0.000 0.000 0.000 edgecolor -newpath 208 76 moveto -218 72 lineto -208 69 lineto -closepath -fill -0.000 0.000 0.000 edgecolor -newpath 208 76 moveto -218 72 lineto -208 69 lineto -closepath -stroke -end grestore -endpage -showpage -grestore -%%PageTrailer -%%EndPage: 1 -%%Trailer -%%Pages: 1 -end -restore -%%EOF diff --git a/dev/printers.mllib b/dev/printers.mllib index 889484ee..6a42678e 100644 --- a/dev/printers.mllib +++ b/dev/printers.mllib @@ -7,18 +7,16 @@ Flags Segmenttree Unicodetable Util +Errors Bigint Hashcons Dyn System Envars -Bstack -Edit -Gset +Store Gmap Fset Fmap -Tlm Gmapl Profile Explore @@ -27,6 +25,7 @@ Rtree Heap Option Dnet +Hashtbl_alt Names Univ @@ -71,7 +70,7 @@ Assumptions Termops Namegen Evd -Rawterm +Glob_term Reductionops Inductiveops Retyping @@ -81,6 +80,7 @@ Evarutil Term_dnet Recordops Evarconv +Arguments_renaming Typing Pattern Matching @@ -94,8 +94,9 @@ Coercion Unification Cases Pretyping -Clenv +Declaremods +Tok Lexer Ppextend Genarg @@ -109,12 +110,17 @@ Syntax_def Implicit_quantifiers Smartlocate Constrintern -Proof_trees +Modintern Tacexpr Proof_type +Goal Logic Refiner +Clenv Evar_refiner +Proofview +Proof +Proof_global Pfedit Tactic_debug Decl_mode diff --git a/dev/tools/change-header b/dev/tools/change-header new file mode 100755 index 00000000..61cc8666 --- /dev/null +++ b/dev/tools/change-header @@ -0,0 +1,55 @@ +#!/bin/sh + +#This script changes the header of .ml* files + +if [ ! $# = 2 ]; then + echo Usage: change-header old-header-file new-header-file + exit 1 +fi + +oldheader=$1 +newheader=$2 + +if [ ! -f $oldheader ]; then echo Cannot read file $oldheader; exit 1; fi +if [ ! -f $newheader ]; then echo Cannot read file $newheader; exit 1; fi + +n=`wc -l $oldheader | sed -e "s/ *\([0-9]*\).*/\1/g"` +nsucc=`expr $n + 1` + +linea='(* -*- coding:utf-8 -*- *)' +lineb='(* -*- compile-command: "make -C ../.. bin/coqdoc" -*- *)' + +modified=0 +kept=0 + +for i in `find . -name \*.mli -o -name \*.ml -o -name \*.ml4 -o -name \*.mll -o -name \*.mly -o -name \*.mlp -o -name \*.v`; do + headline=`head -n 1 $i` + if `echo $headline | grep "(\* -\*- .* \*)" > /dev/null`; then + # Has emacs header + head -n +$nsucc $i | tail -n $n > $i.head.tmp$$ + hasheadline=1 + nnext=`expr $nsucc + 1` + else + head -n +$n $i > $i.head.tmp$$ + hasheadline=0 + nnext=$nsucc + fi + if diff -a -q $oldheader $i.head.tmp$$ > /dev/null; then + echo "$i: header changed" + if [ $hasheadline = 1 ]; then + echo $headline > $i.tmp$$ + else + touch $i.tmp$$ + fi + cat $newheader >> $i.tmp$$ + tail -n +$nnext $i >> $i.tmp$$ + mv $i.tmp$$ $i + modified=`expr $modified + 1` + else + kept=`expr $kept + 1` + fi + rm $i.head.tmp$$ +done + +echo $modified files updated +echo $kept files unchanged diff --git a/dev/tools/univdot b/dev/tools/univdot deleted file mode 100755 index bb0dd2c8..00000000 --- a/dev/tools/univdot +++ /dev/null @@ -1,49 +0,0 @@ -#!/bin/sh - -usage() { - echo "" - echo "usage: univdot [INPUT] [OUTPUT]" - echo "" - echo "takes the output of Dump Universes \"file\" command" - echo "and transforms it to the dot format" - echo "" - echo "Coq> Dump Universes \"univ.raw\"." - echo "" - echo "user@host> univdot univ.raw | dot -Tps > univ.ps" - echo "" -} - - -# these are dot edge attributes to draw arrows corresponding -# to > >= and = edges of the universe graph - -GT="[color=red]" -GE="[color=blue]" -EQ="[color=black]" - - -# input/output redirection -case $# in - 0) ;; - 1) case $1 in - -h|-help|--help) usage - exit 0 ;; - *) exec < $1 ;; - esac ;; - 2) exec < $1 > $2 ;; - *) usage - exit 0;; -esac - - -# dot header -echo 'digraph G {\ - size="7.5,10" ;\ - rankdir = TB ;' - -sed -e "s/^\([^ =>]\+\) > \([^ =>]\+\)/\1 -> \2 $GT/" \ - -e "s/^\([^ =>]\+\) >= \([^ =>]\+\)/\1 -> \2 $GE/" \ - -e "s/^\([^ =>]\+\) = \([^ =>]\+\)/\1 -> \2 $EQ/" \ -| sed -e "s/\./_/g" - -echo "}" \ No newline at end of file diff --git a/dev/top_printers.ml b/dev/top_printers.ml index 3a6abd43..3fc90761 100644 --- a/dev/top_printers.ml +++ b/dev/top_printers.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* raise Not_found) @@ -58,9 +56,9 @@ let ppconstrdb x = pp(Flags.with_option rawdebug Termops.print_constr x) let ppterm = ppconstr let ppsconstr x = ppconstr (Declarations.force x) let ppconstr_univ x = Constrextern.with_universes ppconstr x -let pprawconstr = (fun x -> pp(pr_lrawconstr x)) +let ppglob_constr = (fun x -> pp(pr_lglob_constr x)) let pppattern = (fun x -> pp(pr_constr_pattern x)) -let pptype = (fun x -> pp(pr_ltype x)) +let pptype = (fun x -> try pp(pr_ltype x) with e -> pp (str (Printexc.to_string e))) let ppfconstr c = ppconstr (Closure.term_of_fconstr c) @@ -114,22 +112,31 @@ let pp_transparent_state s = pp (pr_transparent_state s) (* proof printers *) let ppmetas metas = pp(pr_metaset metas) -let ppevm evd = pp(pr_evar_map evd) +let ppevm evd = pp(pr_evar_map (Some 2) evd) +let ppevmall evd = pp(pr_evar_map None evd) +let pr_existentialset evars = + prlist_with_sep spc pr_meta (ExistentialSet.elements evars) +let ppexistentialset evars = + pp (pr_existentialset evars) let ppclenv clenv = pp(pr_clenv clenv) -let ppgoal g = pp(db_pr_goal g) +let ppgoalgoal gl = pp(Goal.pr_goal gl) +let ppgoal g = pp(Printer.pr_goal g) +(* spiwack: deactivated until a replacement is found let pppftreestate p = pp(print_pftreestate p) +*) -let pr_gls gls = - hov 0 (pr_evar_map (sig_sig gls) ++ fnl () ++ db_pr_goal (sig_it gls)) +(* let ppgoal g = pp(db_pr_goal g) *) +(* let pr_gls gls = *) +(* hov 0 (pr_evar_defs (sig_sig gls) ++ fnl () ++ db_pr_goal (sig_it gls)) *) -let pr_glls glls = - hov 0 (pr_evar_map (sig_sig glls) ++ fnl () ++ - prlist_with_sep pr_fnl db_pr_goal (sig_it glls)) +(* let pr_glls glls = *) +(* hov 0 (pr_evar_defs (sig_sig glls) ++ fnl () ++ *) +(* prlist_with_sep pr_fnl db_pr_goal (sig_it glls)) *) -let ppsigmagoal g = pp(pr_goal (sig_it g)) -let prgls gls = pp(pr_gls gls) -let prglls glls = pp(pr_glls glls) -let pproof p = pp(print_proof Evd.empty empty_named_context p) +(* let ppsigmagoal g = pp(pr_goal (sig_it g)) *) +(* let prgls gls = pp(pr_gls gls) *) +(* let prglls glls = pp(pr_glls glls) *) +(* let pproof p = pp(print_proof Evd.empty empty_named_context p) *) let ppuni u = pp(pr_uni u) @@ -153,6 +160,7 @@ let cast_kind_display k = match k with | VMcast -> "VMcast" | DEFAULTcast -> "DEFAULTcast" + | REVERTcast -> "REVERTcast" let constr_display csr = let rec term_display c = match kind_of_term c with @@ -412,12 +420,12 @@ let _ = (fun () -> in_current_context constr_display c) | _ -> failwith "Vernac extension: cannot occur") with - e -> Pp.pp (Cerrors.explain_exn e) + e -> Pp.pp (Errors.print e) let _ = - extend_vernac_command_grammar "PrintConstr" + extend_vernac_command_grammar "PrintConstr" None [[GramTerminal "PrintConstr"; GramNonTerminal - (dummy_loc,ConstrArgType,Extend.Aentry ("constr","constr"), + (dummy_loc,ConstrArgType,Aentry ("constr","constr"), Some (Names.id_of_string "c"))]] let _ = @@ -429,12 +437,12 @@ let _ = (fun () -> in_current_context print_pure_constr c) | _ -> failwith "Vernac extension: cannot occur") with - e -> Pp.pp (Cerrors.explain_exn e) + e -> Pp.pp (Errors.print e) let _ = - extend_vernac_command_grammar "PrintPureConstr" + extend_vernac_command_grammar "PrintPureConstr" None [[GramTerminal "PrintPureConstr"; GramNonTerminal - (dummy_loc,ConstrArgType,Extend.Aentry ("constr","constr"), + (dummy_loc,ConstrArgType,Aentry ("constr","constr"), Some (Names.id_of_string "c"))]] (* Setting printer of unbound global reference *) diff --git a/dev/v8-syntax/syntax-v8.tex b/dev/v8-syntax/syntax-v8.tex index 46ba24da..6630be06 100644 --- a/dev/v8-syntax/syntax-v8.tex +++ b/dev/v8-syntax/syntax-v8.tex @@ -977,7 +977,6 @@ $$ \nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{ident} \nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{string} \nlsep \TERM{Declare}~\TERM{ML}~\TERM{Module}~\PLUS{\NT{string}} -\nlsep \TERM{Dump}~\TERM{Universes}~\OPT{\NT{string}} \nlsep \TERM{Locate}~\NT{locatable} \nlsep \TERM{Add}~\OPT{\TERM{Rec}}~\TERM{LoadPath}~\NT{string}~\OPT{\NT{as-dirpath}} \nlsep \TERM{Remove}~\TERM{LoadPath}~\NT{string} @@ -1179,8 +1178,6 @@ $$ \nlsep \TERM{Show}~\TERM{Intros} %% Correctness: obsolete ? %%\nlsep \TERM{Show}~\TERM{Programs} -\nlsep \TERM{Explain}~\TERM{Proof}~\OPT{\TERM{Tree}}~\STAR{\NT{num}} -%% Go not documented \nlsep \TERM{Hint}~\OPT{\TERM{Local}}~\NT{hint}~\OPT{\NT{inbases}} %% PrintConstr not documented \end{rules} diff --git a/doc/common/macros.tex b/doc/common/macros.tex index d745f34a..f0fb0883 100755 --- a/doc/common/macros.tex +++ b/doc/common/macros.tex @@ -520,8 +520,6 @@ {\begin{center}\begin{rulebox}} {\end{rulebox}\end{center}} -% $Id: macros.tex 13091 2010-06-08 13:56:19Z herbelin $ - %%% Local Variables: %%% mode: latex diff --git a/doc/common/styles/html/coqremote/cover.html b/doc/common/styles/html/coqremote/cover.html index c3091b4e..f4809a48 100644 --- a/doc/common/styles/html/coqremote/cover.html +++ b/doc/common/styles/html/coqremote/cover.html @@ -1,10 +1,9 @@ - - + - + +Cover Page - + Reference Manual | The Coq Proof Assistant @@ -18,9 +17,9 @@ - + - +
@@ -28,6 +27,7 @@
  • Home
    • +
  • About Coq
  • Get Coq
  • Documentation
    • @@ -54,27 +54,29 @@

    Reference Manual

    - Version 8.31 + Version trunk1





    The Coq Development Team





    -

    +
    • V7.x © INRIA 1999-2004
      • -
    • V8.x © INRIA 2004-2010
      • +
    • V8.0 © INRIA 2004-2006
      • +
    • V8.1 © INRIA 2006-2008
      • +
    • V8.2 © INRIA 2008-2009

    This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at http://www.opencontent.org/openpub). Options A and B are not elected.


    -
    +
    -
    1
    +
    1
    This research was partly supported by IST working group ``Types''
    diff --git a/doc/common/styles/html/coqremote/footer.html b/doc/common/styles/html/coqremote/footer.html deleted file mode 100644 index 2b4e0de0..00000000 --- a/doc/common/styles/html/coqremote/footer.html +++ /dev/null @@ -1,43 +0,0 @@ -
    - -
    - - -
- - - -
- - - - diff --git a/doc/common/styles/html/coqremote/header.html b/doc/common/styles/html/coqremote/header.html deleted file mode 100644 index 025e1d3a..00000000 --- a/doc/common/styles/html/coqremote/header.html +++ /dev/null @@ -1,49 +0,0 @@ - - - - - -Standard Library | The Coq Proof Assistant - - - - - - - - - - - - - - - -
- - - - -
- diff --git a/doc/common/styles/html/coqremote/styles.hva b/doc/common/styles/html/coqremote/styles.hva index ec14840b..82f18681 100644 --- a/doc/common/styles/html/coqremote/styles.hva +++ b/doc/common/styles/html/coqremote/styles.hva @@ -2,16 +2,16 @@ \begin{rawhtml} - - + + - - - + + + - - - + + + \end{rawhtml}} % for HeVeA @@ -35,7 +35,7 @@
- +
+
\n\n\n" @@ -624,7 +636,7 @@ module Html = struct let rec reach_item_level n = if !item_level < n then begin - printf "
    \n
  • "; incr item_level; + printf "
      \n
    • "; incr item_level; reach_item_level n end else if !item_level > n then begin printf "\n
      • \n
    \n"; decr item_level; @@ -662,7 +674,9 @@ module Html = struct let end_code () = end_coq (); start_doc () - let start_inline_coq () = printf "" + let start_inline_coq () = + if !inline_notmono then printf "" + else printf "" let end_inline_coq () = printf "" @@ -670,7 +684,50 @@ module Html = struct let end_inline_coq_block () = end_inline_coq () - let paragraph () = printf "\n

    \n" + let paragraph () = printf "\n
    \n\n" + + (* inference rules *) + let inf_rule assumptions (_,_,midnm) conclusions = + (* this first function replaces any occurance of 3 or more spaces + in a row with " "s. We do this to the assumptions so that + people can put multiple rules on a line with nice formatting *) + let replace_spaces str = + let rec copy a n = match n with 0 -> [] | n -> (a :: copy a (n - 1)) in + let results = Str.full_split (Str.regexp "[' '][' '][' ']+") str in + let strs = List.map (fun r -> match r with + | Str.Text s -> [s] + | Str.Delim s -> + copy " " (String.length s)) + results + in + String.concat "" (List.concat strs) + in + let start_assumption line = + (printf "
\n"; + printf " \n" (replace_spaces line)) in + let end_assumption () = + (printf " \n"; + printf "\n") in + let rec print_assumptions hyps = + match hyps with + | [] -> start_assumption "  " + | [(_,hyp)] -> start_assumption hyp + | ((_,hyp) :: hyps') -> (start_assumption hyp; + end_assumption (); + print_assumptions hyps') in + printf "
%s
\n"; + print_assumptions assumptions; + printf " " + | Some s -> printf " %s  \n " s); + printf "\n"; + printf "\n"; + printf " \n"; + printf "\n"; + print_assumptions conclusions; + end_assumption (); + printf "
\n"; + (match midnm with + | None -> printf "  \n
" let section lev f = let lab = new_label () in @@ -1136,6 +1193,21 @@ let verbatim_char = select output_char Html.char TeXmacs.char Raw.char let hard_verbatim_char = output_char +let inf_rule_dumb assumptions (midsp,midln,midnm) conclusions = + start_verbatim (); + let dumb_line = + function (sp,ln) -> (String.iter char ((String.make sp ' ') ^ ln); + char '\n') + in + (List.iter dumb_line assumptions; + dumb_line (midsp, midln ^ (match midnm with + | Some s -> " " ^ s + | None -> "")); + List.iter dumb_line conclusions); + stop_verbatim () + +let inf_rule = select inf_rule_dumb Html.inf_rule inf_rule_dumb inf_rule_dumb + let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index Raw.make_multi_index let make_index = select Latex.make_index Html.make_index TeXmacs.make_index Raw.make_index let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc Raw.make_toc diff --git a/tools/coqdoc/output.mli b/tools/coqdoc/output.mli index dcd9072d..53d88666 100644 --- a/tools/coqdoc/output.mli +++ b/tools/coqdoc/output.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit val start_verbatim : unit -> unit val stop_verbatim : unit -> unit +(* this outputs an inference rule in one go. You pass it the list of + assumptions, then the middle line info, then the conclusion (which + is allowed to span multiple lines). + + In each case, the int is the number of spaces before the start of + the line's text and the string is the text of the line with the + leading trailing space trimmed. For the middle rule, you can + also optionally provide a name. + + We need the space info so that in modes where we aren't doing + something smart we can just format the rule verbatim like the user did +*) +val inf_rule : (int * string) list + -> (int * string * (string option)) + -> (int * string) list + -> unit + val make_multi_index : unit -> unit val make_index : unit -> unit val make_toc : unit -> unit diff --git a/tools/coqdoc/tokens.ml b/tools/coqdoc/tokens.ml index 9de39083..a228797e 100644 --- a/tools/coqdoc/tokens.ml +++ b/tools/coqdoc/tokens.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* exit 1 | _ -> () + +let commands = + [ "INTERPRAWSILENT", (fun s -> eval_call (Ide_intf.interp (true,false,s))); + "INTERPRAW", (fun s -> eval_call (Ide_intf.interp (true,true,s))); + "INTERPSILENT", (fun s -> eval_call (Ide_intf.interp (false,false,s))); + "INTERP", (fun s -> eval_call (Ide_intf.interp (false,true,s))); + "REWIND", (fun s -> eval_call (Ide_intf.rewind (int_of_string s))); + "GOALS", (fun _ -> eval_call Ide_intf.goals); + "HINTS", (fun _ -> eval_call Ide_intf.hints); + "GETOPTIONS", (fun _ -> eval_call Ide_intf.get_options); + "STATUS", (fun _ -> eval_call Ide_intf.status); + "INLOADPATH", (fun s -> eval_call (Ide_intf.inloadpath s)); + "MKCASES", (fun s -> eval_call (Ide_intf.mkcases s)); + "#", (fun _ -> raise Comment); + ] + +let read_eval_print line = + let lline = String.length line in + let rec find_cmd = function + | [] -> prerr_endline ("Error: Unknown API Command :"^line); exit 1 + | (cmd,fn) :: cmds -> + let lcmd = String.length cmd in + if lline >= lcmd && String.sub line 0 lcmd = cmd then + let arg = try String.sub line (lcmd+1) (lline-lcmd-1) with _ -> "" + in fn arg + else find_cmd cmds + in + find_cmd commands + +let usage () = + Printf.printf + "A fake coqide process talking to a coqtop -ideslave.\n\ + Usage: %s []\n\ + Input syntax is one API call per line, the keyword coming first,\n\ + with the rest of the line as string argument (e.g. INTERP Check plus.)\n\ + Supported API keywords are:\n" (Filename.basename Sys.argv.(0)); + List.iter (fun (s,_) -> Printf.printf "\t%s\n" s) commands; + exit 1 + +let main = + Sys.set_signal Sys.sigpipe + (Sys.Signal_handle + (fun _ -> prerr_endline "Broken Pipe (coqtop died ?)"; exit 1)); + let coqtop_name = match Array.length Sys.argv with + | 1 -> "coqtop" + | 2 when Sys.argv.(1) <> "-help" -> Sys.argv.(1) + | _ -> usage () + in + coqtop := Unix.open_process (coqtop_name^" -ideslave"); + while true do + let l = try read_line () with End_of_file -> exit 0 + in + try read_eval_print l + with + | Comment -> () + | e -> + prerr_endline ("Uncaught exception" ^ Printexc.to_string e); exit 1 + done diff --git a/tools/gallina.ml b/tools/gallina.ml index 161d86a8..3d7b1a2c 100644 --- a/tools/gallina.ml +++ b/tools/gallina.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (Coqlib.build_bool_type()).Coqlib.andb +let induct_on c = + new_induct false + [Tacexpr.ElimOnConstr (Evd.empty,(c,Glob_term.NoBindings))] + None (None,None) None + +let destruct_on_using c id = + new_destruct false + [Tacexpr.ElimOnConstr (Evd.empty,(c,Glob_term.NoBindings))] + None + (None,Some (dl,Genarg.IntroOrAndPattern [ + [dl,Genarg.IntroAnonymous]; + [dl,Genarg.IntroIdentifier id]])) + None + +let destruct_on c = + new_destruct false + [Tacexpr.ElimOnConstr (Evd.empty,(c,Glob_term.NoBindings))] + None (None,None) None + (* reconstruct the inductive with the correct deBruijn indexes *) let mkFullInd ind n = let mib = Global.lookup_mind (fst ind) in @@ -329,13 +346,12 @@ let do_replace_lb lb_scheme_key aavoid narg gls p q = with Not_found -> (* spiwack: the format of this error message should probably be improved. *) - let err_msg = msg_with Format.str_formatter + let err_msg = string_of_ppcmds (str "Leibniz->boolean:" ++ str "You have to declare the" ++ str "decidability over " ++ Printer.pr_constr type_of_pq ++ - str " first."); - Format.flush_str_formatter () + str " first.") in error err_msg in let lb_args = Array.append (Array.append @@ -387,13 +403,12 @@ let do_replace_bl bl_scheme_key ind gls aavoid narg lft rgt = with Not_found -> (* spiwack: the format of this error message should probably be improved. *) - let err_msg = msg_with Format.str_formatter + let err_msg = string_of_ppcmds (str "boolean->Leibniz:" ++ str "You have to declare the" ++ str "decidability over " ++ Printer.pr_constr tt1 ++ - str " first."); - Format.flush_str_formatter () + str " first.") in error err_msg in let bl_args = @@ -513,17 +528,9 @@ let compute_bl_tact bl_scheme_key ind lnamesparrec nparrec gsig = avoid := freshz::(!avoid); tclTHENSEQ [ intros_using fresh_first_intros; intro_using freshn ; - new_induct false [ (Tacexpr.ElimOnConstr ((mkVar freshn), - Rawterm.NoBindings))] - None - (None,None) - None; + induct_on (mkVar freshn); intro_using freshm; - new_destruct false [ (Tacexpr.ElimOnConstr ((mkVar freshm), - Rawterm.NoBindings))] - None - (None,None) - None; + destruct_on (mkVar freshm); intro_using freshz; intros; tclTRY ( @@ -541,7 +548,7 @@ repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]). in avoid := fresht::(!avoid); (new_destruct false [Tacexpr.ElimOnConstr - ((mkVar freshz,Rawterm.NoBindings))] + (Evd.empty,((mkVar freshz,Glob_term.NoBindings)))] None (None, Some (dl,Genarg.IntroOrAndPattern [[ dl,Genarg.IntroIdentifier fresht; @@ -551,7 +558,7 @@ repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]). Ci a1 ... an = Ci b1 ... bn replace bi with ai; auto || replace bi with ai by apply typeofbi_prod ; auto *) - fun gls-> let gl = (gls.Evd.it).Evd.evar_concl in + fun gls-> let gl = pf_concl gls in match (kind_of_term gl) with | App (c,ca) -> ( match (kind_of_term c) with @@ -583,7 +590,7 @@ let make_bl_scheme mind = let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = context_chop (nparams-nparrec) mib.mind_params_ctxt in - [|Pfedit.build_by_tactic + [|Pfedit.build_by_tactic (Global.env()) (compute_bl_goal ind lnamesparrec nparrec) (compute_bl_tact (!bl_scheme_kind_aux()) ind lnamesparrec nparrec)|] @@ -651,30 +658,22 @@ let compute_lb_tact lb_scheme_key ind lnamesparrec nparrec gsig = avoid := freshz::(!avoid); tclTHENSEQ [ intros_using fresh_first_intros; intro_using freshn ; - new_induct false [Tacexpr.ElimOnConstr - ((mkVar freshn),Rawterm.NoBindings)] - None - (None,None) - None; + induct_on (mkVar freshn); intro_using freshm; - new_destruct false [Tacexpr.ElimOnConstr - ((mkVar freshm),Rawterm.NoBindings)] - None - (None,None) - None; + destruct_on (mkVar freshm); intro_using freshz; intros; tclTRY ( tclORELSE reflexivity (Equality.discr_tac false None) ); - Equality.inj [] false (mkVar freshz,Rawterm.NoBindings); + Equality.inj [] false (mkVar freshz,Glob_term.NoBindings); intros; simpl_in_concl; Auto.default_auto; tclREPEAT ( tclTHENSEQ [apply (andb_true_intro()); simplest_split ;Auto.default_auto ] ); - fun gls -> let gl = (gls.Evd.it).Evd.evar_concl in + fun gls -> let gl = pf_concl gls in (* assume the goal to be eq (eq_type ...) = true *) match (kind_of_term gl) with | App(c,ca) -> (match (kind_of_term ca.(1)) with @@ -703,7 +702,7 @@ let make_lb_scheme mind = let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = context_chop (nparams-nparrec) mib.mind_params_ctxt in - [|Pfedit.build_by_tactic + [|Pfedit.build_by_tactic (Global.env()) (compute_lb_goal ind lnamesparrec nparrec) (compute_lb_tact (!lb_scheme_kind_aux()) ind lnamesparrec nparrec)|] @@ -810,24 +809,11 @@ let compute_dec_tact ind lnamesparrec nparrec gsig = assert_by (Name freshH) ( mkApp(sumbool(),[|eqtrue eqbnm; eqfalse eqbnm|]) ) - (tclTHEN - (new_destruct false [Tacexpr.ElimOnConstr - (eqbnm,Rawterm.NoBindings)] - None - (None,None) - None) - Auto.default_auto); + (tclTHEN (destruct_on eqbnm) Auto.default_auto); (fun gsig -> let freshH2 = fresh_id (!avoid) (id_of_string "H") gsig in avoid := freshH2::(!avoid); - tclTHENS ( - new_destruct false [Tacexpr.ElimOnConstr - ((mkVar freshH),Rawterm.NoBindings)] - None - (None,Some (dl,Genarg.IntroOrAndPattern [ - [dl,Genarg.IntroAnonymous]; - [dl,Genarg.IntroIdentifier freshH2]])) None - ) [ + tclTHENS (destruct_on_using (mkVar freshH) freshH2) [ (* left *) tclTHENSEQ [ simplest_left; @@ -850,10 +836,10 @@ let compute_dec_tact ind lnamesparrec nparrec gsig = Auto.default_auto ]); Equality.general_rewrite_bindings_in true - all_occurrences false + all_occurrences true false (List.hd !avoid) ((mkVar (List.hd (List.tl !avoid))), - Rawterm.NoBindings + Glob_term.NoBindings ) true; Equality.discr_tac false None @@ -870,7 +856,7 @@ let make_eq_decidability mind = let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = context_chop (nparams-nparrec) mib.mind_params_ctxt in - [|Pfedit.build_by_tactic + [|Pfedit.build_by_tactic (Global.env()) (compute_dec_goal ind lnamesparrec nparrec) (compute_dec_tact ind lnamesparrec nparrec)|] diff --git a/toplevel/auto_ind_decl.mli b/toplevel/auto_ind_decl.mli index c791da28..076a946a 100644 --- a/toplevel/auto_ind_decl.mli +++ b/toplevel/auto_ind_decl.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr array -(* Build equivalence between boolean equality and Leibniz equality *) +(** {6 Build equivalence between boolean equality and Leibniz equality } *) val lb_scheme_kind : mutual scheme_kind val make_lb_scheme : mutual_inductive -> constr array @@ -35,7 +40,7 @@ val make_lb_scheme : mutual_inductive -> constr array val bl_scheme_kind : mutual scheme_kind val make_bl_scheme : mutual_inductive -> constr array -(* Build decidability of equality *) +(** {6 Build decidability of equality } *) val eq_dec_scheme_kind : mutual scheme_kind val make_eq_decidability : mutual_inductive -> constr array diff --git a/toplevel/autoinstance.ml b/toplevel/autoinstance.ml index 4a67ede4..9258a39f 100644 --- a/toplevel/autoinstance.ml +++ b/toplevel/autoinstance.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* msgnl (str"Error defining instance := "++pr_constr def++str" : "++pr_constr typ++str" "++Cerrors.explain_exn e) + with e -> msgnl (str"Error defining instance := "++pr_constr def++str" : "++pr_constr typ++str" "++Errors.print e) let rec iter_under_prod (f:rel_context->constr->unit) (ctx:rel_context) t = f ctx t; match kind_of_term t with @@ -255,7 +257,7 @@ let gen_sort_topo l evm = (* register real typeclass instance given a totally defined evd *) let declare_instance (k:global_reference -> rel_context -> constr list -> unit) (cl,gen,evm:signature) = - let evm = Evarutil.nf_evars evm in + let evm = Evarutil.nf_evar_map evm in let gen = gen_sort_topo gen evm in let (evm,gen) = List.fold_right (fun ev (evm,gen) -> @@ -310,6 +312,7 @@ let end_autoinstance () = let _ = Goptions.declare_bool_option { Goptions.optsync=true; + Goptions.optdepr=false; Goptions.optkey=["Autoinstance"]; Goptions.optname="automatic typeclass instance recognition"; Goptions.optread=(fun () -> !autoinstance_opt); diff --git a/toplevel/autoinstance.mli b/toplevel/autoinstance.mli index b9b1e3c2..dd50cda5 100644 --- a/toplevel/autoinstance.mli +++ b/toplevel/autoinstance.mli @@ -1,38 +1,34 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* rel_context -> constr list -> unit -(* [search_declaration gr] Search in the library if the (new) +(** [search_declaration gr] Search in the library if the (new) * declaration gr can form an instance of a registered record/class *) val search_declaration : global_reference -> unit -(* [search_record declf gr evm] Search the library for instances of +(** [search_record declf gr evm] Search the library for instances of the (new) record/class declaration [gr], and register them using [declf]. [evm] is the signature of the record (to avoid recomputing it) *) val search_record : instance_decl_function -> global_reference -> evar_map -> unit -(* Instance declaration for both scenarios *) +(** Instance declaration for both scenarios *) val declare_record_instance : instance_decl_function val declare_class_instance : instance_decl_function diff --git a/toplevel/cerrors.ml b/toplevel/cerrors.ml index 86057b4b..5f2c3dbb 100644 --- a/toplevel/cerrors.ml +++ b/toplevel/cerrors.ml @@ -1,20 +1,18 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* - hov 0 (anomaly_string () ++ str "uncaught Stream.Failure.") - | Stream.Error txt -> - hov 0 (str "Syntax error: " ++ str txt ++ str ".") - | Token.Error txt -> - hov 0 (str "Syntax error: " ++ str txt ++ str ".") - | Sys_error msg -> - hov 0 (anomaly_string () ++ str "uncaught exception Sys_error " ++ str (guill msg) ++ report_fn ()) - | UserError(s,pps) -> - hov 0 (str "Error: " ++ where s ++ pps) - | Out_of_memory -> - hov 0 (str "Out of memory.") - | Stack_overflow -> - hov 0 (str "Stack overflow.") - | Timeout -> - hov 0 (str "Timeout!") - | Anomaly (s,pps) -> - hov 0 (anomaly_string () ++ where s ++ pps ++ report_fn ()) - | AnomalyOnError (s,exc) -> - hov 0 (anomaly_string () ++ str s ++ str ". Received exception is:" ++ - fnl() ++ explain_exn_default_aux anomaly_string report_fn exc) - | Match_failure(filename,pos1,pos2) -> - hov 0 (anomaly_string () ++ str "Match failure in file " ++ str (guill filename) ++ - if Sys.ocaml_version = "3.06" then - (str " from character " ++ int pos1 ++ - str " to " ++ int pos2) - else - (str " at line " ++ int pos1 ++ - str " character " ++ int pos2) - ++ report_fn ()) - | Not_found -> - hov 0 (anomaly_string () ++ str "uncaught exception Not_found" ++ report_fn ()) - | Failure s -> - hov 0 (anomaly_string () ++ str "uncaught exception Failure " ++ str (guill s) ++ report_fn ()) - | Invalid_argument s -> - hov 0 (anomaly_string () ++ str "uncaught exception Invalid_argument " ++ str (guill s) ++ report_fn ()) - | Sys.Break -> - hov 0 (fnl () ++ str "User interrupt.") - | Lexer.Error Illegal_character -> - hov 0 (str "Syntax error: Illegal character.") - | Lexer.Error Unterminated_comment -> - hov 0 (str "Syntax error: Unterminated comment.") - | Lexer.Error Unterminated_string -> - hov 0 (str "Syntax error: Unterminated string.") - | Lexer.Error Undefined_token -> - hov 0 (str "Syntax error: Undefined token.") - | Lexer.Error (Bad_token s) -> - hov 0 (str "Syntax error: Bad token" ++ spc () ++ str s ++ str ".") - | Stdpp.Exc_located (loc,exc) -> +(** Registration of generic errors + Nota: explain_exn does NOT end with a newline anymore! +*) + +let explain_exn_default = function + (* Basic interaction exceptions *) + | Stream.Error txt -> hov 0 (str ("Syntax error: " ^ txt ^ ".")) + | Token.Error txt -> hov 0 (str ("Syntax error: " ^ txt ^ ".")) + | Lexer.Error.E err -> hov 0 (str (Lexer.Error.to_string err)) + | Sys_error msg -> hov 0 (str ("System error: " ^ guill msg)) + | Out_of_memory -> hov 0 (str "Out of memory.") + | Stack_overflow -> hov 0 (str "Stack overflow.") + | Timeout -> hov 0 (str "Timeout!") + | Sys.Break -> hov 0 (fnl () ++ str "User interrupt.") + (* Meta-exceptions *) + | Loc.Exc_located (loc,exc) -> hov 0 ((if loc = dummy_loc then (mt ()) else (str"At location " ++ print_loc loc ++ str":" ++ fnl ())) - ++ explain_exn_default_aux anomaly_string report_fn exc) - | Assert_failure (s,b,e) -> - hov 0 (anomaly_string () ++ str "assert failure" ++ spc () ++ - (if s <> "" then - if Sys.ocaml_version = "3.06" then - (str ("(file \"" ^ s ^ "\", characters ") ++ - int b ++ str "-" ++ int e ++ str ")") - else - (str ("(file \"" ^ s ^ "\", line ") ++ int b ++ - str ", characters " ++ int e ++ str "-" ++ - int (e+6) ++ str ")") - else - (mt ())) ++ - report_fn ()) - | EvaluatedError (msg,None) -> - msg - | EvaluatedError (msg,Some reraise) -> - msg ++ explain_exn_default_aux anomaly_string report_fn reraise - | reraise -> - hov 0 (anomaly_string () ++ str "Uncaught exception " ++ - str (Printexc.to_string reraise) ++ report_fn ()) + ++ Errors.print_no_anomaly exc) + | EvaluatedError (msg,None) -> msg + | EvaluatedError (msg,Some reraise) -> msg ++ Errors.print_no_anomaly reraise + (* Otherwise, not handled here *) + | _ -> raise Errors.Unhandled + +let _ = Errors.register_handler explain_exn_default + + +(** Pre-explain a vernac interpretation error *) let wrap_vernac_error strm = EvaluatedError (hov 0 (str "Error:" ++ spc () ++ strm), None) @@ -120,13 +69,17 @@ let rec process_vernac_interp_error = function mt() in wrap_vernac_error (str "Universe inconsistency" ++ msg ++ str ".") | TypeError(ctx,te) -> - wrap_vernac_error (Himsg.explain_type_error ctx te) - | PretypeError(ctx,te) -> - wrap_vernac_error (Himsg.explain_pretype_error ctx te) + wrap_vernac_error (Himsg.explain_type_error ctx Evd.empty te) + | PretypeError(ctx,sigma,te) -> + wrap_vernac_error (Himsg.explain_pretype_error ctx sigma te) | Typeclasses_errors.TypeClassError(env, te) -> wrap_vernac_error (Himsg.explain_typeclass_error env te) | InductiveError e -> wrap_vernac_error (Himsg.explain_inductive_error e) + | Modops.ModuleTypingError e -> + wrap_vernac_error (Himsg.explain_module_error e) + | Modintern.ModuleInternalizationError e -> + wrap_vernac_error (Himsg.explain_module_internalization_error e) | RecursionSchemeError e -> wrap_vernac_error (Himsg.explain_recursion_scheme_error e) | Cases.PatternMatchingError (env,e) -> @@ -145,10 +98,10 @@ let rec process_vernac_interp_error = function (str "No constant of this name:" ++ spc () ++ Libnames.pr_qualid q ++ str ".") | Refiner.FailError (i,s) -> - EvaluatedError (hov 0 (str "Error: Tactic failure" ++ - (if Lazy.force s <> mt() then str ":" ++ Lazy.force s else mt ()) ++ - if i=0 then str "." else str " (level " ++ int i ++ str")."), - None) + wrap_vernac_error + (str "Tactic failure" ++ + (if Lazy.force s <> mt() then str ":" ++ Lazy.force s else mt ()) ++ + if i=0 then str "." else str " (level " ++ int i ++ str").") | AlreadyDeclared msg -> wrap_vernac_error (msg ++ str ".") | Proof_type.LtacLocated (_,(Refiner.FailError (i,s) as exc)) when Lazy.force s <> mt () -> @@ -156,32 +109,13 @@ let rec process_vernac_interp_error = function | Proof_type.LtacLocated (s,exc) -> EvaluatedError (hov 0 (Himsg.explain_ltac_call_trace s ++ fnl()), Some (process_vernac_interp_error exc)) - | Stdpp.Exc_located (loc,exc) -> - Stdpp.Exc_located (loc,process_vernac_interp_error exc) + | Loc.Exc_located (loc,exc) -> + Loc.Exc_located (loc,process_vernac_interp_error exc) | exc -> exc -let anomaly_string () = str "Anomaly: " - -let report () = (str "." ++ spc () ++ str "Please report.") - -let explain_exn_default = - explain_exn_default_aux anomaly_string report - -let raise_if_debug e = - if !Flags.debug then raise e - let _ = Tactic_debug.explain_logic_error := - (fun e -> explain_exn_default (process_vernac_interp_error e)) + (fun e -> Errors.print (process_vernac_interp_error e)) let _ = Tactic_debug.explain_logic_error_no_anomaly := - (fun e -> - explain_exn_default_aux (fun () -> mt()) (fun () -> str ".") - (process_vernac_interp_error e)) - -let explain_exn_function = ref explain_exn_default - -let explain_exn e = !explain_exn_function e - -let explain_exn_no_anomaly e = - explain_exn_default_aux (fun () -> raise e) mt e + (fun e -> Errors.print_no_report (process_vernac_interp_error e)) diff --git a/toplevel/cerrors.mli b/toplevel/cerrors.mli index e1f7c035..da9d3590 100644 --- a/toplevel/cerrors.mli +++ b/toplevel/cerrors.mli @@ -1,35 +1,24 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* std_ppcmds -val explain_exn : exn -> std_ppcmds - -(** Precompute errors raised during vernac interpretation *) - -val explain_exn_no_anomaly : exn -> std_ppcmds - (** Pre-explain a vernac interpretation error *) val process_vernac_interp_error : exn -> exn -(** For debugging purpose (?), the explain function can be twicked *) +(** General explain function. Should not be used directly now, + see instead function [Errors.print] and variants *) -val explain_exn_function : (exn -> std_ppcmds) ref val explain_exn_default : exn -> std_ppcmds -val raise_if_debug : exn -> unit diff --git a/toplevel/class.ml b/toplevel/class.ml index 09ce84e0..ebaa19b6 100644 --- a/toplevel/class.ml +++ b/toplevel/class.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* true - | (n,t::l) -> (strip_outer_cast t = mkRel n) & (aux ((n-1),l)) + | (n,t::l) -> + let t = strip_outer_cast t in + isRel t && destRel t = n && aux ((n-1),l) | _ -> false in aux (nargs,lt) @@ -126,7 +126,7 @@ let get_source lp source = let (cl1,lv1) = match lp with | [] -> raise Not_found - | t1::_ -> find_class_type (Global.env()) Evd.empty t1 + | t1::_ -> find_class_type Evd.empty t1 in (cl1,lv1,1) | Some cl -> @@ -134,7 +134,7 @@ let get_source lp source = | [] -> raise Not_found | t1::lt -> try - let cl1,lv1 = find_class_type (Global.env()) Evd.empty t1 in + let cl1,lv1 = find_class_type Evd.empty t1 in if cl = cl1 then cl1,lv1,(List.length lt+1) else raise Not_found with Not_found -> aux lt @@ -144,7 +144,7 @@ let get_target t ind = if (ind > 1) then CL_FUN else - fst (find_class_type (Global.env()) Evd.empty t) + fst (find_class_type Evd.empty t) let prods_of t = let rec aux acc d = match kind_of_term d with @@ -212,16 +212,16 @@ let build_id_coercion idf_opt source = match idf_opt with | Some idf -> idf | None -> - let cl,_ = find_class_type (Global.env()) Evd.empty t in + let cl,_ = find_class_type Evd.empty t in id_of_string ("Id_"^(ident_key_of_class source)^"_"^ (ident_key_of_class cl)) in let constr_entry = (* Cast is necessary to express [val_f] is identity *) DefinitionEntry { const_entry_body = mkCast (val_f, DEFAULTcast, typ_f); + const_entry_secctx = None; const_entry_type = Some typ_f; - const_entry_opaque = false; - const_entry_boxed = Flags.boxed_definitions()} in + const_entry_opaque = false } in let kn = declare_constant idf (constr_entry,IsDefinition IdentityCoercion) in ConstRef kn @@ -266,7 +266,7 @@ let add_new_coercion_core coef stre source target isid = check_arity cls; check_arity clt; let stre' = get_strength stre coef cls clt in - declare_coercion coef stre' isid cls clt (List.length lvs) + declare_coercion coef stre' ~isid ~src:cls ~target:clt ~params:(List.length lvs) let try_add_new_coercion_core ref b c d e = try add_new_coercion_core ref b c d e diff --git a/toplevel/class.mli b/toplevel/class.mli index b05f38e7..2cc8c453 100644 --- a/toplevel/class.mli +++ b/toplevel/class.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* locality -> source:cl_typ -> target:cl_typ -> unit -(* [try_add_new_coercion ref s] declares [ref], assumed to be of type +(** [try_add_new_coercion ref s] declares [ref], assumed to be of type [(x1:T1)...(xn:Tn)src->tg], as a coercion from [src] to [tg] *) val try_add_new_coercion : global_reference -> locality -> unit -(* [try_add_new_coercion_subclass cst s] expects that [cst] denotes a +(** [try_add_new_coercion_subclass cst s] expects that [cst] denotes a transparent constant which unfolds to some class [tg]; it declares an identity coercion from [cst] to [tg], named something like ["Id_cst_tg"] *) val try_add_new_coercion_subclass : cl_typ -> locality -> unit -(* [try_add_new_coercion_with_source ref s src] declares [ref] as a coercion +(** [try_add_new_coercion_with_source ref s src] declares [ref] as a coercion from [src] to [tg] where the target is inferred from the type of [ref] *) val try_add_new_coercion_with_source : global_reference -> locality -> source:cl_typ -> unit -(* [try_add_new_identity_coercion id s src tg] enriches the +(** [try_add_new_identity_coercion id s src tg] enriches the environment with a new definition of name [id] declared as an identity coercion from [src] to [tg] *) val try_add_new_identity_coercion : identifier -> locality -> diff --git a/toplevel/classes.ml b/toplevel/classes.ml index 28c1ab75..1e83e4b8 100644 --- a/toplevel/classes.ml +++ b/toplevel/classes.ml @@ -1,19 +1,15 @@ -(* -*- compile-command: "make -C .. bin/coqtop.byte" -*- *) (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* + (fun inst local pri -> + let path = try Auto.PathHints [global_of_constr inst] with _ -> Auto.PathAny in Flags.silently (fun () -> - Auto.add_hints false [typeclasses_db] + Auto.add_hints local [typeclasses_db] (Auto.HintsResolveEntry - [pri, false, constr_of_global inst])) ()); - Typeclasses.register_set_typeclass_transparency set_typeclass_transparency + [pri, false, path, inst])) ()); + Typeclasses.register_set_typeclass_transparency set_typeclass_transparency; + Typeclasses.register_classes_transparent_state + (fun () -> Auto.Hint_db.transparent_state (Auto.searchtable_map typeclasses_db)) let declare_class g = match global g with @@ -54,12 +53,13 @@ let declare_class g = | _ -> user_err_loc (loc_of_reference g, "declare_class", Pp.str"Unsupported class type, only constants and inductives are allowed") -let declare_instance glob g = +(** TODO: add subinstances *) +let existing_instance glob g = let c = global g in let instance = Typing.type_of (Global.env ()) Evd.empty (constr_of_global c) in let _, r = decompose_prod_assum instance in match class_of_constr r with - | Some tc -> add_instance (new_instance tc None glob c) + | Some (_, (tc, _)) -> add_instance (new_instance tc None glob c) | None -> user_err_loc (loc_of_reference g, "declare_instance", Pp.str "Constant does not build instances of a declared type class.") @@ -68,13 +68,6 @@ let mismatched_props env n m = mismatched_ctx_inst env Properties n m type binder_list = (identifier located * bool * constr_expr) list -(* Calls to interpretation functions. *) - -let interp_type_evars evdref env ?(impls=empty_internalization_env) typ = - let typ' = intern_gen true ~impls !evdref env typ in - let imps = Implicit_quantifiers.implicits_of_rawterm typ' in - imps, Pretyping.Default.understand_tcc_evars evdref env Pretyping.IsType typ' - (* Declare everything in the parameters as implicit, and the class instance as well *) open Topconstr @@ -108,19 +101,18 @@ open Pp let ($$) g f = fun x -> g (f x) let instance_hook k pri global imps ?hook cst = - let inst = Typeclasses.new_instance k pri global cst in - Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps; - Typeclasses.add_instance inst; - (match hook with Some h -> h cst | None -> ()) + Impargs.maybe_declare_manual_implicits false cst ~enriching:false imps; + Typeclasses.declare_instance pri (not global) cst; + (match hook with Some h -> h cst | None -> ()) let declare_instance_constant k pri global imps ?hook id term termtype = let cdecl = let kind = IsDefinition Instance in let entry = { const_entry_body = term; + const_entry_secctx = None; const_entry_type = Some termtype; - const_entry_opaque = false; - const_entry_boxed = false } + const_entry_opaque = false } in DefinitionEntry entry, kind in let kn = Declare.declare_constant id cdecl in @@ -148,8 +140,8 @@ let new_instance ?(abstract=false) ?(global=false) ctx (instid, bk, cl) props in let tclass = if generalize then CGeneralization (dummy_loc, Implicit, Some AbsPi, tclass) else tclass in let k, cty, ctx', ctx, len, imps, subst = - let (env', ctx), imps = interp_context_evars evars env ctx in - let c', imps' = interp_type_evars_impls ~evdref:evars ~fail_evar:false env' tclass in + let impls, ((env', ctx), imps) = interp_context_evars evars env ctx in + let c', imps' = interp_type_evars_impls ~impls ~evdref:evars ~fail_evar:false env' tclass in let len = List.length ctx in let imps = imps @ Impargs.lift_implicits len imps' in let ctx', c = decompose_prod_assum c' in @@ -190,26 +182,29 @@ let new_instance ?(abstract=false) ?(global=false) ctx (instid, bk, cl) props Evarutil.nf_evar !evars t in Evarutil.check_evars env Evd.empty !evars termtype; - let cst = Declare.declare_internal_constant id - (Entries.ParameterEntry (termtype,false), Decl_kinds.IsAssumption Decl_kinds.Logical) - in instance_hook k None false imps ?hook (ConstRef cst); id + let cst = Declare.declare_constant ~internal:Declare.KernelSilent id + (Entries.ParameterEntry + (None,termtype,None), Decl_kinds.IsAssumption Decl_kinds.Logical) + in instance_hook k None global imps ?hook (ConstRef cst); id end else begin let props = match props with - | CRecord (loc, _, fs) -> + | Some (CRecord (loc, _, fs)) -> if List.length fs > List.length k.cl_props then mismatched_props env' (List.map snd fs) k.cl_props; - Inl fs - | _ -> Inr props + Some (Inl fs) + | Some t -> Some (Inr t) + | None -> None in let subst = match props with - | Inr term -> + | None -> if k.cl_props = [] then Some (Inl subst) else None + | Some (Inr term) -> let c = interp_casted_constr_evars evars env' term cty in - Inr (c, subst) - | Inl props -> + Some (Inr (c, subst)) + | Some (Inl props) -> let get_id = function | Ident id' -> id' @@ -223,7 +218,10 @@ let new_instance ?(abstract=false) ?(global=false) ctx (instid, bk, cl) props let (loc_mid, c) = List.find (fun (id', _) -> Name (snd (get_id id')) = id) rest in let rest' = List.filter (fun (id', _) -> Name (snd (get_id id')) <> id) rest in let (loc, mid) = get_id loc_mid in - Option.iter (fun x -> Dumpglob.add_glob loc (ConstRef x)) (List.assoc mid k.cl_projs); + List.iter (fun (n, _, x) -> + if n = Name mid then + Option.iter (fun x -> Dumpglob.add_glob loc (ConstRef x)) x) + k.cl_projs; c :: props, rest' with Not_found -> (CHole (Util.dummy_loc, None) :: props), rest @@ -233,12 +231,14 @@ let new_instance ?(abstract=false) ?(global=false) ctx (instid, bk, cl) props if rest <> [] then unbound_method env' k.cl_impl (get_id (fst (List.hd rest))) else - Inl (type_ctx_instance evars (push_rel_context ctx' env') k.cl_props props subst) + Some (Inl (type_ctx_instance evars (push_rel_context ctx' env') k.cl_props props subst)) in evars := Evarutil.nf_evar_map !evars; let term, termtype = match subst with - | Inl subst -> + | None -> let termtype = it_mkProd_or_LetIn cty ctx in + None, termtype + | Some (Inl subst) -> let subst = List.fold_left2 (fun subst' s (_, b, _) -> if b = None then s :: subst' else subst') [] subst (k.cl_props @ snd k.cl_context) @@ -246,26 +246,25 @@ let new_instance ?(abstract=false) ?(global=false) ctx (instid, bk, cl) props let app, ty_constr = instance_constructor k subst in let termtype = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in let term = Termops.it_mkLambda_or_LetIn (Option.get app) (ctx' @ ctx) in - term, termtype - | Inr (def, subst) -> + Some term, termtype + | Some (Inr (def, subst)) -> let termtype = it_mkProd_or_LetIn cty ctx in let term = Termops.it_mkLambda_or_LetIn def ctx in - term, termtype + Some term, termtype in let termtype = Evarutil.nf_evar !evars termtype in - let term = Evarutil.nf_evar !evars term in + let term = Option.map (Evarutil.nf_evar !evars) term in let evm = undefined_evars !evars in Evarutil.check_evars env Evd.empty !evars termtype; - if Evd.is_empty evm then - declare_instance_constant k pri global imps ?hook id term termtype + if Evd.is_empty evm && term <> None then + declare_instance_constant k pri global imps ?hook id (Option.get term) termtype else begin evars := Typeclasses.resolve_typeclasses ~onlyargs:true ~fail:true env !evars; let kind = Decl_kinds.Global, Decl_kinds.DefinitionBody Decl_kinds.Instance in Flags.silently (fun () -> Lemmas.start_proof id kind termtype (fun _ -> instance_hook k pri global imps ?hook); - if props <> Inl [] then - Pfedit.by (* (Refiner.tclTHEN (Refiner.tclEVARS ( !isevars)) *) - (!refine_ref (evm, term)) + if term <> None then + Pfedit.by (!refine_ref (evm, Option.get term)) else if Flags.is_auto_intros () then Pfedit.by (Refiner.tclDO len Tactics.intro); (match tac with Some tac -> Pfedit.by tac | None -> ())) (); @@ -284,18 +283,13 @@ let named_of_rel_context l = l ([], []) in ctx -let push_named_context = List.fold_right push_named - -let rec list_filter_map f = function - | [] -> [] - | hd :: tl -> match f hd with - | None -> list_filter_map f tl - | Some x -> x :: list_filter_map f tl - -let context ?(hook=fun _ -> ()) l = +let string_of_global r = + string_of_qualid (Nametab.shortest_qualid_of_global Idset.empty r) + +let context l = let env = Global.env() in let evars = ref Evd.empty in - let (env', fullctx), impls = interp_context_evars evars env l in + let _, ((env', fullctx), impls) = interp_context_evars evars env l in let fullctx = Evarutil.nf_rel_context_evar !evars fullctx in let ce t = Evarutil.check_evars env Evd.empty !evars t in List.iter (fun (n, b, t) -> Option.iter ce b; ce t) fullctx; @@ -304,13 +298,13 @@ let context ?(hook=fun _ -> ()) l = in let fn (id, _, t) = if Lib.is_modtype () && not (Lib.sections_are_opened ()) then - let cst = Declare.declare_internal_constant id - (ParameterEntry (t,false), IsAssumption Logical) + let cst = Declare.declare_constant ~internal:Declare.KernelSilent id + (ParameterEntry (None,t,None), IsAssumption Logical) in match class_of_constr t with - | Some tc -> - add_instance (Typeclasses.new_instance tc None false (ConstRef cst)); - hook (ConstRef cst) + | Some (rels, (tc, args) as _cl) -> + add_instance (Typeclasses.new_instance tc None false (ConstRef cst)) + (* declare_subclasses (ConstRef cst) cl *) | None -> () else ( let impl = List.exists @@ -318,9 +312,6 @@ let context ?(hook=fun _ -> ()) l = match x with ExplByPos (_, Some id') -> id = id' | _ -> false) impls in Command.declare_assumption false (Local (* global *), Definitional) t - [] impl (* implicit *) false (* inline *) (dummy_loc, id); - match class_of_constr t with - | None -> () - | Some tc -> hook (VarRef id)) + [] impl (* implicit *) None (* inline *) (dummy_loc, id)) in List.iter fn (List.rev ctx) - + diff --git a/toplevel/classes.mli b/toplevel/classes.mli index 69e4dd8b..68a93a74 100644 --- a/toplevel/classes.mli +++ b/toplevel/classes.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr_expr list -> rel_context -> 'a val mismatched_props : env -> constr_expr list -> rel_context -> 'a -(* Post-hoc class declaration. *) +(** Post-hoc class declaration. *) val declare_class : reference -> unit -(* Instance declaration *) +(** Instance declaration *) -val declare_instance : bool -> reference -> unit +val existing_instance : bool -> reference -> unit val declare_instance_constant : typeclass -> - int option -> (* priority *) - bool -> (* globality *) - Impargs.manual_explicitation list -> (* implicits *) + int option -> (** priority *) + bool -> (** globality *) + Impargs.manual_explicitation list -> (** implicits *) ?hook:(Libnames.global_reference -> unit) -> - identifier -> (* name *) - Term.constr -> (* body *) - Term.types -> (* type *) + identifier -> (** name *) + Term.constr -> (** body *) + Term.types -> (** type *) Names.identifier val new_instance : - ?abstract:bool -> (* Not abstract by default. *) - ?global:bool -> (* Not global by default. *) + ?abstract:bool -> (** Not abstract by default. *) + ?global:bool -> (** Not global by default. *) local_binder list -> typeclass_constraint -> - constr_expr -> + constr_expr option -> ?generalize:bool -> ?tac:Proof_type.tactic -> ?hook:(Libnames.global_reference -> unit) -> int option -> identifier -(* Setting opacity *) +(** Setting opacity *) -val set_typeclass_transparency : evaluable_global_reference -> bool -> unit +val set_typeclass_transparency : evaluable_global_reference -> bool -> bool -> unit -(* For generation on names based on classes only *) +(** For generation on names based on classes only *) val id_of_class : typeclass -> identifier -(* Context command *) +(** Context command *) -val context : ?hook:(Libnames.global_reference -> unit) -> - local_binder list -> unit +val context : local_binder list -> unit -(* Forward ref for refine *) +(** Forward ref for refine *) val refine_ref : (open_constr -> Proof_type.tactic) ref - diff --git a/toplevel/command.ml b/toplevel/command.ml index 1112ac6d..eca53ae7 100644 --- a/toplevel/command.ml +++ b/toplevel/command.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* let body = ce.const_entry_body in { ce with const_entry_body = - under_binders (Global.env()) (fst (reduction_of_red_expr red)) n body } + under_binders (Global.env()) (fst (reduction_of_red_expr red)) n body } -let interp_definition boxed bl red_option c ctypopt = +let interp_definition bl red_option c ctypopt = let env = Global.env() in let evdref = ref Evd.empty in - let (env_bl, ctx), imps1 = interp_context_evars evdref env bl in + let impls, ((env_bl, ctx), imps1) = interp_context_evars evdref env bl in + let nb_args = List.length ctx in let imps,ce = match ctypopt with None -> - let c, imps2 = interp_constr_evars_impls ~evdref ~fail_evar:false env_bl c in + let c, imps2 = interp_constr_evars_impls ~impls ~evdref ~fail_evar:false env_bl c in let body = nf_evar !evdref (it_mkLambda_or_LetIn c ctx) in check_evars env Evd.empty !evdref body; - imps1@imps2, + imps1@(Impargs.lift_implicits nb_args imps2), { const_entry_body = body; + const_entry_secctx = None; const_entry_type = None; - const_entry_opaque = false; - const_entry_boxed = boxed } + const_entry_opaque = false } | Some ctyp -> - let ty, impls = interp_type_evars_impls ~evdref ~fail_evar:false env_bl ctyp in - let c, imps2 = interp_casted_constr_evars_impls ~evdref ~fail_evar:false env_bl c ty in + let ty, impsty = interp_type_evars_impls ~impls ~evdref ~fail_evar:false env_bl ctyp in + let c, imps2 = interp_casted_constr_evars_impls ~impls ~evdref ~fail_evar:false env_bl c ty in let body = nf_evar !evdref (it_mkLambda_or_LetIn c ctx) in let typ = nf_evar !evdref (it_mkProd_or_LetIn ty ctx) in check_evars env Evd.empty !evdref body; check_evars env Evd.empty !evdref typ; - imps1@imps2, + imps1@(Impargs.lift_implicits nb_args imps2), { const_entry_body = body; + const_entry_secctx = None; const_entry_type = Some typ; - const_entry_opaque = false; - const_entry_boxed = boxed } + const_entry_opaque = false } in red_constant_entry (rel_context_length ctx) ce red_option, imps @@ -115,11 +114,11 @@ let declare_definition ident (local,k) ce imps hook = let r = match local with | Local when Lib.sections_are_opened () -> let c = - SectionLocalDef(ce.const_entry_body,ce.const_entry_type,false) in + SectionLocalDef(ce.const_entry_body ,ce.const_entry_type,false) in let _ = declare_variable ident (Lib.cwd(),c,IsDefinition k) in definition_message ident; if Pfedit.refining () then - Flags.if_verbose msg_warning + Flags.if_warn msg_warning (str"Local definition " ++ pr_id ident ++ str" is not visible from current goals"); VarRef ident @@ -139,10 +138,12 @@ let declare_assumption is_coe (local,kind) c imps impl nl (_,ident) = if is_verbose () & Pfedit.refining () then msgerrnl (str"Warning: Variable " ++ pr_id ident ++ str" is not visible from current goals"); - VarRef ident + let r = VarRef ident in + Typeclasses.declare_instance None true r; r | (Global|Local) -> let kn = - declare_constant ident (ParameterEntry (c,nl), IsAssumption kind) in + declare_constant ident + (ParameterEntry (None,c,nl), IsAssumption kind) in let gr = ConstRef kn in maybe_declare_manual_implicits false gr imps; assumption_message ident; @@ -150,8 +151,10 @@ let declare_assumption is_coe (local,kind) c imps impl nl (_,ident) = msg_warning (pr_id ident ++ str" is declared as a parameter" ++ str" because it is at a global level"); Autoinstance.search_declaration (ConstRef kn); - gr in - if is_coe then Class.try_add_new_coercion r local + Typeclasses.declare_instance None false gr; + gr + in + if is_coe then Class.try_add_new_coercion r local let declare_assumptions_hook = ref ignore let set_declare_assumptions_hook = (:=) declare_assumptions_hook @@ -225,7 +228,7 @@ let interp_mutual_inductive (paramsl,indl) notations finite = check_all_names_different indl; let env0 = Global.env() in let evdref = ref Evd.empty in - let (env_params, ctx_params), userimpls = + let _, ((env_params, ctx_params), userimpls) = interp_context_evars evdref env0 paramsl in let indnames = List.map (fun ind -> ind.ind_name) indl in @@ -321,7 +324,7 @@ let extract_params indl = let extract_inductive indl = List.map (fun ((_,indname),_,ar,lc) -> { ind_name = indname; - ind_arity = Option.cata (fun x -> x) (CSort (dummy_loc, Rawterm.RType None)) ar; + ind_arity = Option.cata (fun x -> x) (CSort (dummy_loc, Glob_term.GType None)) ar; ind_lc = List.map (fun (_,((_,id),t)) -> (id,t)) lc }) indl @@ -335,7 +338,7 @@ let extract_mutual_inductive_declaration_components indl = let declare_mutual_inductive_with_eliminations isrecord mie impls = let names = List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in let (_,kn) = declare_mind isrecord mie in - let mind = Global.mind_of_delta (mind_of_kn kn) in + let mind = Global.mind_of_delta_kn kn in list_iter_i (fun i (indimpls, constrimpls) -> let ind = (mind,i) in Autoinstance.search_declaration (IndRef ind); @@ -442,7 +445,7 @@ let check_mutuality env isfix fixl = let po = partial_order preorder in match List.filter (function (_,Inr _) -> true | _ -> false) po with | (x,Inr xge)::(y,Inr yge)::rest -> - if_verbose msg_warning (non_full_mutual_message x xge y yge isfix rest) + if_warn msg_warning (non_full_mutual_message x xge y yge isfix rest) | _ -> () type structured_fixpoint_expr = { @@ -455,8 +458,8 @@ type structured_fixpoint_expr = { let interp_fix_context evdref env isfix fix = let before, after = if isfix then split_at_annot fix.fix_binders fix.fix_annot else [], fix.fix_binders in - let (env', ctx), imps = interp_context_evars evdref env before in - let (env'', ctx'), imps' = interp_context_evars evdref env' after in + let impl_env, ((env', ctx), imps) = interp_context_evars evdref env before in + let _, ((env'', ctx'), imps') = interp_context_evars ~impl_env evdref env' after in let annot = Option.map (fun _ -> List.length (assums_of_rel_context ctx)) fix.fix_annot in ((env'', ctx' @ ctx), imps @ imps', annot) @@ -471,13 +474,13 @@ let interp_fix_body evdref env_rec impls (_,ctx) fix ccl = let build_fix_type (_,ctx) ccl = it_mkProd_or_LetIn ccl ctx -let declare_fix boxed kind f def t imps = +let declare_fix kind f def t imps = let ce = { const_entry_body = def; + const_entry_secctx = None; const_entry_type = Some t; - const_entry_opaque = false; - const_entry_boxed = boxed - } in + const_entry_opaque = false } + in let kn = declare_constant f (DefinitionEntry ce,IsDefinition kind) in let gr = ConstRef kn in Autoinstance.search_declaration (ConstRef kn); @@ -547,7 +550,7 @@ let interp_recursive isfix fixl notations = let interp_fixpoint = interp_recursive true let interp_cofixpoint = interp_recursive false -let declare_fixpoint boxed ((fixnames,fixdefs,fixtypes),fiximps) indexes ntns = +let declare_fixpoint ((fixnames,fixdefs,fixtypes),fiximps) indexes ntns = if List.mem None fixdefs then (* Some bodies to define by proof *) let thms = @@ -565,14 +568,14 @@ let declare_fixpoint boxed ((fixnames,fixdefs,fixtypes),fiximps) indexes ntns = let fiximps = List.map (fun (n,r,p) -> r) fiximps in let fixdecls = list_map_i (fun i _ -> mkFix ((indexes,i),fixdecls)) 0 fixnames in - ignore (list_map4 (declare_fix boxed Fixpoint) fixnames fixdecls fixtypes fiximps); + ignore (list_map4 (declare_fix Fixpoint) fixnames fixdecls fixtypes fiximps); (* Declare the recursive definitions *) fixpoint_message (Some indexes) fixnames; end; (* Declare notations *) List.iter Metasyntax.add_notation_interpretation ntns -let declare_cofixpoint boxed ((fixnames,fixdefs,fixtypes),fiximps) ntns = +let declare_cofixpoint ((fixnames,fixdefs,fixtypes),fiximps) ntns = if List.mem None fixdefs then (* Some bodies to define by proof *) let thms = @@ -588,22 +591,23 @@ let declare_cofixpoint boxed ((fixnames,fixdefs,fixtypes),fiximps) ntns = let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in let fixdecls = list_map_i (fun i _ -> mkCoFix (i,fixdecls)) 0 fixnames in let fiximps = List.map (fun (len,imps,idx) -> imps) fiximps in - ignore (list_map4 (declare_fix boxed CoFixpoint) fixnames fixdecls fixtypes fiximps); + ignore (list_map4 (declare_fix CoFixpoint) fixnames fixdecls fixtypes fiximps); (* Declare the recursive definitions *) cofixpoint_message fixnames end; (* Declare notations *) List.iter Metasyntax.add_notation_interpretation ntns -let extract_decreasing_argument = function +let extract_decreasing_argument limit = function | (na,CStructRec) -> na + | (na,_) when not limit -> na | _ -> error "Only structural decreasing is supported for a non-Program Fixpoint" -let extract_fixpoint_components l = +let extract_fixpoint_components limit l = let fixl, ntnl = List.split l in let fixl = List.map (fun ((_,id),ann,bl,typ,def) -> - let ann = extract_decreasing_argument ann in + let ann = extract_decreasing_argument limit ann in {fix_name = id; fix_annot = ann; fix_binders = bl; fix_body = def; fix_type = typ}) fixl in fixl, List.flatten ntnl @@ -613,13 +617,13 @@ let extract_cofixpoint_components l = {fix_name = id; fix_annot = None; fix_binders = bl; fix_body = def; fix_type = typ}) fixl, List.flatten ntnl -let do_fixpoint l b = - let fixl,ntns = extract_fixpoint_components l in +let do_fixpoint l = + let fixl,ntns = extract_fixpoint_components true l in let fix = interp_fixpoint fixl ntns in let possible_indexes = List.map compute_possible_guardness_evidences (snd fix) in - declare_fixpoint b fix possible_indexes ntns + declare_fixpoint fix possible_indexes ntns -let do_cofixpoint l b = +let do_cofixpoint l = let fixl,ntns = extract_cofixpoint_components l in - declare_cofixpoint b (interp_cofixpoint fixl ntns) ntns + declare_cofixpoint (interp_cofixpoint fixl ntns) ntns diff --git a/toplevel/command.mli b/toplevel/command.mli index af89b59a..8ffdbdec 100644 --- a/toplevel/command.mli +++ b/toplevel/command.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit) -> unit val get_declare_definition_hook : unit -> (definition_entry -> unit) val set_declare_assumptions_hook : (types -> unit) -> unit -(*************************************************************************) -(* Definitions/Let *) +(** {6 Definitions/Let} *) val interp_definition : - boxed_flag -> local_binder list -> red_expr option -> constr_expr -> - constr_expr option -> definition_entry * manual_implicits + local_binder list -> red_expr option -> constr_expr -> + constr_expr option -> definition_entry * Impargs.manual_implicits val declare_definition : identifier -> locality * definition_object_kind -> - definition_entry -> manual_implicits -> declaration_hook -> unit + definition_entry -> Impargs.manual_implicits -> declaration_hook -> unit -(*************************************************************************) -(* Parameters/Assumptions *) +(** {6 Parameters/Assumptions} *) val interp_assumption : - local_binder list -> constr_expr -> types * manual_implicits + local_binder list -> constr_expr -> types * Impargs.manual_implicits val declare_assumption : coercion_flag -> assumption_kind -> types -> - manual_implicits -> - bool (* implicit *) -> bool (* inline *) -> variable located -> unit + Impargs.manual_implicits -> + bool (** implicit *) -> Entries.inline -> variable located -> unit val declare_assumptions : variable located list -> - coercion_flag -> assumption_kind -> types -> manual_implicits -> - bool -> bool -> unit + coercion_flag -> assumption_kind -> types -> Impargs.manual_implicits -> + bool -> Entries.inline -> unit -(*************************************************************************) -(* Inductive and coinductive types *) +(** {6 Inductive and coinductive types} *) -(* Extracting the semantical components out of the raw syntax of mutual +(** Extracting the semantical components out of the raw syntax of mutual inductive declarations *) type structured_one_inductive_expr = { @@ -75,30 +68,29 @@ val extract_mutual_inductive_declaration_components : (one_inductive_expr * decl_notation list) list -> structured_inductive_expr * (*coercions:*) qualid list * decl_notation list -(* Typing mutual inductive definitions *) +(** Typing mutual inductive definitions *) type one_inductive_impls = - Impargs.manual_explicitation list (* for inds *)* - Impargs.manual_explicitation list list (* for constrs *) + Impargs.manual_implicits (** for inds *)* + Impargs.manual_implicits list (** for constrs *) val interp_mutual_inductive : structured_inductive_expr -> decl_notation list -> bool -> mutual_inductive_entry * one_inductive_impls list -(* Registering a mutual inductive definition together with its +(** Registering a mutual inductive definition together with its associated schemes *) val declare_mutual_inductive_with_eliminations : Declare.internal_flag -> mutual_inductive_entry -> one_inductive_impls list -> mutual_inductive -(* Entry points for the vernacular commands Inductive and CoInductive *) +(** Entry points for the vernacular commands Inductive and CoInductive *) val do_mutual_inductive : (one_inductive_expr * decl_notation list) list -> bool -> unit -(*************************************************************************) -(* Fixpoints and cofixpoints *) +(** {6 Fixpoints and cofixpoints} *) type structured_fixpoint_expr = { fix_name : identifier; @@ -108,10 +100,10 @@ type structured_fixpoint_expr = { fix_type : constr_expr } -(* Extracting the semantical components out of the raw syntax of +(** Extracting the semantical components out of the raw syntax of (co)fixpoints declarations *) -val extract_fixpoint_components : +val extract_fixpoint_components : bool -> (fixpoint_expr * decl_notation list) list -> structured_fixpoint_expr list * decl_notation list @@ -119,40 +111,40 @@ val extract_cofixpoint_components : (cofixpoint_expr * decl_notation list) list -> structured_fixpoint_expr list * decl_notation list -(* Typing global fixpoints and cofixpoint_expr *) +(** Typing global fixpoints and cofixpoint_expr *) type recursive_preentry = identifier list * constr option list * types list val interp_fixpoint : structured_fixpoint_expr list -> decl_notation list -> - recursive_preentry * (name list * manual_implicits * int option) list + recursive_preentry * (name list * Impargs.manual_implicits * int option) list val interp_cofixpoint : structured_fixpoint_expr list -> decl_notation list -> - recursive_preentry * (name list * manual_implicits * int option) list + recursive_preentry * (name list * Impargs.manual_implicits * int option) list -(* Registering fixpoints and cofixpoints in the environment *) +(** Registering fixpoints and cofixpoints in the environment *) val declare_fixpoint : - bool -> recursive_preentry * (name list * manual_implicits * int option) list -> + recursive_preentry * (name list * Impargs.manual_implicits * int option) list -> lemma_possible_guards -> decl_notation list -> unit val declare_cofixpoint : - bool -> recursive_preentry * (name list * manual_implicits * int option) list -> + recursive_preentry * (name list * Impargs.manual_implicits * int option) list -> decl_notation list -> unit -(* Entry points for the vernacular commands Fixpoint and CoFixpoint *) +(** Entry points for the vernacular commands Fixpoint and CoFixpoint *) val do_fixpoint : - (fixpoint_expr * decl_notation list) list -> bool -> unit + (fixpoint_expr * decl_notation list) list -> unit val do_cofixpoint : - (cofixpoint_expr * decl_notation list) list -> bool -> unit + (cofixpoint_expr * decl_notation list) list -> unit -(* Utils *) +(** Utils *) val check_mutuality : Environ.env -> bool -> (identifier * types) list -> unit -val declare_fix : bool -> definition_object_kind -> identifier -> - constr -> types -> Impargs.manual_explicitation list -> global_reference +val declare_fix : definition_object_kind -> identifier -> + constr -> types -> Impargs.manual_implicits -> global_reference diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml index 210507e1..e4cfcb3f 100644 --- a/toplevel/coqinit.ml +++ b/toplevel/coqinit.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* () (* Flags.if_verbose - mSGNL (str ("No .coqrc or .coqrc."^Coq_config.version^ + mSGNL (str ("No coqrc or coqrc."^Coq_config.version^ " found. Skipping rcfile loading.")) *) with e -> @@ -52,9 +53,9 @@ let load_rcfile() = Flags.if_verbose msgnl (str"Skipping rcfile loading.") (* Puts dir in the path of ML and in the LoadPath *) -let coq_add_path d s = - Mltop.add_path d (Names.make_dirpath [Nameops.coq_root;Names.id_of_string s]) -let coq_add_rec_path s = Mltop.add_rec_path s (Names.make_dirpath [Nameops.coq_root]) +let coq_add_path unix_path s = + Mltop.add_path ~unix_path ~coq_root:(Names.make_dirpath [Nameops.coq_root;Names.id_of_string s]) +let coq_add_rec_path unix_path = Mltop.add_rec_path ~unix_path ~coq_root:(Names.make_dirpath [Nameops.coq_root]) (* By the option -include -I or -R of the command line *) let includes = ref [] @@ -75,10 +76,12 @@ let theories_dirs_map = [ "theories/Sets", "Sets" ; "theories/Structures", "Structures" ; "theories/Lists", "Lists" ; + "theories/Vectors", "Vectors" ; "theories/Wellfounded", "Wellfounded" ; "theories/Relations", "Relations" ; "theories/Numbers", "Numbers" ; "theories/QArith", "QArith" ; + "theories/PArith", "PArith" ; "theories/NArith", "NArith" ; "theories/ZArith", "ZArith" ; "theories/Arith", "Arith" ; @@ -91,24 +94,31 @@ let theories_dirs_map = [ let init_load_path () = let coqlib = Envars.coqlib () in let user_contrib = coqlib/"user-contrib" in + let xdg_dirs = Envars.xdg_dirs in + let coqpath = Envars.coqpath in let dirs = ["states";"plugins"] in - (* first user-contrib *) - if Sys.file_exists user_contrib then - Mltop.add_rec_path user_contrib Nameops.default_root_prefix; - (* then states, theories and dev *) - List.iter (fun s -> coq_add_rec_path (coqlib/s)) dirs; - (* developer specific directory to open *) + (* NOTE: These directories are searched from last to first *) + (* first, developer specific directory to open *) if Coq_config.local then coq_add_path (coqlib/"dev") "dev"; (* then standard library *) List.iter - (fun (s,alias) -> Mltop.add_rec_path (coqlib/s) (Names.make_dirpath [Names.id_of_string alias; Nameops.coq_root])) + (fun (s,alias) -> Mltop.add_rec_path ~unix_path:(coqlib/s) ~coq_root:(Names.make_dirpath [Names.id_of_string alias; Nameops.coq_root])) theories_dirs_map; + (* then states and plugins *) + List.iter (fun s -> coq_add_rec_path (coqlib/s)) dirs; + (* then user-contrib *) + if Sys.file_exists user_contrib then + Mltop.add_rec_path ~unix_path:user_contrib ~coq_root:Nameops.default_root_prefix; + (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME *) + List.iter (fun s -> Mltop.add_rec_path ~unix_path:s ~coq_root:Nameops.default_root_prefix) xdg_dirs; + (* then directories in COQPATH *) + List.iter (fun s -> Mltop.add_rec_path ~unix_path:s ~coq_root:Nameops.default_root_prefix) coqpath; (* then current directory *) - Mltop.add_path "." Nameops.default_root_prefix; + Mltop.add_path ~unix_path:"." ~coq_root:Nameops.default_root_prefix; (* additional loadpath, given with -I -include -R options *) List.iter - (fun (s,alias,reci) -> - if reci then Mltop.add_rec_path s alias else Mltop.add_path s alias) + (fun (unix_path, coq_root, reci) -> + if reci then Mltop.add_rec_path ~unix_path ~coq_root else Mltop.add_path ~unix_path ~coq_root) (List.rev !includes) let init_library_roots () = @@ -117,9 +127,8 @@ let init_library_roots () = (* Initialises the Ocaml toplevel before launching it, so that it can find the "include" file in the *source* directory *) let init_ocaml_path () = - let coqsrc = Coq_config.coqsrc in let add_subdir dl = - Mltop.add_ml_dir (List.fold_left (/) coqsrc dl) + Mltop.add_ml_dir (List.fold_left (/) Envars.coqroot dl) in Mltop.add_ml_dir (Envars.coqlib ()); List.iter add_subdir diff --git a/toplevel/coqinit.mli b/toplevel/coqinit.mli index c0f59a56..43b1556d 100644 --- a/toplevel/coqinit.mli +++ b/toplevel/coqinit.mli @@ -1,19 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit val set_rcfile : string -> unit -val set_rcuser : string -> unit val no_load_rc : unit -> unit val load_rcfile : unit -> unit diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml index 7887a060..76e9c2fe 100644 --- a/toplevel/coqtop.ml +++ b/toplevel/coqtop.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* compat_version := Some V8_3 | "8.2" -> compat_version := Some V8_2 | "8.1" -> warning "Compatibility with version 8.1 not supported." | "8.0" -> warning "Compatibility with version 8.0 not supported." | s -> error ("Unknown compatibility version \""^s^"\".") -let re_exec_version = ref "" -let set_byte () = re_exec_version := "byte" -let set_opt () = re_exec_version := "opt" - -(* Re-exec Coq in bytecode or native code if necessary. [s] is either - ["byte"] or ["opt"]. Notice that this is possible since the nature of - the toplevel has already been set in [Mltop] by the main file created - by coqmktop (see scripts/coqmktop.ml). *) - -let re_exec is_ide = - let s = !re_exec_version in - let is_native = Mltop.is_native in - (* Unix.readlink is not implemented on Windows architectures :-( - let prog = - try Unix.readlink "/proc/self/exe" - with Unix.Unix_error _ -> Sys.argv.(0) in - *) - let prog = Sys.argv.(0) in - if (is_native && s = "byte") || ((not is_native) && s = "opt") - then begin - let s = if s = "" then if is_native then "opt" else "byte" else s in - let newprog = - let dir = Filename.dirname prog in - let coqtop = if is_ide then "coqide." else "coqtop." in - let com = coqtop ^ s ^ Coq_config.exec_extension in - if dir <> "." then Filename.concat dir com else com - in - Sys.argv.(0) <- newprog; - Unix.handle_unix_error (Unix.execvp newprog) Sys.argv - end - (*s options for the virtual machine *) let boxed_val = ref false -let boxed_def = ref false let use_vm = ref false let set_vm_opt () = Vm.set_transp_values (not !boxed_val); - Flags.set_boxed_definitions !boxed_def; Vconv.set_use_vm !use_vm (*s Parsing of the command line. @@ -183,12 +149,13 @@ let usage () = let warning s = msg_warning (str s) +let ide_slave = ref false +let filter_opts = ref false -let ide_args = ref [] -let parse_args is_ide = +let parse_args arglist = let glob_opt = ref false in let rec parse = function - | [] -> () + | [] -> [] | "-with-geoproof" :: s :: rem -> if s = "yes" then Coq_config.with_geoproof := true else if s = "no" then Coq_config.with_geoproof := false @@ -216,14 +183,15 @@ let parse_args is_ide = | "-notop" :: rem -> unset_toplevel_name (); parse rem | "-q" :: rem -> no_load_rc (); parse rem - | "-opt" :: rem -> set_opt(); parse rem - | "-byte" :: rem -> set_byte(); parse rem + | "-opt" :: rem -> warning "option -opt deprecated, call with .opt suffix\n"; parse rem + | "-byte" :: rem -> warning "option -byte deprecated, call with .byte suffix\n"; parse rem | "-full" :: rem -> warning "option -full deprecated\n"; parse rem | "-batch" :: rem -> set_batch_mode (); parse rem | "-boot" :: rem -> boot := true; no_load_rc (); parse rem | "-quality" :: rem -> term_quality := true; no_load_rc (); parse rem - | "-outputstate" :: s :: rem -> set_outputstate s; parse rem + | "-outputstate" :: s :: rem -> + Flags.load_proofs := Flags.Force; set_outputstate s; parse rem | "-outputstate" :: [] -> usage () | "-nois" :: rem -> set_inputstate ""; parse rem @@ -264,7 +232,9 @@ let parse_args is_ide = | "-compile-verbose" :: f :: rem -> add_compile true f; if not !glob_opt then Dumpglob.dump_to_dotglob (); parse rem | "-compile-verbose" :: [] -> usage () - | "-dont-load-proofs" :: rem -> Flags.dont_load_proofs := true; parse rem + | "-force-load-proofs" :: rem -> Flags.load_proofs := Flags.Force; parse rem + | "-lazy-load-proofs" :: rem -> Flags.load_proofs := Flags.Lazy; parse rem + | "-dont-load-proofs" :: rem -> Flags.load_proofs := Flags.Dont; parse rem | "-beautify" :: rem -> make_beautify true; parse rem @@ -278,30 +248,28 @@ let parse_args is_ide = | "-vm" :: rem -> use_vm := true; parse rem | "-emacs" :: rem -> Flags.print_emacs := true; Pp.make_pp_emacs(); parse rem - | "-emacs-U" :: rem -> Flags.print_emacs := true; - Flags.print_emacs_safechar := true; Pp.make_pp_emacs(); parse rem + | "-emacs-U" :: rem -> + warning "Obsolete option \"-emacs-U\", use -emacs instead."; + Flags.print_emacs := true; Pp.make_pp_emacs(); parse rem | "-unicode" :: rem -> add_require "Utf8_core"; parse rem | "-coqlib" :: d :: rem -> Flags.coqlib_spec:=true; Flags.coqlib:=d; parse rem | "-coqlib" :: [] -> usage () - | "-where" :: _ -> print_endline (Envars.coqlib ()); exit 0 + | "-where" :: _ -> print_endline (Envars.coqlib ()); exit (if !filter_opts then 2 else 0) - | ("-config"|"--config") :: _ -> Usage.print_config (); exit 0 + | ("-config"|"--config") :: _ -> Usage.print_config (); exit (if !filter_opts then 2 else 0) | ("-quiet"|"-silent") :: rem -> Flags.make_silent true; parse rem | ("-?"|"-h"|"-H"|"-help"|"--help") :: _ -> usage () - | ("-v"|"--version") :: _ -> Usage.version () + | ("-v"|"--version") :: _ -> Usage.version (if !filter_opts then 2 else 0) | "-init-file" :: f :: rem -> set_rcfile f; parse rem | "-init-file" :: [] -> usage () - | "-user" :: u :: rem -> set_rcuser u; parse rem - | "-user" :: [] -> usage () - | "-notactics" :: rem -> warning "Obsolete option \"-notactics\"."; remove_top_ml (); parse rem @@ -320,32 +288,41 @@ let parse_args is_ide = | "-no-hash-consing" :: rem -> Flags.hash_cons_proofs := false; parse rem + | "-ideslave" :: rem -> ide_slave := true; parse rem + + | "-filteropts" :: rem -> filter_opts := true; parse rem + | s :: rem -> - if is_ide then begin - ide_args := s :: !ide_args; - parse rem - end else begin - prerr_endline ("Don't know what to do with " ^ s); usage () - end + if !filter_opts then + s :: (parse rem) + else + (prerr_endline ("Don't know what to do with " ^ s); usage ()) in try - parse (List.tl (Array.to_list Sys.argv)) + parse arglist with | UserError(_,s) as e -> begin try Stream.empty s; exit 1 with Stream.Failure -> - msgnl (Cerrors.explain_exn e); exit 1 + msgnl (Errors.print e); exit 1 end - | e -> begin msgnl (Cerrors.explain_exn e); exit 1 end + | e -> begin msgnl (Errors.print e); exit 1 end -let init is_ide = +let init arglist = Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *) Lib.init(); + (* Default Proofb Mode starts with an alternative default. *) + Goptions.set_string_option_value ["Default";"Proof";"Mode"] "Classic"; begin try - parse_args is_ide; - re_exec is_ide; + let foreign_args = parse_args arglist in + if !filter_opts then + (print_string (String.concat "\n" foreign_args); exit 0); + if !ide_slave then begin + Flags.make_silent true; + Ide_slave.init_stdout () + end; if_verbose print_header (); init_load_path (); inputstate (); @@ -374,13 +351,14 @@ let init is_ide = exit 0); Lib.declare_initial_state () -let init_toplevel () = init false - -let init_ide () = init true; List.rev !ide_args +let init_toplevel = init let start () = - init_toplevel (); - Toplevel.loop(); + init_toplevel (List.tl (Array.to_list Sys.argv)); + if !ide_slave then + Ide_slave.loop () + else + Toplevel.loop(); (* Initialise and launch the Ocaml toplevel *) Coqinit.init_ocaml_path(); Mltop.ocaml_toploop(); diff --git a/toplevel/coqtop.mli b/toplevel/coqtop.mli index ef730915..16d2b874 100644 --- a/toplevel/coqtop.mli +++ b/toplevel/coqtop.mli @@ -1,23 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit - -(* [init_ide] is to be used by the Coq IDE. - It does everything [start] does, except launching the toplevel loop. - It returns the list of Coq files given on the command line. *) - -val init_ide : unit -> string list +val init_toplevel : string list -> unit +val start : unit -> unit diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml index 58122e11..bab711ea 100644 --- a/toplevel/discharge.ml +++ b/toplevel/discharge.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* str "Recursive definition on" ++ spc () ++ pr_lconstr_env env c ++ spc () ++ str "which should be an inductive type" - | RecursionOnIllegalTerm(j,arg,le,lt) -> + | RecursionOnIllegalTerm(j,(arg_env, arg),le,lt) -> + let arg_env = make_all_name_different arg_env in let called = match names.(j) with Name id -> pr_id id @@ -247,7 +262,7 @@ let explain_ill_formed_rec_body env err names i fixenv vdefj = prlist_with_sep pr_spc pr_db lt in str "Recursive call to " ++ called ++ spc () ++ strbrk "has principal argument equal to" ++ spc () ++ - pr_lconstr_env env arg ++ strbrk " instead of " ++ vars + pr_lconstr_env arg_env arg ++ strbrk " instead of " ++ vars | NotEnoughArgumentsForFixCall j -> let called = @@ -274,12 +289,12 @@ let explain_ill_formed_rec_body env err names i fixenv vdefj = str "Recursive call forbidden in the type of a recursive definition" ++ spc () ++ pr_lconstr_env env c | RecCallInCaseFun c -> - str "Recursive call in a branch of" ++ spc () ++ pr_lconstr_env env c + str "Invalid recursive call in a branch of" ++ spc () ++ pr_lconstr_env env c | RecCallInCaseArg c -> - str "Recursive call in the argument of cases in" ++ spc () ++ + str "Invalid recursive call in the argument of \"match\" in" ++ spc () ++ pr_lconstr_env env c | RecCallInCasePred c -> - str "Recursive call in the type of cases in" ++ spc () ++ + str "Invalid recursive call in the \"return\" clause of \"match\" in" ++ spc () ++ pr_lconstr_env env c | NotGuardedForm c -> str "Sub-expression " ++ pr_lconstr_env env c ++ @@ -295,7 +310,9 @@ let explain_ill_formed_rec_body env err names i fixenv vdefj = str"Recursive definition is:" ++ spc () ++ pvd ++ str "." with _ -> mt ()) -let explain_ill_typed_rec_body env i names vdefj vargs = +let explain_ill_typed_rec_body env sigma i names vdefj vargs = + let vdefj = jv_nf_evar sigma vdefj in + let vargs = Array.map (nf_evar sigma) vargs in let env = make_all_name_different env in let pvd,pvdt = pr_ljudge_env env (vdefj.(i)) in let pv = pr_lconstr_env env vargs.(i) in @@ -305,12 +322,14 @@ let explain_ill_typed_rec_body env i names vdefj vargs = str "has type" ++ spc () ++ pvdt ++ spc () ++ str "while it should be" ++ spc () ++ pv ++ str "." -let explain_cant_find_case_type env c = +let explain_cant_find_case_type env sigma c = + let c = nf_evar sigma c in let env = make_all_name_different env in let pe = pr_lconstr_env env c in str "Cannot infer type of pattern-matching on" ++ ws 1 ++ pe ++ str "." -let explain_occur_check env ev rhs = +let explain_occur_check env sigma ev rhs = + let rhs = nf_evar sigma rhs in let env = make_all_name_different env in let id = Evd.string_of_existential ev in let pt = pr_lconstr_env env rhs in @@ -354,7 +373,8 @@ let explain_hole_kind env evi = function | MatchingVar _ -> assert false -let explain_not_clean env ev t k = +let explain_not_clean env sigma ev t k = + let t = nf_evar sigma t in let env = make_all_name_different env in let id = Evd.string_of_existential ev in let var = pr_lconstr_env env t in @@ -401,13 +421,15 @@ let explain_wrong_case_info env ind ci = str "was given to a pattern-matching expression on the inductive type" ++ spc () ++ pc ++ str "." -let explain_cannot_unify env m n = +let explain_cannot_unify env sigma m n = + let m = nf_evar sigma m in + let n = nf_evar sigma n in let pm = pr_lconstr_env env m in let pn = pr_lconstr_env env n in str "Impossible to unify" ++ brk(1,1) ++ pm ++ spc () ++ str "with" ++ brk(1,1) ++ pn ++ str "." -let explain_cannot_unify_local env m n subn = +let explain_cannot_unify_local env sigma m n subn = let pm = pr_lconstr_env env m in let pn = pr_lconstr_env env n in let psubn = pr_lconstr_env env subn in @@ -449,7 +471,7 @@ let explain_non_linear_unification env m t = strbrk " which would require to abstract twice on " ++ pr_lconstr_env env t ++ str "." -let explain_type_error env err = +let explain_type_error env sigma err = let env = make_all_name_different env in match err with | UnboundRel n -> @@ -457,7 +479,7 @@ let explain_type_error env err = | UnboundVar v -> explain_unbound_var env v | NotAType j -> - explain_not_type env j + explain_not_type env sigma j | BadAssumption c -> explain_bad_assumption env c | ReferenceVariables id -> @@ -465,38 +487,39 @@ let explain_type_error env err = | ElimArity (ind, aritylst, c, pj, okinds) -> explain_elim_arity env ind aritylst c pj okinds | CaseNotInductive cj -> - explain_case_not_inductive env cj + explain_case_not_inductive env sigma cj | NumberBranches (cj, n) -> - explain_number_branches env cj n + explain_number_branches env sigma cj n | IllFormedBranch (c, i, actty, expty) -> - explain_ill_formed_branch env c i actty expty + explain_ill_formed_branch env sigma c i actty expty | Generalization (nvar, c) -> explain_generalization env nvar c | ActualType (j, pt) -> - explain_actual_type env j pt + explain_actual_type env sigma j pt | CantApplyBadType (t, rator, randl) -> - explain_cant_apply_bad_type env t rator randl + explain_cant_apply_bad_type env sigma t rator randl | CantApplyNonFunctional (rator, randl) -> - explain_cant_apply_not_functional env rator randl + explain_cant_apply_not_functional env sigma rator randl | IllFormedRecBody (err, lna, i, fixenv, vdefj) -> explain_ill_formed_rec_body env err lna i fixenv vdefj | IllTypedRecBody (i, lna, vdefj, vargs) -> - explain_ill_typed_rec_body env i lna vdefj vargs + explain_ill_typed_rec_body env sigma i lna vdefj vargs | WrongCaseInfo (ind,ci) -> explain_wrong_case_info env ind ci -let explain_pretype_error env err = +let explain_pretype_error env sigma err = + let env = env_nf_betaiotaevar sigma env in let env = make_all_name_different env in match err with - | CantFindCaseType c -> explain_cant_find_case_type env c - | OccurCheck (n,c) -> explain_occur_check env n c - | NotClean (n,c,k) -> explain_not_clean env n c k + | CantFindCaseType c -> explain_cant_find_case_type env sigma c + | OccurCheck (n,c) -> explain_occur_check env sigma n c + | NotClean (n,c,k) -> explain_not_clean env sigma n c k | UnsolvableImplicit (evi,k,exp) -> explain_unsolvable_implicit env evi k exp | VarNotFound id -> explain_var_not_found env id - | UnexpectedType (actual,expect) -> explain_unexpected_type env actual expect - | NotProduct c -> explain_not_product env c - | CannotUnify (m,n) -> explain_cannot_unify env m n - | CannotUnifyLocal (m,n,sn) -> explain_cannot_unify_local env m n sn + | UnexpectedType (actual,expect) -> explain_unexpected_type env sigma actual expect + | NotProduct c -> explain_not_product env sigma c + | CannotUnify (m,n) -> explain_cannot_unify env sigma m n + | CannotUnifyLocal (m,n,sn) -> explain_cannot_unify_local env sigma m n sn | CannotGeneralize ty -> explain_refiner_cannot_generalize env ty | NoOccurrenceFound (c, id) -> explain_no_occurrence_found env c id | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type env m n @@ -504,6 +527,155 @@ let explain_pretype_error env err = explain_cannot_find_well_typed_abstraction env p l | AbstractionOverMeta (m,n) -> explain_abstraction_over_meta env m n | NonLinearUnification (m,c) -> explain_non_linear_unification env m c + | TypingError t -> explain_type_error env sigma t + +(* Module errors *) + +open Modops + +let explain_not_match_error = function + | InductiveFieldExpected _ -> + strbrk "an inductive definition is expected" + | DefinitionFieldExpected -> + strbrk "a definition is expected" + | ModuleFieldExpected -> + strbrk "a module is expected" + | ModuleTypeFieldExpected -> + strbrk "a module type is expected" + | NotConvertibleInductiveField id | NotConvertibleConstructorField id -> + str "types given to " ++ str (string_of_id id) ++ str " differ" + | NotConvertibleBodyField -> + str "the body of definitions differs" + | NotConvertibleTypeField -> + str "types differ" + | NotSameConstructorNamesField -> + str "constructor names differ" + | NotSameInductiveNameInBlockField -> + str "inductive types names differ" + | FiniteInductiveFieldExpected isfinite -> + str "type is expected to be " ++ + str (if isfinite then "coinductive" else "inductive") + | InductiveNumbersFieldExpected n -> + str "number of inductive types differs" + | InductiveParamsNumberField n -> + str "inductive type has not the right number of parameters" + | RecordFieldExpected isrecord -> + str "type is expected " ++ str (if isrecord then "" else "not ") ++ + str "to be a record" + | RecordProjectionsExpected nal -> + (if List.length nal >= 2 then str "expected projection names are " + else str "expected projection name is ") ++ + pr_enum (function Name id -> str (string_of_id id) | _ -> str "_") nal + | NotEqualInductiveAliases -> + str "Aliases to inductive types do not match" + | NoTypeConstraintExpected -> + strbrk "a definition whose type is constrained can only be subtype of a definition whose type is itself constrained" + +let explain_signature_mismatch l spec why = + str "Signature components for label " ++ str (string_of_label l) ++ + str " do not match:" ++ spc () ++ explain_not_match_error why ++ str "." + +let explain_label_already_declared l = + str ("The label "^string_of_label l^" is already declared.") + +let explain_application_to_not_path _ = + str "Application of modules is restricted to paths." + +let explain_not_a_functor mtb = + str "Application of not a functor." + +let explain_incompatible_module_types mexpr1 mexpr2 = + str "Incompatible module types." + +let explain_not_equal_module_paths mp1 mp2 = + str "Non equal modules." + +let explain_no_such_label l = + str "No such label " ++ str (string_of_label l) ++ str "." + +let explain_incompatible_labels l l' = + str "Opening and closing labels are not the same: " ++ + str (string_of_label l) ++ str " <> " ++ str (string_of_label l') ++ str "!" + +let explain_signature_expected mtb = + str "Signature expected." + +let explain_no_module_to_end () = + str "No open module to end." + +let explain_no_module_type_to_end () = + str "No open module type to end." + +let explain_not_a_module s = + quote (str s) ++ str " is not a module." + +let explain_not_a_module_type s = + quote (str s) ++ str " is not a module type." + +let explain_not_a_constant l = + quote (pr_label l) ++ str " is not a constant." + +let explain_incorrect_label_constraint l = + str "Incorrect constraint for label " ++ + quote (pr_label l) ++ str "." + +let explain_generative_module_expected l = + str "The module " ++ str (string_of_label l) ++ + strbrk " is not generative. Only components of generative modules can be changed using the \"with\" construct." + +let explain_non_empty_local_context = function + | None -> str "The local context is not empty." + | Some l -> + str "The local context of the component " ++ + str (string_of_label l) ++ str " is not empty." + +let explain_label_missing l s = + str "The field " ++ str (string_of_label l) ++ str " is missing in " + ++ str s ++ str "." + +let explain_module_error = function + | SignatureMismatch (l,spec,err) -> explain_signature_mismatch l spec err + | LabelAlreadyDeclared l -> explain_label_already_declared l + | ApplicationToNotPath mexpr -> explain_application_to_not_path mexpr + | NotAFunctor mtb -> explain_not_a_functor mtb + | IncompatibleModuleTypes (m1,m2) -> explain_incompatible_module_types m1 m2 + | NotEqualModulePaths (mp1,mp2) -> explain_not_equal_module_paths mp1 mp2 + | NoSuchLabel l -> explain_no_such_label l + | IncompatibleLabels (l1,l2) -> explain_incompatible_labels l1 l2 + | SignatureExpected mtb -> explain_signature_expected mtb + | NoModuleToEnd -> explain_no_module_to_end () + | NoModuleTypeToEnd -> explain_no_module_type_to_end () + | NotAModule s -> explain_not_a_module s + | NotAModuleType s -> explain_not_a_module_type s + | NotAConstant l -> explain_not_a_constant l + | IncorrectWithConstraint l -> explain_incorrect_label_constraint l + | GenerativeModuleExpected l -> explain_generative_module_expected l + | NonEmptyLocalContect lopt -> explain_non_empty_local_context lopt + | LabelMissing (l,s) -> explain_label_missing l s + +(* Module internalization errors *) + +(* +let explain_declaration_not_path _ = + str "Declaration is not a path." + +*) + +let explain_not_module_nor_modtype s = + quote (str s) ++ str " is not a module or module type." + +let explain_incorrect_with_in_module () = + str "The syntax \"with\" is not allowed for modules." + +let explain_incorrect_module_application () = + str "Illegal application to a module type." + +open Modintern + +let explain_module_internalization_error = function + | NotAModuleNorModtype s -> explain_not_module_nor_modtype s + | IncorrectWithInModule -> explain_incorrect_with_in_module () + | IncorrectModuleApplication -> explain_incorrect_module_application () (* Typeclass errors *) @@ -525,6 +697,7 @@ let explain_no_instance env (_,id) l = prlist_with_sep pr_spc (pr_lconstr_env env) l let pr_constraints printenv env evm = + let evm = Evd.undefined_evars (Evarutil.nf_evar_map_undefined evm) in let l = Evd.to_list evm in let (ev, evi) = List.hd l in if List.for_all (fun (ev', evi') -> @@ -534,12 +707,14 @@ let pr_constraints printenv env evm = (reset_with_named_context evi.evar_hyps env) in (if printenv then pe ++ fnl () else mt ()) ++ prlist_with_sep (fun () -> fnl ()) - (fun (ev, evi) -> str(string_of_existential ev)++ str " == " ++ pr_constr evi.evar_concl) l + (fun (ev, evi) -> str(string_of_existential ev) ++ + str " : " ++ pr_lconstr evi.evar_concl) l ++ fnl() ++ + pr_evar_map_constraints evm else - pr_evar_map evm + pr_evar_map None evm let explain_unsatisfiable_constraints env evd constr = - let evm = Evarutil.nf_evars evd in + let evm = Evarutil.nf_evar_map evd in let undef = Evd.undefined_evars evm in match constr with | None -> @@ -684,7 +859,7 @@ let error_not_allowed_case_analysis isrec kind i = let error_not_mutual_in_scheme ind ind' = if ind = ind' then str "The inductive type " ++ pr_inductive (Global.env()) ind ++ - str "occurs twice." + str " occurs twice." else str "The inductive types " ++ pr_inductive (Global.env()) ind ++ spc () ++ str "and" ++ spc () ++ pr_inductive (Global.env()) ind' ++ spc () ++ @@ -805,7 +980,7 @@ let explain_reduction_tactic_error = function | Tacred.InvalidAbstraction (env,c,(env',e)) -> str "The abstracted term" ++ spc () ++ pr_lconstr_env_at_top env c ++ spc () ++ str "is not well typed." ++ fnl () ++ - explain_type_error env' e + explain_type_error env' Evd.empty e let explain_ltac_call_trace (nrep,last,trace,loc) = let calls = @@ -831,7 +1006,7 @@ let explain_ltac_call_trace (nrep,last,trace,loc) = let filter = function (id,None) -> None | (id,Some id') -> Some(id,([],mkVar id')) in let unboundvars = list_map_filter filter unboundvars in - quote (pr_rawconstr_env (Global.env()) c) ++ + quote (pr_glob_constr_env (Global.env()) c) ++ (if unboundvars <> [] or vars <> [] then strbrk " (with " ++ prlist_with_sep pr_comma diff --git a/toplevel/himsg.mli b/toplevel/himsg.mli index e12e445c..a763472b 100644 --- a/toplevel/himsg.mli +++ b/toplevel/himsg.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* type_error -> std_ppcmds +val explain_type_error : env -> Evd.evar_map -> type_error -> std_ppcmds -val explain_pretype_error : env -> pretype_error -> std_ppcmds +val explain_pretype_error : env -> Evd.evar_map -> pretype_error -> std_ppcmds val explain_inductive_error : inductive_error -> std_ppcmds @@ -44,3 +40,8 @@ val explain_reduction_tactic_error : val explain_ltac_call_trace : int * Proof_type.ltac_call_kind * Proof_type.ltac_trace * Util.loc -> std_ppcmds + +val explain_module_error : Modops.module_typing_error -> std_ppcmds + +val explain_module_internalization_error : + Modintern.module_internalization_error -> std_ppcmds diff --git a/toplevel/ide_intf.ml b/toplevel/ide_intf.ml new file mode 100644 index 00000000..fc8ffa25 --- /dev/null +++ b/toplevel/ide_intf.ml @@ -0,0 +1,434 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* Obj.magic (handler.interp (r,b,s) : string) + | Rewind i -> Obj.magic (handler.rewind i : int) + | Goal -> Obj.magic (handler.goals () : goals option) + | Evars -> Obj.magic (handler.evars () : evar list option) + | Hints -> Obj.magic (handler.hints () : (hint list * hint) option) + | Status -> Obj.magic (handler.status () : status) + | GetOptions -> Obj.magic (handler.get_options () : (option_name * option_state) list) + | SetOptions opts -> Obj.magic (handler.set_options opts : unit) + | InLoadPath s -> Obj.magic (handler.inloadpath s : bool) + | MkCases s -> Obj.magic (handler.mkcases s : string list list) + in Good res + with e -> + let (l, str) = handler.handle_exn e in + Fail (l,str) + +(** * XML data marshalling *) + +exception Marshal_error + +(** Utility functions *) + +let massoc x l = + try List.assoc x l + with Not_found -> raise Marshal_error + +let constructor t c args = Element (t, ["val", c], args) + +let do_match constr t mf = match constr with +| Element (s, attrs, args) -> + if s = t then + let c = massoc "val" attrs in + mf c args + else raise Marshal_error +| _ -> raise Marshal_error + +let pcdata = function +| PCData s -> s +| _ -> raise Marshal_error + +let singleton = function +| [x] -> x +| _ -> raise Marshal_error + +let raw_string = function +| [] -> "" +| [PCData s] -> s +| _ -> raise Marshal_error + +let bool_arg tag b = if b then [tag, ""] else [] + +(** Base types *) + +let of_bool b = + if b then constructor "bool" "true" [] + else constructor "bool" "false" [] + +let to_bool xml = do_match xml "bool" + (fun s _ -> match s with + | "true" -> true + | "false" -> false + | _ -> raise Marshal_error) + +let of_list f l = + Element ("list", [], List.map f l) + +let to_list f = function +| Element ("list", [], l) -> + List.map f l +| _ -> raise Marshal_error + +let of_option f = function +| None -> Element ("option", ["val", "none"], []) +| Some x -> Element ("option", ["val", "some"], [f x]) + +let to_option f = function +| Element ("option", ["val", "none"], []) -> None +| Element ("option", ["val", "some"], [x]) -> Some (f x) +| _ -> raise Marshal_error + +let of_string s = Element ("string", [], [PCData s]) + +let to_string = function +| Element ("string", [], l) -> raw_string l +| _ -> raise Marshal_error + +let of_int i = Element ("int", [], [PCData (string_of_int i)]) + +let to_int = function +| Element ("int", [], [PCData s]) -> int_of_string s +| _ -> raise Marshal_error + +let of_pair f g (x, y) = Element ("pair", [], [f x; g y]) + +let to_pair f g = function +| Element ("pair", [], [x; y]) -> (f x, g y) +| _ -> raise Marshal_error + +(** More elaborate types *) + +let of_option_value = function +| IntValue i -> + constructor "option_value" "intvalue" [of_option of_int i] +| BoolValue b -> + constructor "option_value" "boolvalue" [of_bool b] +| StringValue s -> + constructor "option_value" "stringvalue" [of_string s] + +let to_option_value xml = do_match xml "option_value" + (fun s args -> match s with + | "intvalue" -> IntValue (to_option to_int (singleton args)) + | "boolvalue" -> BoolValue (to_bool (singleton args)) + | "stringvalue" -> StringValue (to_string (singleton args)) + | _ -> raise Marshal_error + ) + +let of_option_state s = + Element ("option_state", [], [ + of_bool s.opt_sync; + of_bool s.opt_depr; + of_string s.opt_name; + of_option_value s.opt_value] + ) + +let to_option_state = function +| Element ("option_state", [], [sync; depr; name; value]) -> + { + opt_sync = to_bool sync; + opt_depr = to_bool depr; + opt_name = to_string name; + opt_value = to_option_value value; + } +| _ -> raise Marshal_error + +let of_value f = function +| Good x -> Element ("value", ["val", "good"], [f x]) +| Fail (loc, msg) -> + let loc = match loc with + | None -> [] + | Some (s, e) -> [("loc_s", string_of_int s); ("loc_e", string_of_int e)] + in + Element ("value", ["val", "fail"] @ loc, [PCData msg]) + +let to_value f = function +| Element ("value", attrs, l) -> + let ans = massoc "val" attrs in + if ans = "good" then Good (f (singleton l)) + else if ans = "fail" then + let loc = + try + let loc_s = int_of_string (List.assoc "loc_s" attrs) in + let loc_e = int_of_string (List.assoc "loc_e" attrs) in + Some (loc_s, loc_e) + with _ -> None + in + let msg = raw_string l in + Fail (loc, msg) + else raise Marshal_error +| _ -> raise Marshal_error + +let of_call = function +| Interp (raw, vrb, cmd) -> + let flags = (bool_arg "raw" raw) @ (bool_arg "verbose" vrb) in + Element ("call", ("val", "interp") :: flags, [PCData cmd]) +| Rewind n -> + Element ("call", ("val", "rewind") :: ["steps", string_of_int n], []) +| Goal -> + Element ("call", ["val", "goal"], []) +| Evars -> + Element ("call", ["val", "evars"], []) +| Hints -> + Element ("call", ["val", "hints"], []) +| Status -> + Element ("call", ["val", "status"], []) +| GetOptions -> + Element ("call", ["val", "getoptions"], []) +| SetOptions opts -> + let args = List.map (of_pair (of_list of_string) of_option_value) opts in + Element ("call", ["val", "setoptions"], args) +| InLoadPath file -> + Element ("call", ["val", "inloadpath"], [PCData file]) +| MkCases ind -> + Element ("call", ["val", "mkcases"], [PCData ind]) + +let to_call = function +| Element ("call", attrs, l) -> + let ans = massoc "val" attrs in + begin match ans with + | "interp" -> + let raw = List.mem_assoc "raw" attrs in + let vrb = List.mem_assoc "verbose" attrs in + Interp (raw, vrb, raw_string l) + | "rewind" -> + let steps = int_of_string (massoc "steps" attrs) in + Rewind steps + | "goal" -> Goal + | "evars" -> Evars + | "status" -> Status + | "getoptions" -> GetOptions + | "setoptions" -> + let args = List.map (to_pair (to_list to_string) to_option_value) l in + SetOptions args + | "inloadpath" -> InLoadPath (raw_string l) + | "mkcases" -> MkCases (raw_string l) + | "hints" -> Hints + | _ -> raise Marshal_error + end +| _ -> raise Marshal_error + +let of_status s = + let of_so = of_option of_string in + Element ("status", [], [of_so s.status_path; of_so s.status_proofname]) + +let to_status = function +| Element ("status", [], [path; name]) -> + { + status_path = to_option to_string path; + status_proofname = to_option to_string name; + } +| _ -> raise Marshal_error + +let of_evar s = + Element ("evar", [], [PCData s.evar_info]) + +let to_evar = function +| Element ("evar", [], data) -> { evar_info = raw_string data; } +| _ -> raise Marshal_error + +let of_goal g = + let hyp = of_list of_string g.goal_hyp in + let ccl = of_string g.goal_ccl in + Element ("goal", [], [hyp; ccl]) + +let to_goal = function +| Element ("goal", [], [hyp; ccl]) -> + let hyp = to_list to_string hyp in + let ccl = to_string ccl in + { goal_hyp = hyp; goal_ccl = ccl } +| _ -> raise Marshal_error + +let of_goals g = + let fg = of_list of_goal g.fg_goals in + let bg = of_list of_goal g.bg_goals in + Element ("goals", [], [fg; bg]) + +let to_goals = function +| Element ("goals", [], [fg; bg]) -> + let fg = to_list to_goal fg in + let bg = to_list to_goal bg in + { fg_goals = fg; bg_goals = bg; } +| _ -> raise Marshal_error + +let of_hints = + let of_hint = of_list (of_pair of_string of_string) in + of_option (of_pair (of_list of_hint) of_hint) + +let of_answer (q : 'a call) (r : 'a value) = + let convert = match q with + | Interp _ -> Obj.magic (of_string : string -> xml) + | Rewind _ -> Obj.magic (of_int : int -> xml) + | Goal -> Obj.magic (of_option of_goals : goals option -> xml) + | Evars -> Obj.magic (of_option (of_list of_evar) : evar list option -> xml) + | Hints -> Obj.magic (of_hints : (hint list * hint) option -> xml) + | Status -> Obj.magic (of_status : status -> xml) + | GetOptions -> Obj.magic (of_list (of_pair (of_list of_string) of_option_state) : (option_name * option_state) list -> xml) + | SetOptions _ -> Obj.magic (fun _ -> Element ("unit", [], [])) + | InLoadPath _ -> Obj.magic (of_bool : bool -> xml) + | MkCases _ -> Obj.magic (of_list (of_list of_string) : string list list -> xml) + in + of_value convert r + +let to_answer xml = + let rec convert elt = match elt with + | Element (tpe, attrs, l) -> + begin match tpe with + | "unit" -> Obj.magic () + | "string" -> Obj.magic (to_string elt : string) + | "int" -> Obj.magic (to_int elt : int) + | "status" -> Obj.magic (to_status elt : status) + | "bool" -> Obj.magic (to_bool elt : bool) + | "list" -> Obj.magic (to_list convert elt : 'a list) + | "option" -> Obj.magic (to_option convert elt : 'a option) + | "pair" -> Obj.magic (to_pair convert convert elt : ('a * 'b)) + | "goals" -> Obj.magic (to_goals elt : goals) + | "evar" -> Obj.magic (to_evar elt : evar) + | "option_value" -> Obj.magic (to_option_value elt : option_value) + | "option_state" -> Obj.magic (to_option_state elt : option_state) + | _ -> raise Marshal_error + end + | _ -> raise Marshal_error + in + to_value convert xml + +(** * Debug printing *) + +let pr_option_value = function +| IntValue None -> "none" +| IntValue (Some i) -> string_of_int i +| StringValue s -> s +| BoolValue b -> if b then "true" else "false" + +let rec pr_setoptions opts = + let map (key, v) = + let key = String.concat " " key in + key ^ " := " ^ (pr_option_value v) + in + String.concat "; " (List.map map opts) + +let pr_getoptions opts = + let map (key, s) = + let key = String.concat " " key in + Printf.sprintf "%s: sync := %b; depr := %b; name := %s; value := %s\n" + key s.opt_sync s.opt_depr s.opt_name (pr_option_value s.opt_value) + in + "\n" ^ String.concat "" (List.map map opts) + +let pr_call = function + | Interp (r,b,s) -> + let raw = if r then "RAW" else "" in + let verb = if b then "" else "SILENT" in + "INTERP"^raw^verb^" ["^s^"]" + | Rewind i -> "REWIND "^(string_of_int i) + | Goal -> "GOALS" + | Evars -> "EVARS" + | Hints -> "HINTS" + | Status -> "STATUS" + | GetOptions -> "GETOPTIONS" + | SetOptions l -> "SETOPTIONS" ^ " [" ^ pr_setoptions l ^ "]" + | InLoadPath s -> "INLOADPATH "^s + | MkCases s -> "MKCASES "^s + +let pr_value_gen pr = function + | Good v -> "GOOD " ^ pr v + | Fail (_,str) -> "FAIL ["^str^"]" + +let pr_value v = pr_value_gen (fun _ -> "") v + +let pr_string s = "["^s^"]" +let pr_bool b = if b then "true" else "false" + +let pr_status s = + let path = match s.status_path with + | None -> "no path; " + | Some p -> "path = " ^ p ^ "; " + in + let name = match s.status_proofname with + | None -> "no proof;" + | Some n -> "proof = " ^ n ^ ";" + in + "Status: " ^ path ^ name + +let pr_mkcases l = + let l = List.map (String.concat " ") l in + "[" ^ String.concat " | " l ^ "]" + +let pr_goals_aux g = + if g.fg_goals = [] then + if g.bg_goals = [] then "Proof completed." + else Printf.sprintf "Still %i unfocused goals." (List.length g.bg_goals) + else + let pr_menu s = s in + let pr_goal { goal_hyp = hyps; goal_ccl = goal } = + "[" ^ String.concat "; " (List.map pr_menu hyps) ^ " |- " ^ pr_menu goal ^ "]" + in + String.concat " " (List.map pr_goal g.fg_goals) + +let pr_goals = function +| None -> "No proof in progress." +| Some g -> pr_goals_aux g + +let pr_evar ev = "[" ^ ev.evar_info ^ "]" + +let pr_evars = function +| None -> "No proof in progress." +| Some evars -> String.concat " " (List.map pr_evar evars) + +let pr_full_value call value = + match call with + | Interp _ -> pr_value_gen pr_string (Obj.magic value : string value) + | Rewind i -> pr_value_gen string_of_int (Obj.magic value : int value) + | Goal -> pr_value_gen pr_goals (Obj.magic value : goals option value) + | Evars -> pr_value_gen pr_evars (Obj.magic value : evar list option value) + | Hints -> pr_value value + | Status -> pr_value_gen pr_status (Obj.magic value : status value) + | GetOptions -> pr_value_gen pr_getoptions (Obj.magic value : (option_name * option_state) list value) + | SetOptions _ -> pr_value value + | InLoadPath s -> pr_value_gen pr_bool (Obj.magic value : bool value) + | MkCases s -> pr_value_gen pr_mkcases (Obj.magic value : string list list value) diff --git a/toplevel/ide_intf.mli b/toplevel/ide_intf.mli new file mode 100644 index 00000000..69204da1 --- /dev/null +++ b/toplevel/ide_intf.mli @@ -0,0 +1,87 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* string call + +(** Backtracking by at least a certain number of phrases. + No finished proofs will be re-opened. Instead, + we continue backtracking until before these proofs, + and answer the amount of extra backtracking performed. + Backtracking by more than the number of phrases already + interpreted successfully (and not yet undone) will fail. *) +val rewind : int -> int call + +(** Fetching the list of current goals. Return [None] if no proof is in + progress, [Some gl] otherwise. *) +val goals : goals option call + +(** Retrieving the tactics applicable to the current goal. [None] if there is + no proof in progress. *) +val hints : (hint list * hint) option call + +(** The status, for instance "Ready in SomeSection, proving Foo" *) +val status : status call + +(** Is a directory part of Coq's loadpath ? *) +val inloadpath : string -> bool call + +(** Create a "match" template for a given inductive type. + For each branch of the match, we list the constructor name + followed by enough pattern variables. *) +val mkcases : string -> string list list call + +(** Retrieve the list of unintantiated evars in the current proof. [None] if no + proof is in progress. *) +val evars : evar list option call + +(** Retrieve the list of options of the current toplevel, together with their + state. *) +val get_options : (option_name * option_state) list call + +(** Set the options to the given value. Warning: this is not atomic, so whenever + the call fails, the option state can be messed up... This is the caller duty + to check that everything is correct. *) +val set_options : (option_name * option_value) list -> unit call + +val abstract_eval_call : handler -> 'a call -> 'a value + +(** * XML data marshalling *) + +exception Marshal_error + +val of_value : ('a -> xml) -> 'a value -> xml +val to_value : (xml -> 'a) -> xml -> 'a value + +val of_call : 'a call -> xml +val to_call : xml -> 'a call + +val of_answer : 'a call -> 'a value -> xml +val to_answer : xml -> 'a value + +(** * Debug printing *) + +val pr_call : 'a call -> string +val pr_value : 'a value -> string +val pr_full_value : 'a call -> 'a value -> string diff --git a/toplevel/ide_slave.ml b/toplevel/ide_slave.ml new file mode 100644 index 00000000..42ecb75b --- /dev/null +++ b/toplevel/ide_slave.ml @@ -0,0 +1,579 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* + flush_all (); + orig_stdout := Unix.out_channel_of_descr (Unix.dup Unix.stdout); + Unix.dup2 Unix.stderr Unix.stdout; + Pp_control.std_ft := out_ft; + Pp_control.err_ft := out_ft; + Pp_control.deep_ft := deep_out_ft; + set_binary_mode_out !orig_stdout true; + set_binary_mode_in stdin true; + ), + (fun () -> Format.pp_print_flush out_ft (); + let r = Buffer.contents out_buff in + Buffer.clear out_buff; r) + + +(** Categories of commands *) + +let coqide_known_option table = List.mem table [ + ["Printing";"Implicit"]; + ["Printing";"Coercions"]; + ["Printing";"Matching"]; + ["Printing";"Synth"]; + ["Printing";"Notations"]; + ["Printing";"All"]; + ["Printing";"Records"]; + ["Printing";"Existential";"Instances"]; + ["Printing";"Universes"]] + +type command_attribute = + NavigationCommand | QueryCommand | DebugCommand | KnownOptionCommand + | OtherStatePreservingCommand | GoalStartingCommand | SolveCommand + | ProofEndingCommand + +let rec attribute_of_vernac_command = function + (* Control *) + | VernacTime com -> attribute_of_vernac_command com + | VernacTimeout(_,com) -> attribute_of_vernac_command com + | VernacFail com -> attribute_of_vernac_command com + | VernacList _ -> [] (* unsupported *) + | VernacLoad _ -> [] + + (* Syntax *) + | VernacTacticNotation _ -> [] + | VernacSyntaxExtension _ -> [] + | VernacDelimiters _ -> [] + | VernacBindScope _ -> [] + | VernacOpenCloseScope _ -> [] + | VernacArgumentsScope _ -> [] + | VernacInfix _ -> [] + | VernacNotation _ -> [] + + (* Gallina *) + | VernacDefinition (_,_,DefineBody _,_) -> [] + | VernacDefinition (_,_,ProveBody _,_) -> [GoalStartingCommand] + | VernacStartTheoremProof _ -> [GoalStartingCommand] + | VernacEndProof _ -> [ProofEndingCommand] + | VernacExactProof _ -> [ProofEndingCommand] + + | VernacAssumption _ -> [] + | VernacInductive _ -> [] + | VernacFixpoint _ -> [] + | VernacCoFixpoint _ -> [] + | VernacScheme _ -> [] + | VernacCombinedScheme _ -> [] + + (* Modules *) + | VernacDeclareModule _ -> [] + | VernacDefineModule _ -> [] + | VernacDeclareModuleType _ -> [] + | VernacInclude _ -> [] + + (* Gallina extensions *) + | VernacBeginSection _ -> [] + | VernacEndSegment _ -> [] + | VernacRequire _ -> [] + | VernacImport _ -> [] + | VernacCanonical _ -> [] + | VernacCoercion _ -> [] + | VernacIdentityCoercion _ -> [] + + (* Type classes *) + | VernacInstance _ -> [] + | VernacContext _ -> [] + | VernacDeclareInstances _ -> [] + | VernacDeclareClass _ -> [] + + (* Solving *) + | VernacSolve _ -> [SolveCommand] + | VernacSolveExistential _ -> [SolveCommand] + + (* Auxiliary file and library management *) + | VernacRequireFrom _ -> [] + | VernacAddLoadPath _ -> [] + | VernacRemoveLoadPath _ -> [] + | VernacAddMLPath _ -> [] + | VernacDeclareMLModule _ -> [] + | VernacChdir o -> + (* TODO: [Chdir d] is currently not undo-able (not stored in coq state). + But if we register [Chdir] in the state, loading [initial.coq] will + wrongly cd to the compile-time directory at each coqtop launch. *) + if o = None then [QueryCommand] else [] + + (* State management *) + | VernacWriteState _ -> [] + | VernacRestoreState _ -> [] + + (* Resetting *) + | VernacRemoveName _ -> [NavigationCommand] + | VernacResetName _ -> [NavigationCommand] + | VernacResetInitial -> [NavigationCommand] + | VernacBack _ -> [NavigationCommand] + | VernacBackTo _ -> [NavigationCommand] + + (* Commands *) + | VernacDeclareTacticDefinition _ -> [] + | VernacCreateHintDb _ -> [] + | VernacRemoveHints _ -> [] + | VernacHints _ -> [] + | VernacSyntacticDefinition _ -> [] + | VernacDeclareImplicits _ -> [] + | VernacArguments _ -> [] + | VernacDeclareReduction _ -> [] + | VernacReserve _ -> [] + | VernacGeneralizable _ -> [] + | VernacSetOpacity _ -> [] + | VernacSetOption (_,["Ltac";"Debug"], _) -> [DebugCommand] + | VernacSetOption (_,o,BoolValue true) | VernacUnsetOption (_,o) -> + if coqide_known_option o then [KnownOptionCommand] else [] + | VernacSetOption _ -> [] + | VernacRemoveOption _ -> [] + | VernacAddOption _ -> [] + | VernacMemOption _ -> [QueryCommand] + + | VernacPrintOption _ -> [QueryCommand] + | VernacCheckMayEval _ -> [QueryCommand] + | VernacGlobalCheck _ -> [QueryCommand] + | VernacPrint _ -> [QueryCommand] + | VernacSearch _ -> [QueryCommand] + | VernacLocate _ -> [QueryCommand] + + | VernacComments _ -> [OtherStatePreservingCommand] + | VernacNop -> [OtherStatePreservingCommand] + + (* Proof management *) + | VernacGoal _ -> [GoalStartingCommand] + + | VernacAbort _ -> [] + | VernacAbortAll -> [NavigationCommand] + | VernacRestart -> [NavigationCommand] + | VernacSuspend -> [NavigationCommand] + | VernacResume _ -> [NavigationCommand] + | VernacUndo _ -> [NavigationCommand] + | VernacUndoTo _ -> [NavigationCommand] + | VernacBacktrack _ -> [NavigationCommand] + + | VernacFocus _ -> [SolveCommand] + | VernacUnfocus -> [SolveCommand] + | VernacShow _ -> [OtherStatePreservingCommand] + | VernacCheckGuard -> [OtherStatePreservingCommand] + | VernacProof (None, None) -> [OtherStatePreservingCommand] + | VernacProof _ -> [] + + | VernacProofMode _ -> [] + | VernacBullet _ -> [SolveCommand] + | VernacSubproof _ -> [SolveCommand] + | VernacEndSubproof -> [SolveCommand] + + (* Toplevel control *) + | VernacToplevelControl _ -> [] + + (* Extensions *) + | VernacExtend ("Subtac_Obligations", _) -> [GoalStartingCommand] + | VernacExtend _ -> [] + +let is_vernac_navigation_command com = + List.mem NavigationCommand (attribute_of_vernac_command com) + +let is_vernac_query_command com = + List.mem QueryCommand (attribute_of_vernac_command com) + +let is_vernac_known_option_command com = + List.mem KnownOptionCommand (attribute_of_vernac_command com) + +let is_vernac_debug_command com = + List.mem DebugCommand (attribute_of_vernac_command com) + +let is_vernac_goal_printing_command com = + let attribute = attribute_of_vernac_command com in + List.mem GoalStartingCommand attribute or + List.mem SolveCommand attribute + +let is_vernac_state_preserving_command com = + let attribute = attribute_of_vernac_command com in + List.mem OtherStatePreservingCommand attribute or + List.mem QueryCommand attribute + +let is_vernac_tactic_command com = + List.mem SolveCommand (attribute_of_vernac_command com) + +let is_vernac_proof_ending_command com = + List.mem ProofEndingCommand (attribute_of_vernac_command com) + + +(** Command history stack + + We maintain a stack of the past states of the system. Each + successfully interpreted command adds a [reset_info] element + to this stack, storing what were the (label / open proofs / + current proof depth) just _before_ the interpretation of this + command. A label is just an integer (cf. BackTo and Bactrack + vernac commands). +*) + +type reset_info = { label : int; proofs : identifier list; depth : int } + +let com_stk = Stack.create () + +let compute_reset_info () = + { label = Lib.current_command_label (); + proofs = Pfedit.get_all_proof_names (); + depth = max 0 (Pfedit.current_proof_depth ()) } + + +(** Interpretation (cf. [Ide_intf.interp]) *) + +(** Check whether a command is forbidden by CoqIDE *) + +let coqide_cmd_checks (loc,ast) = + let user_error s = + raise (Loc.Exc_located (loc, Util.UserError ("CoqIde", str s))) + in + if is_vernac_debug_command ast then + user_error "Debug mode not available within CoqIDE"; + if is_vernac_navigation_command ast then + user_error "Use CoqIDE navigation instead"; + if is_vernac_known_option_command ast then + user_error "Use CoqIDE display menu instead"; + if is_vernac_query_command ast then + msgerrnl (str "Warning: query commands should not be inserted in scripts") + +let raw_eval_expr = Vernac.eval_expr + +let eval_expr loc_ast = + let rewind_info = compute_reset_info () in + raw_eval_expr loc_ast; + Stack.push rewind_info com_stk + +let interp (raw,verbosely,s) = + if not raw then (prerr_endline "Starting interp..."; prerr_endline s); + let pa = Pcoq.Gram.parsable (Stream.of_string s) in + let loc_ast = Vernac.parse_sentence (pa,None) in + if not raw then coqide_cmd_checks loc_ast; + (* We run tactics silently, since we will query the goal state later. + Otherwise, we honor the IDE verbosity flag. *) + Flags.make_silent + (is_vernac_goal_printing_command (snd loc_ast) || not verbosely); + if raw then raw_eval_expr loc_ast else eval_expr loc_ast; + Flags.make_silent true; + if not raw then prerr_endline ("...Done with interp of : "^s); + read_stdout () + + +(** Backtracking (cf. [Ide_intf.rewind]). + We now rely on the [Backtrack] command just as ProofGeneral. *) + +let rewind count = + if count = 0 then 0 + else + let current_proofs = Pfedit.get_all_proof_names () + in + (* 1) First, let's pop the history stack exactly [count] times. + NB: Normally, the IDE will not rewind by more than the numbers + of already interpreted commands, hence no risk of [Stack.Empty]. + *) + let initial_target = + for i = 1 to count - 1 do ignore (Stack.pop com_stk) done; + Stack.pop com_stk + in + (* 2) Backtrack by enough additional steps to avoid re-opening proofs. + Typically, when a Qed has been crossed, we backtrack to the proof start. + NB: We cannot reach the empty stack, since the oldest [reset_info] + in the history cannot have opened proofs. + *) + let already_opened p = List.mem p current_proofs in + let rec extra_back n target = + if List.for_all already_opened target.proofs then n,target + else extra_back (n+1) (Stack.pop com_stk) + in + let extra_count, target = extra_back 0 initial_target + in + (* 3) Now that [target.proofs] is a subset of the opened proofs before + the rewind, we simply abort the extra proofs (if any). + NB: It is critical here that proofs are nested in a regular way + (i.e. no Resume or Suspend, as enforced above). This way, we can simply + count the extra proofs to abort instead of taking care of their names. + *) + let naborts = List.length current_proofs - List.length target.proofs + in + (* 4) We are now ready to call [Backtrack] *) + prerr_endline ("Rewind to state "^string_of_int target.label^ + ", proof depth "^string_of_int target.depth^ + ", num of aborts "^string_of_int naborts); + Vernacentries.vernac_backtrack target.label target.depth naborts; + Lib.mark_end_of_command (); (* We've short-circuited Vernac.eval_expr *) + extra_count + + +(** Goal display *) + +let hyp_next_tac sigma env (id,_,ast) = + let id_s = Names.string_of_id id in + let type_s = string_of_ppcmds (pr_ltype_env env ast) in + [ + ("clear "^id_s),("clear "^id_s^".\n"); + ("apply "^id_s),("apply "^id_s^".\n"); + ("exact "^id_s),("exact "^id_s^".\n"); + ("generalize "^id_s),("generalize "^id_s^".\n"); + ("absurd <"^id_s^">"),("absurd "^type_s^".\n") + ] @ (if Hipattern.is_equality_type ast then [ + ("discriminate "^id_s),("discriminate "^id_s^".\n"); + ("injection "^id_s),("injection "^id_s^".\n") + ] else []) @ (if Hipattern.is_equality_type (snd (Reductionops.splay_prod env sigma ast)) then [ + ("rewrite "^id_s),("rewrite "^id_s^".\n"); + ("rewrite <- "^id_s),("rewrite <- "^id_s^".\n") + ] else []) @ [ + ("elim "^id_s), ("elim "^id_s^".\n"); + ("inversion "^id_s), ("inversion "^id_s^".\n"); + ("inversion clear "^id_s), ("inversion_clear "^id_s^".\n") + ] + +let concl_next_tac sigma concl = + let expand s = (s,s^".\n") in + List.map expand ([ + "intro"; + "intros"; + "intuition" + ] @ (if Hipattern.is_equality_type (Goal.V82.concl sigma concl) then [ + "reflexivity"; + "discriminate"; + "symmetry" + ] else []) @ [ + "assumption"; + "omega"; + "ring"; + "auto"; + "eauto"; + "tauto"; + "trivial"; + "decide equality"; + "simpl"; + "subst"; + "red"; + "split"; + "left"; + "right" + ]) + +let process_goal sigma g = + let env = Goal.V82.env sigma g in + let ccl = + let norm_constr = Reductionops.nf_evar sigma (Goal.V82.concl sigma g) in + string_of_ppcmds (pr_ltype_env_at_top env norm_constr) in + let process_hyp h_env d acc = + let d = Term.map_named_declaration (Reductionops.nf_evar sigma) d in + (string_of_ppcmds (pr_var_decl h_env d)) :: acc in +(* (string_of_ppcmds (pr_var_decl h_env d), hyp_next_tac sigma h_env d)::acc in *) + let hyps = + List.rev (Environ.fold_named_context process_hyp env ~init: []) in + { Interface.goal_hyp = hyps; Interface.goal_ccl = ccl } +(* hyps,(ccl,concl_next_tac sigma g)) *) + +let goals () = + try + let pfts = Proof_global.give_me_the_proof () in + let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in + let fg = List.map (process_goal sigma) all_goals in + let { Evd.it = bgoals ; sigma = sigma } = Proof.V82.background_subgoals pfts in + let bg = List.map (process_goal sigma) bgoals in + Some { Interface.fg_goals = fg; Interface.bg_goals = bg; } + with Proof_global.NoCurrentProof -> None + +let evars () = + try + let pfts = Proof_global.give_me_the_proof () in + let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in + let exl = Evarutil.non_instantiated sigma in + let map_evar ev = { Interface.evar_info = string_of_ppcmds (pr_evar ev); } in + let el = List.map map_evar exl in + Some el + with Proof_global.NoCurrentProof -> None + +let hints () = + try + let pfts = Proof_global.give_me_the_proof () in + let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in + match all_goals with + | [] -> None + | g :: _ -> + let env = Goal.V82.env sigma g in + let hint_goal = concl_next_tac sigma g in + let get_hint_hyp env d accu = hyp_next_tac sigma env d :: accu in + let hint_hyps = List.rev (Environ.fold_named_context get_hint_hyp env ~init: []) in + Some (hint_hyps, hint_goal) + with Proof_global.NoCurrentProof -> None + +(** Other API calls *) + +let inloadpath dir = + Library.is_in_load_paths (System.physical_path_of_string dir) + +let status () = + (** We remove the initial part of the current [dir_path] + (usually Top in an interactive session, cf "coqtop -top"), + and display the other parts (opened sections and modules) *) + let path = + let l = Names.repr_dirpath (Lib.cwd ()) in + let l = snd (Util.list_sep_last l) in + if l = [] then None + else Some (Names.string_of_dirpath (Names.make_dirpath l)) + in + let proof = + try + Some (Names.string_of_id (Pfedit.get_current_proof_name ())) + with _ -> None + in + { Interface.status_path = path; Interface.status_proofname = proof } + +let get_options () = + let table = Goptions.get_tables () in + let fold key state accu = (key, state) :: accu in + Goptions.OptionMap.fold fold table [] + +let set_options options = + let iter (name, value) = match value with + | BoolValue b -> Goptions.set_bool_option_value name b + | IntValue i -> Goptions.set_int_option_value name i + | StringValue s -> Goptions.set_string_option_value name s + in + List.iter iter options + +(** Grouping all call handlers together + error handling *) + +let eval_call c = + let rec handle_exn e = + catch_break := false; + let pr_exn e = string_of_ppcmds (Errors.print e) in + match e with + | Vernacexpr.Drop -> None, "Drop is not allowed by coqide!" + | Vernacexpr.Quit -> None, "Quit is not allowed by coqide!" + | Vernac.DuringCommandInterp (_,inner) -> handle_exn inner + | Error_in_file (_,_,inner) -> None, pr_exn inner + | Loc.Exc_located (loc, inner) when loc = dummy_loc -> None, pr_exn inner + | Loc.Exc_located (loc, inner) -> Some (Util.unloc loc), pr_exn inner + | e -> None, pr_exn e + in + let interruptible f x = + catch_break := true; + Util.check_for_interrupt (); + let r = f x in + catch_break := false; + r + in + let handler = { + Interface.interp = interruptible interp; + Interface.rewind = interruptible rewind; + Interface.goals = interruptible goals; + Interface.evars = interruptible evars; + Interface.hints = interruptible hints; + Interface.status = interruptible status; + Interface.inloadpath = interruptible inloadpath; + Interface.get_options = interruptible get_options; + Interface.set_options = interruptible set_options; + Interface.mkcases = interruptible Vernacentries.make_cases; + Interface.handle_exn = handle_exn; } + in + (* If the messages of last command are still there, we remove them *) + ignore (read_stdout ()); + Ide_intf.abstract_eval_call handler c + + +(** The main loop *) + +(** Exceptions during eval_call should be converted into [Interface.Fail] + messages by [handle_exn] above. Otherwise, we die badly, after having + tried to send a last message to the ide: trying to recover from errors + with the current protocol would most probably bring desynchronisation + between coqtop and ide. With marshalling, reading an answer to + a different request could hang the ide... *) + +let pr_debug s = + if !Flags.debug then Printf.eprintf "[pid %d] %s\n%!" (Unix.getpid ()) s + +let fail err = + Ide_intf.of_value (fun _ -> assert false) (Interface.Fail (None, err)) + +let loop () = + let p = Xml_parser.make () in + let () = Xml_parser.check_eof p false in + init_signal_handler (); + catch_break := false; + (* ensure we have a command separator object (DOT) so that the first + command can be reseted. *) + Lib.mark_end_of_command(); + try + while true do + let xml_answer = + try + let xml_query = Xml_parser.parse p (Xml_parser.SChannel stdin) in + let q = Ide_intf.to_call xml_query in + let () = pr_debug ("<-- " ^ Ide_intf.pr_call q) in + let r = eval_call q in + let () = pr_debug ("--> " ^ Ide_intf.pr_full_value q r) in + Ide_intf.of_answer q r + with + | Xml_parser.Error (err, loc) -> + let msg = "Syntax error in query: " ^ Xml_parser.error_msg err in + fail msg + | Ide_intf.Marshal_error -> + fail "Incorrect query." + in + Xml_utils.print_xml !orig_stdout xml_answer; + flush !orig_stdout + done + with e -> + let msg = Printexc.to_string e in + let r = "Fatal exception in coqtop:\n" ^ msg in + pr_debug ("==> " ^ r); + (try + Xml_utils.print_xml !orig_stdout (fail r); + flush !orig_stdout + with _ -> ()); + exit 1 diff --git a/toplevel/ide_slave.mli b/toplevel/ide_slave.mli new file mode 100644 index 00000000..13dff280 --- /dev/null +++ b/toplevel/ide_slave.mli @@ -0,0 +1,17 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* unit + +val loop : unit -> unit diff --git a/toplevel/ind_tables.ml b/toplevel/ind_tables.ml index 53c3bcea..de3b62f8 100644 --- a/toplevel/ind_tables.ml +++ b/toplevel/ind_tables.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (Lib.discharge_inductive ind,Lib.discharge_con const)) l) -let (inScheme,_) = +let inScheme : string * (inductive * constant) array -> obj = declare_object {(default_object "SCHEME") with cache_function = cache_scheme; load_function = (fun _ -> cache_scheme); @@ -111,21 +109,28 @@ let declare_individual_scheme_object s ?(aux="") f = let declare_scheme kind indcl = Lib.add_anonymous_leaf (inScheme (kind,indcl)) +let is_visible_name id = + try ignore (Nametab.locate (Libnames.qualid_of_ident id)); true + with Not_found -> false + +let compute_name internal id = + match internal with + | KernelVerbose | UserVerbose -> id + | KernelSilent -> + Namegen.next_ident_away_from (add_prefix "internal_" id) is_visible_name + let define internal id c = - (* TODO: specify even more by distinguish between KernelVerbose and - * UserVerbose *) - let fd = match internal with - | KernelSilent -> declare_internal_constant - | _ -> declare_constant in + let fd = declare_constant ~internal in + let id = compute_name internal id in let kn = fd id (DefinitionEntry { const_entry_body = c; + const_entry_secctx = None; const_entry_type = None; - const_entry_opaque = false; - const_entry_boxed = Flags.boxed_definitions() }, + const_entry_opaque = false }, Decl_kinds.IsDefinition Scheme) in (match internal with - | KernelSilent -> () + | KernelSilent -> () | _-> definition_message id); kn diff --git a/toplevel/ind_tables.mli b/toplevel/ind_tables.mli index e6f5e77a..96096d47 100644 --- a/toplevel/ind_tables.mli +++ b/toplevel/ind_tables.mli @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* constr array type individual_scheme_object_function = inductive -> constr -(* Main functions to register a scheme builder *) +(** Main functions to register a scheme builder *) val declare_mutual_scheme_object : string -> ?aux:string -> mutual_scheme_object_function -> mutual scheme_kind @@ -37,16 +37,16 @@ val declare_individual_scheme_object : string -> ?aux:string -> val declare_scheme : 'a scheme_kind -> (inductive * constant) array -> unit *) -(* Force generation of a (mutually) scheme with possibly user-level names *) +(** Force generation of a (mutually) scheme with possibly user-level names *) val define_individual_scheme : individual scheme_kind -> - Declare.internal_flag (* internal *) -> + Declare.internal_flag (** internal *) -> identifier option -> inductive -> constant -val define_mutual_scheme : mutual scheme_kind -> Declare.internal_flag (* internal *) -> +val define_mutual_scheme : mutual scheme_kind -> Declare.internal_flag (** internal *) -> (int * identifier) list -> mutual_inductive -> constant array -(* Main function to retrieve a scheme in the cache or to generate it *) +(** Main function to retrieve a scheme in the cache or to generate it *) val find_scheme : 'a scheme_kind -> inductive -> constant val check_scheme : 'a scheme_kind -> inductive -> bool diff --git a/toplevel/indschemes.ml b/toplevel/indschemes.ml index 3596085f..51eddbae 100644 --- a/toplevel/indschemes.ml +++ b/toplevel/indschemes.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* !elim_flag) ; @@ -58,6 +57,7 @@ let case_flag = ref false let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "automatic declaration of case analysis schemes"; optkey = ["Case";"Analysis";"Schemes"]; optread = (fun () -> !case_flag) ; @@ -67,6 +67,7 @@ let eq_flag = ref false let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "automatic declaration of boolean equality"; optkey = ["Boolean";"Equality";"Schemes"]; optread = (fun () -> !eq_flag) ; @@ -74,6 +75,7 @@ let _ = let _ = (* compatibility *) declare_bool_option { optsync = true; + optdepr = true; optname = "automatic declaration of boolean equality"; optkey = ["Equality";"Scheme"]; optread = (fun () -> !eq_flag) ; @@ -81,10 +83,11 @@ let _ = (* compatibility *) let is_eq_flag () = !eq_flag && Flags.version_strictly_greater Flags.V8_2 -let eq_dec_flag = ref false +let eq_dec_flag = ref false let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "automatic declaration of decidable equality"; optkey = ["Decidable";"Equality";"Schemes"]; optread = (fun () -> !eq_dec_flag) ; @@ -94,6 +97,7 @@ let rewriting_flag = ref false let _ = declare_bool_option { optsync = true; + optdepr = false; optname ="automatic declaration of rewriting schemes for equality types"; optkey = ["Rewriting";"Schemes"]; optread = (fun () -> !rewriting_flag) ; @@ -102,16 +106,13 @@ let _ = (* Util *) let define id internal c t = - (* TODO: specify even more by distinguish KernelVerbose and UserVerbose *) - let f = match internal with - | KernelSilent -> declare_internal_constant - | _ -> declare_constant in + let f = declare_constant ~internal in let kn = f id (DefinitionEntry { const_entry_body = c; + const_entry_secctx = None; const_entry_type = t; - const_entry_opaque = false; - const_entry_boxed = Flags.boxed_definitions() }, + const_entry_opaque = false }, Decl_kinds.IsDefinition Scheme) in definition_message id; kn @@ -127,7 +128,7 @@ let alarm what internal msg = | KernelVerbose | KernelSilent -> (if debug then - Flags.if_verbose Pp.msg_warning + Flags.if_warn Pp.msg_warning (hov 0 msg ++ fnl () ++ what ++ str " not defined.")) | _ -> errorlabstrm "" msg @@ -158,7 +159,7 @@ let try_declare_scheme what f internal names kn = (strbrk "Required constant " ++ str s ++ str " undefined.") | AlreadyDeclared msg -> alarm what internal (msg ++ str ".") - | _ -> + | _ -> alarm what internal (str "Unknown exception during scheme creation.") @@ -173,7 +174,7 @@ let declare_beq_scheme_with l kn = try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserVerbose l kn let try_declare_beq_scheme kn = - (* TODO: handle Fix, see e.g. TheoryList.In_spec, eventually handle + (* TODO: handle Fix, eventually handle proof-irrelevance; improve decidability by depending on decidability for the parameters rather than on the bl and lb properties *) try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen KernelVerbose [] kn diff --git a/toplevel/indschemes.mli b/toplevel/indschemes.mli index 707b9e00..87aedc7b 100644 --- a/toplevel/indschemes.mli +++ b/toplevel/indschemes.mli @@ -1,56 +1,52 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit val declare_eq_decidability : mutual_inductive -> unit -(* Build and register a congruence scheme for an equality-like inductive type *) +(** Build and register a congruence scheme for an equality-like inductive type *) val declare_congr_scheme : inductive -> unit -(* Build and register rewriting schemes for an equality-like inductive type *) +(** Build and register rewriting schemes for an equality-like inductive type *) val declare_rewriting_schemes : inductive -> unit -(* Mutual Minimality/Induction scheme *) +(** Mutual Minimality/Induction scheme *) val do_mutual_induction_scheme : - (identifier located * bool * inductive * rawsort) list -> unit + (identifier located * bool * inductive * glob_sort) list -> unit -(* Main calls to interpret the Scheme command *) +(** Main calls to interpret the Scheme command *) val do_scheme : (identifier located option * scheme) list -> unit -(* Combine a list of schemes into a conjunction of them *) +(** Combine a list of schemes into a conjunction of them *) val build_combined_scheme : env -> constant list -> constr * types val do_combined_scheme : identifier located -> identifier located list -> unit -(* Hook called at each inductive type definition *) +(** Hook called at each inductive type definition *) val declare_default_schemes : mutual_inductive -> unit diff --git a/toplevel/interface.mli b/toplevel/interface.mli new file mode 100644 index 00000000..e1410f5b --- /dev/null +++ b/toplevel/interface.mli @@ -0,0 +1,87 @@ +(************************************************************************) +(* v * The Coq Proof Assistant / The Coq Development Team *) +(* string; + rewind : int -> int; + goals : unit -> goals option; + evars : unit -> evar list option; + hints : unit -> (hint list * hint) option; + status : unit -> status; + get_options : unit -> (option_name * option_state) list; + set_options : (option_name * option_value) list -> unit; + inloadpath : string -> bool; + mkcases : string -> string list list; + handle_exn : exn -> location * string; +} diff --git a/toplevel/lemmas.ml b/toplevel/lemmas.ml index 8ef82105..7704449f 100644 --- a/toplevel/lemmas.ml +++ b/toplevel/lemmas.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* (pi2 (Global.lookup_named id),variable_opacity id) | ConstRef cst -> - let {const_body=body;const_opaque=opaq} = Global.lookup_constant cst in - (Option.map Declarations.force body,opaq) + let cb = Global.lookup_constant cst in + (Option.map Declarations.force (body_of_constant cb), is_opaque cb) | _ -> assert false let adjust_guardness_conditions const = function @@ -126,13 +124,13 @@ let find_mutually_recursive_statements thms = assert (rest=[]); (* One occ. of common coind ccls and no common inductive hyps *) if common_same_indhyp <> [] then - if_verbose warning "Assuming mutual coinductive statements."; + if_verbose msgnl (str "Assuming mutual coinductive statements."); flush_all (); indccl, true, [] | [], _::_ -> if same_indccl <> [] && list_distinct (List.map pi1 (List.hd same_indccl)) then - if_verbose warn (strbrk "Coinductive statements do not follow the order of definition, assume the proof to be by induction."); flush_all (); + if_verbose msgnl (strbrk "Coinductive statements do not follow the order of definition, assuming the proof to be by induction."); flush_all (); let possible_guards = List.map (List.map pi3) inds_hyps in (* assume the largest indices as possible *) list_last common_same_indhyp, false, possible_guards @@ -176,14 +174,6 @@ let save id const do_guard (locality,kind) hook = definition_message id; hook l r -let save_hook = ref ignore -let set_save_hook f = save_hook := f - -let save_named opacity = - let id,(const,do_guard,persistence,hook) = Pfedit.cook_proof !save_hook in - let const = { const with const_entry_opaque = opacity } in - save id const do_guard persistence hook - let default_thm_id = id_of_string "Unnamed_thm" let compute_proof_name locality = function @@ -209,7 +199,7 @@ let save_remaining_recthms (local,kind) body opaq i (id,(t_i,(_,imps))) = (Local,VarRef id,imps) | Global -> let k = IsAssumption Conjectural in - let kn = declare_constant id (ParameterEntry (t_i,false), k) in + let kn = declare_constant id (ParameterEntry (None,t_i,None), k) in (Global,ConstRef kn,imps)) | Some body -> let k = logical_kind_of_goal_kind kind in @@ -225,27 +215,34 @@ let save_remaining_recthms (local,kind) body opaq i (id,(t_i,(_,imps))) = | Global -> let const = { const_entry_body = body_i; + const_entry_secctx = None; const_entry_type = Some t_i; - const_entry_opaque = opaq; - const_entry_boxed = false (* copy of what cook_proof does *)} in + const_entry_opaque = opaq } in let kn = declare_constant id (DefinitionEntry const, k) in (Global,ConstRef kn,imps) -(* 4.2| General support for goals *) +let save_hook = ref ignore +let set_save_hook f = save_hook := f + +let get_proof opacity = + let id,(const,do_guard,persistence,hook) = Pfedit.cook_proof !save_hook in + id,{const with const_entry_opaque = opacity},do_guard,persistence,hook + +let save_named opacity = + let id,const,do_guard,persistence,hook = get_proof opacity in + save id const do_guard persistence hook let check_anonymity id save_ident = - if atompart_of_id id <> "Unnamed_thm" then + if atompart_of_id id <> string_of_id (default_thm_id) then error "This command can only be used for unnamed theorem." let save_anonymous opacity save_ident = - let id,(const,do_guard,persistence,hook) = Pfedit.cook_proof !save_hook in - let const = { const with const_entry_opaque = opacity } in + let id,const,do_guard,persistence,hook = get_proof opacity in check_anonymity id save_ident; save save_ident const do_guard persistence hook let save_anonymous_with_strength kind opacity save_ident = - let id,(const,do_guard,_,hook) = Pfedit.cook_proof !save_hook in - let const = { const with const_entry_opaque = opacity } in + let id,const,do_guard,_,hook = get_proof opacity in check_anonymity id save_ident; (* we consider that non opaque behaves as local for discharge *) save save_ident const do_guard (Global, Proof kind) hook @@ -256,8 +253,7 @@ let start_hook = ref ignore let set_start_hook = (:=) start_hook let start_proof id kind c ?init_tac ?(compute_guard=[]) hook = - let sign = Global.named_context () in - let sign = clear_proofs sign in + let sign = initialize_named_context_for_proof () in !start_hook c; Pfedit.start_proof id kind sign c ?init_tac ~compute_guard hook @@ -314,11 +310,11 @@ let start_proof_with_initialization kind recguard thms snl hook = start_proof id kind t ?init_tac hook ~compute_guard:guard let start_proof_com kind thms hook = - let evdref = ref (create_evar_defs Evd.empty) in + let evdref = ref Evd.empty in let env0 = Global.env () in let thms = List.map (fun (sopt,(bl,t,guard)) -> - let (env, ctx), imps = interp_context_evars evdref env0 bl in - let t', imps' = interp_type_evars_impls ~evdref env t in + let impls, ((env, ctx), imps) = interp_context_evars evdref env0 bl in + let t', imps' = interp_type_evars_impls ~impls ~evdref env t in Sign.iter_rel_context (check_evars env Evd.empty !evdref) ctx; let ids = List.map pi1 ctx in (compute_proof_name (fst kind) sopt, @@ -333,8 +329,9 @@ let start_proof_com kind thms hook = let admit () = let (id,k,typ,hook) = Pfedit.current_proof_statement () in + let e = Pfedit.get_used_variables(), typ, None in let kn = - declare_constant id (ParameterEntry (typ,false),IsAssumption Conjectural) in + declare_constant id (ParameterEntry e,IsAssumption Conjectural) in Pfedit.delete_current_proof (); assumption_message id; hook Global (ConstRef kn) diff --git a/toplevel/lemmas.mli b/toplevel/lemmas.mli index 0e8eaac2..8b496f82 100644 --- a/toplevel/lemmas.mli +++ b/toplevel/lemmas.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit) -> unit val start_proof : identifier -> goal_kind -> types -> @@ -35,31 +31,32 @@ val start_proof_with_initialization : (identifier * (types * (name list * Impargs.manual_explicitation list))) list -> int list option -> declaration_hook -> unit -(* A hook the next three functions pass to cook_proof *) -val set_save_hook : (Refiner.pftreestate -> unit) -> unit +(** A hook the next three functions pass to cook_proof *) +val set_save_hook : (Proof.proof -> unit) -> unit -(*s [save_named b] saves the current completed proof under the name it +(** {6 ... } *) +(** [save_named b] saves the current completed proof under the name it was started; boolean [b] tells if the theorem is declared opaque; it fails if the proof is not completed *) val save_named : bool -> unit -(* [save_anonymous b name] behaves as [save_named] but declares the theorem +(** [save_anonymous b name] behaves as [save_named] but declares the theorem under the name [name] and respects the strength of the declaration *) val save_anonymous : bool -> identifier -> unit -(* [save_anonymous_with_strength s b name] behaves as [save_anonymous] but +(** [save_anonymous_with_strength s b name] behaves as [save_anonymous] but declares the theorem under the name [name] and gives it the strength [strength] *) val save_anonymous_with_strength : theorem_kind -> bool -> identifier -> unit -(* [admit ()] aborts the current goal and save it as an assmumption *) +(** [admit ()] aborts the current goal and save it as an assmumption *) val admit : unit -> unit -(* [get_current_context ()] returns the evar context and env of the +(** [get_current_context ()] returns the evar context and env of the current open proof if any, otherwise returns the empty evar context and the current global env *) diff --git a/toplevel/libtypes.ml b/toplevel/libtypes.ml index 27e19bd8..2f98962c 100644 --- a/toplevel/libtypes.ml +++ b/toplevel/libtypes.ml @@ -1,6 +1,6 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* obj = declare_object { (default_object "LIBTYPES") with load_function = (fun _ -> load); diff --git a/toplevel/libtypes.mli b/toplevel/libtypes.mli index 03329592..a6a95ccf 100644 --- a/toplevel/libtypes.mli +++ b/toplevel/libtypes.mli @@ -1,31 +1,25 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* types -(* The different types of search available. - * See term_dnet.mli for more explanations *) +(** The different types of search available. + See term_dnet.mli for more explanations *) val search_pattern : types -> result list val search_concl : types -> result list val search_head_concl : types -> result list diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml index 0adae08a..6a4d7251 100644 --- a/toplevel/metasyntax.ml +++ b/toplevel/metasyntax.ml @@ -1,15 +1,14 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* obj = declare_object {(default_object "TOKEN") with open_function = (fun i o -> if i=1 then cache_token o); cache_function = cache_token; @@ -70,7 +70,12 @@ let subst_tactic_parule subst (key,n,p,(d,tac)) = let subst_tactic_notation (subst,(pa,pp)) = (subst_tactic_parule subst pa,pp) -let (inTacticGrammar, outTacticGrammar) = +type tactic_grammar_obj = + (string * int * grammar_prod_item list * + (dir_path * Tacexpr.glob_tactic_expr)) + * (string * Genarg.argument_type list * (int * Pptactic.grammar_terminals)) + +let inTacticGrammar : tactic_grammar_obj -> obj = declare_object {(default_object "TacticGrammar") with open_function = (fun i o -> if i=1 then cache_tactic_notation o); cache_function = cache_tactic_notation; @@ -106,33 +111,33 @@ let add_tactic_notation (n,prods,e) = let print_grammar = function | "constr" | "operconstr" | "binder_constr" -> msgnl (str "Entry constr is"); - entry_print Pcoq.Constr.constr; + Gram.entry_print Pcoq.Constr.constr; msgnl (str "and lconstr is"); - entry_print Pcoq.Constr.lconstr; + Gram.entry_print Pcoq.Constr.lconstr; msgnl (str "where binder_constr is"); - entry_print Pcoq.Constr.binder_constr; + Gram.entry_print Pcoq.Constr.binder_constr; msgnl (str "and operconstr is"); - entry_print Pcoq.Constr.operconstr; + Gram.entry_print Pcoq.Constr.operconstr; | "pattern" -> - entry_print Pcoq.Constr.pattern + Gram.entry_print Pcoq.Constr.pattern | "tactic" -> msgnl (str "Entry tactic_expr is"); - entry_print Pcoq.Tactic.tactic_expr; + Gram.entry_print Pcoq.Tactic.tactic_expr; msgnl (str "Entry binder_tactic is"); - entry_print Pcoq.Tactic.binder_tactic; + Gram.entry_print Pcoq.Tactic.binder_tactic; msgnl (str "Entry simple_tactic is"); - entry_print Pcoq.Tactic.simple_tactic; + Gram.entry_print Pcoq.Tactic.simple_tactic; | "vernac" -> msgnl (str "Entry vernac is"); - entry_print Pcoq.Vernac_.vernac; + Gram.entry_print Pcoq.Vernac_.vernac; msgnl (str "Entry command is"); - entry_print Pcoq.Vernac_.command; + Gram.entry_print Pcoq.Vernac_.command; msgnl (str "Entry syntax is"); - entry_print Pcoq.Vernac_.syntax; + Gram.entry_print Pcoq.Vernac_.syntax; msgnl (str "Entry gallina is"); - entry_print Pcoq.Vernac_.gallina; + Gram.entry_print Pcoq.Vernac_.gallina; msgnl (str "Entry gallina_ext is"); - entry_print Pcoq.Vernac_.gallina_ext; + Gram.entry_print Pcoq.Vernac_.gallina_ext; | _ -> error "Unknown or unprintable grammar entry." (**********************************************************************) @@ -233,7 +238,7 @@ let parse_format (loc,str) = else error "Empty format." with e -> - Stdpp.raise_with_loc loc e + Loc.raise loc e (***********************) (* Analyzing notations *) @@ -279,9 +284,9 @@ let rec find_pattern nt xl = function find_pattern nt (x::xl) (l,l') | [], NonTerminal x' :: l' -> (out_nt nt,x',List.rev xl),l' - | [], Terminal s :: _ | Terminal s :: _, _ -> + | _, Terminal s :: _ | Terminal s :: _, _ -> error ("The token \""^s^"\" occurs on one side of \"..\" but not on the other side.") - | [], Break s :: _ | Break s :: _, _ -> + | _, Break s :: _ | Break s :: _, _ -> error ("A break occurs on one side of \"..\" but not on the other side.") | _, [] -> error ("The special symbol \"..\" must occur in a configuration of the form\n\"x symbs .. symbs y\".") @@ -311,13 +316,10 @@ let rec interp_list_parser hd = function (* Find non-terminal tokens of notation *) -let is_normal_token str = - try let _ = Lexer.check_ident str in true with Lexer.Error _ -> false - (* To protect alphabetic tokens and quotes from being seen as variables *) let quote_notation_token x = let n = String.length x in - let norm = is_normal_token x in + let norm = is_ident x in if (n > 0 & norm) or (n > 2 & x.[0] = '\'') then "'"^x^"'" else x @@ -325,11 +327,9 @@ let rec raw_analyze_notation_tokens = function | [] -> [] | String ".." :: sl -> NonTerminal ldots_var :: raw_analyze_notation_tokens sl | String "_" :: _ -> error "_ must be quoted." - | String x :: sl when is_normal_token x -> - Lexer.check_ident x; + | String x :: sl when is_ident x -> NonTerminal (Names.id_of_string x) :: raw_analyze_notation_tokens sl | String s :: sl -> - Lexer.check_keyword s; Terminal (drop_simple_quotes s) :: raw_analyze_notation_tokens sl | WhiteSpace n :: sl -> Break n :: raw_analyze_notation_tokens sl @@ -363,11 +363,6 @@ let error_not_same_scope x y = error ("Variables "^string_of_id x^" and "^string_of_id y^ " must be in the same scope.") -let error_both_bound_and_binding x y = - errorlabstrm "" (strbrk "The recursive variables " ++ pr_id x ++ - strbrk " and " ++ pr_id y ++ strbrk " cannot be used as placeholder - for both terms and binders.") - (**********************************************************************) (* Build pretty-printing rules *) @@ -375,9 +370,9 @@ type printing_precedence = int * parenRelation type parsing_precedence = int option let prec_assoc = function - | Gramext.RightA -> (L,E) - | Gramext.LeftA -> (E,L) - | Gramext.NonA -> (L,L) + | RightA -> (L,E) + | LeftA -> (E,L) + | NonA -> (L,L) let precedence_of_entry_type from = function | ETConstr (NumLevel n,BorderProd (_,None)) -> n, Prec n @@ -403,12 +398,6 @@ let is_right_bracket s = let l = String.length s in l <> 0 & (s.[l-1] = '}' or s.[l-1] = ']' or s.[l-1] = ')') -let is_left_bracket_on_left s = - let l = String.length s in l <> 0 & s.[l-1] = '>' - -let is_right_bracket_on_right s = - let l = String.length s in l <> 0 & s.[0] = '<' - let is_comma s = let l = String.length s in l <> 0 & (s.[0] = ',' or s.[0] = ';') @@ -598,20 +587,20 @@ let is_not_small_constr = function | _ -> false let rec define_keywords_aux = function - | GramConstrNonTerminal(e,Some _) as n1 :: GramConstrTerminal("IDENT",k) :: l + | GramConstrNonTerminal(e,Some _) as n1 :: GramConstrTerminal(IDENT k) :: l when is_not_small_constr e -> - message ("Defining '"^k^"' as keyword"); - Lexer.add_token("",k); - n1 :: GramConstrTerminal("",k) :: define_keywords_aux l + message ("Identifier '"^k^"' now a keyword"); + Lexer.add_keyword k; + n1 :: GramConstrTerminal(KEYWORD k) :: define_keywords_aux l | n :: l -> n :: define_keywords_aux l | [] -> [] (* Ensure that IDENT articulation terminal symbols are keywords *) let define_keywords = function - | GramConstrTerminal("IDENT",k)::l -> - message ("Defining '"^k^"' as keyword"); - Lexer.add_token("",k); - GramConstrTerminal("",k) :: define_keywords_aux l + | GramConstrTerminal(IDENT k)::l -> + message ("Identifier '"^k^"' now a keyword"); + Lexer.add_keyword k; + GramConstrTerminal(KEYWORD k) :: define_keywords_aux l | l -> define_keywords_aux l let distribute a ll = List.map (fun l -> a @ l) ll @@ -673,9 +662,9 @@ let border = function let recompute_assoc typs = match border typs, border (List.rev typs) with - | Some Gramext.LeftA, Some Gramext.RightA -> assert false - | Some Gramext.LeftA, _ -> Some Gramext.LeftA - | _, Some Gramext.RightA -> Some Gramext.RightA + | Some LeftA, Some RightA -> assert false + | Some LeftA, _ -> Some LeftA + | _, Some RightA -> Some RightA | _ -> None (**************************************************************************) @@ -726,7 +715,13 @@ let subst_syntax_extension (subst,(local,sy)) = let classify_syntax_definition (local,_ as o) = if local then Dispose else Substitute o -let (inSyntaxExtension, outSyntaxExtension) = +type syntax_extension_obj = + bool * + (notation_var_internalization_type list * Notation.level * + notation * notation_grammar * unparsing list) + list + +let inSyntaxExtension : syntax_extension_obj -> obj = declare_object {(default_object "SYNTAX-EXTENSION") with open_function = (fun i o -> if i=1 then cache_syntax_extension o); cache_function = cache_syntax_extension; @@ -891,15 +886,17 @@ specially and require that the notation \"{ _ }\" is already reserved." (* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *) let remove_curly_brackets l = - let rec next = function - | Break _ :: l -> next l - | l -> l in + let rec skip_break acc = function + | Break _ as br :: l -> skip_break (br::acc) l + | l -> List.rev acc, l in let rec aux deb = function | [] -> [] | Terminal "{" as t1 :: l -> - (match next l with + let br,next = skip_break [] l in + (match next with | NonTerminal _ as x :: l' as l0 -> - (match next l' with + let br',next' = skip_break [] l' in + (match next' with | Terminal "}" as t2 :: l'' as l1 -> if l <> l0 or l' <> l1 then warning "Skipping spaces inside curly brackets"; @@ -907,15 +904,14 @@ let remove_curly_brackets l = check_curly_brackets_notation_exists (); x :: aux false l'' end - | l1 -> t1 :: x :: aux false l1) + | l1 -> t1 :: br @ x :: br' @ aux false l1) | l0 -> t1 :: aux false l0) | x :: l -> x :: aux false l in aux true l let compute_syntax_data (df,modifiers) = let (assoc,n,etyps,onlyparse,fmt) = interp_modifiers modifiers in - (* Notation defaults to NONA *) - let assoc = match assoc with None -> Some Gramext.NonA | a -> a in + let assoc = match assoc with None -> (* default *) Some NonA | a -> a in let toks = split_notation_string df in let (recvars,mainvars,symbols) = analyze_notation_tokens toks in let ntn_for_interp = make_notation_key symbols in @@ -977,7 +973,11 @@ let subst_notation (subst,(lc,scope,pat,b,ndf)) = let classify_notation (local,_,_,_,_ as o) = if local then Dispose else Substitute o -let (inNotation, outNotation) = +type notation_obj = + bool * scope_name option * interpretation * bool * + (notation * notation_location) + +let inNotation : notation_obj -> obj = declare_object {(default_object "NOTATION") with open_function = open_notation; cache_function = cache_notation; @@ -1153,7 +1153,7 @@ let subst_scope_command (subst,(scope,o as x)) = match o with scope, ScopeClasses cl' | _ -> x -let (inScopeCommand,outScopeCommand) = +let inScopeCommand : scope_name * scope_command -> obj = declare_object {(default_object "DELIMITERS") with cache_function = cache_scope_command; open_function = open_scope_command; diff --git a/toplevel/metasyntax.mli b/toplevel/metasyntax.mli index 2c4e29bb..4ee1310a 100644 --- a/toplevel/metasyntax.mli +++ b/toplevel/metasyntax.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit -(* Adding a tactic notation in the environment *) +(** Adding a tactic notation in the environment *) val add_tactic_notation : int * grammar_tactic_prod_item_expr list * raw_tactic_expr -> unit -(* Adding a (constr) notation in the environment*) +(** Adding a (constr) notation in the environment*) val add_infix : locality_flag -> (lstring * syntax_modifier list) -> constr_expr -> scope_name option -> unit @@ -35,32 +31,32 @@ val add_infix : locality_flag -> (lstring * syntax_modifier list) -> val add_notation : locality_flag -> constr_expr -> (lstring * syntax_modifier list) -> scope_name option -> unit -(* Declaring delimiter keys and default scopes *) +(** Declaring delimiter keys and default scopes *) val add_delimiters : scope_name -> string -> unit val add_class_scope : scope_name -> Classops.cl_typ -> unit -(* Add only the interpretation of a notation that already has pa/pp rules *) +(** Add only the interpretation of a notation that already has pa/pp rules *) val add_notation_interpretation : (lstring * constr_expr * scope_name option) -> unit -(* Add a notation interpretation for supporting the "where" clause *) +(** Add a notation interpretation for supporting the "where" clause *) val set_notation_for_interpretation : Constrintern.internalization_env -> (lstring * constr_expr * scope_name option) -> unit -(* Add only the parsing/printing rule of a notation *) +(** Add only the parsing/printing rule of a notation *) val add_syntax_extension : locality_flag -> (lstring * syntax_modifier list) -> unit -(* Add a syntactic definition (as in "Notation f := ...") *) +(** Add a syntactic definition (as in "Notation f := ...") *) val add_syntactic_definition : identifier -> identifier list * constr_expr -> bool -> bool -> unit -(* Print the Camlp4 state of a grammar *) +(** Print the Camlp4 state of a grammar *) val print_grammar : string -> unit diff --git a/toplevel/mltop.ml4 b/toplevel/mltop.ml4 index 59bc01d0..ff3ce8a0 100644 --- a/toplevel/mltop.ml4 +++ b/toplevel/mltop.ml4 @@ -1,18 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* () (* For Rec Add ML Path *) -let add_rec_ml_dir dir = - List.iter (fun (lp,_) -> add_ml_dir lp) (all_subdirs dir) +let add_rec_ml_dir unix_path = + List.iter (fun (lp,_) -> add_ml_dir lp) (all_subdirs ~unix_path) (* Adding files to Coq and ML loadpath *) @@ -150,24 +143,24 @@ let add_path ~unix_path:dir ~coq_root:coq_dirpath = let convert_string d = try Names.id_of_string d with _ -> - if_verbose warning - ("Directory "^d^" cannot be used as a Coq identifier (skipped)"); + if_warn msg_warning + (str ("Directory "^d^" cannot be used as a Coq identifier (skipped)")); flush_all (); failwith "caught" -let add_rec_path ~unix_path:dir ~coq_root:coq_dirpath = - if exists_dir dir then - let dirs = all_subdirs dir in - let prefix = Names.repr_dirpath coq_dirpath in +let add_rec_path ~unix_path ~coq_root = + if exists_dir unix_path then + let dirs = all_subdirs ~unix_path in + let prefix = Names.repr_dirpath coq_root in let convert_dirs (lp,cp) = (lp,Names.make_dirpath (List.map convert_string (List.rev cp)@prefix)) in let dirs = map_succeed convert_dirs dirs in List.iter (fun lpe -> add_ml_dir (fst lpe)) dirs; - add_ml_dir dir; + add_ml_dir unix_path; List.iter (Library.add_load_path false) dirs; - Library.add_load_path true (dir,coq_dirpath) + Library.add_load_path true (unix_path, coq_root) else - msg_warning (str ("Cannot open " ^ dir)) + msg_warning (str ("Cannot open " ^ unix_path)) (* convertit un nom quelconque en nom de fichier ou de module *) let mod_of_name name = @@ -224,8 +217,6 @@ let file_of_name name = coqtop could always load plugins, we prefer to have uniformity between bytecode and native versions. *) -let stdlib_use_plugins = Coq_config.has_natdynlink - (* [known_loaded_module] contains the names of the loaded ML modules * (linked or loaded with load_object). It is used not to load a * module twice. It is NOT the list of ML modules Coq knows. *) @@ -244,7 +235,7 @@ let add_known_module mname = let module_is_known mname = Stringset.mem (String.capitalize mname) !known_loaded_modules -let load_object mname fname= +let load_ml_object mname fname= dir_ml_load fname; add_known_module mname @@ -266,7 +257,7 @@ let unfreeze_ml_modules x = if not (module_is_known mname) then if has_dynlink then let fname = file_of_name mname in - load_object mname fname + load_ml_object mname fname else errorlabstrm "Mltop.unfreeze_ml_modules" (str"Loading of ML object file forbidden in a native Coq."); @@ -291,7 +282,7 @@ let cache_ml_module_object (_,{mnames=mnames}) = try if_verbose msg (str"[Loading ML file " ++ str fname ++ str" ..."); - load_object mname fname; + load_ml_object mname fname; if_verbose msgnl (str" done]"); add_loaded_module mname with e -> @@ -305,7 +296,7 @@ let cache_ml_module_object (_,{mnames=mnames}) = let classify_ml_module_object ({mlocal=mlocal} as o) = if mlocal then Dispose else Substitute o -let (inMLModule,outMLModule) = +let inMLModule : ml_module_object -> obj = declare_object {(default_object "ML-MODULE") with load_function = (fun _ -> cache_ml_module_object); cache_function = cache_ml_module_object; diff --git a/toplevel/mltop.mli b/toplevel/mltop.mli index ae562bd2..1e9c3b03 100644 --- a/toplevel/mltop.mli +++ b/toplevel/mltop.mli @@ -1,14 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit; @@ -16,44 +14,44 @@ type toplevel = { add_dir : string -> unit; ml_loop : unit -> unit } -(* Sets and initializes a toplevel (if any) *) +(** Sets and initializes a toplevel (if any) *) val set_top : toplevel -> unit -(* Are we in a native version of Coq? *) +(** Are we in a native version of Coq? *) val is_native : bool -(* Removes the toplevel (if any) *) +(** Removes the toplevel (if any) *) val remove : unit -> unit -(* Tests if an Ocaml toplevel runs under Coq *) +(** Tests if an Ocaml toplevel runs under Coq *) val is_ocaml_top : unit -> bool -(* Tests if we can load ML files *) +(** Tests if we can load ML files *) val has_dynlink : bool -(* Starts the Ocaml toplevel loop *) +(** Starts the Ocaml toplevel loop *) val ocaml_toploop : unit -> unit -(* Dynamic loading of .cmo *) +(** Dynamic loading of .cmo *) val dir_ml_load : string -> unit -(* Dynamic interpretation of .ml *) +(** Dynamic interpretation of .ml *) val dir_ml_use : string -> unit -(* Adds a path to the ML paths *) +(** Adds a path to the ML paths *) val add_ml_dir : string -> unit val add_rec_ml_dir : string -> unit -(* Adds a path to the Coq and ML paths *) +(** Adds a path to the Coq and ML paths *) val add_path : unix_path:string -> coq_root:Names.dir_path -> unit val add_rec_path : unix_path:string -> coq_root:Names.dir_path -> unit -(* List of modules linked to the toplevel *) +(** List of modules linked to the toplevel *) val add_known_module : string -> unit val module_is_known : string -> bool -val load_object : string -> string -> unit +val load_ml_object : string -> string -> unit -(* Summary of Declared ML Modules *) +(** Summary of Declared ML Modules *) val get_loaded_modules : unit -> string list val add_loaded_module : string -> unit val init_ml_modules : unit -> unit @@ -63,8 +61,6 @@ type ml_module_object = { mlocal: Vernacexpr.locality_flag; mnames: string list; } -val inMLModule : ml_module_object -> Libobject.obj -val outMLModule : Libobject.obj -> ml_module_object val declare_ml_modules : Vernacexpr.locality_flag -> string list -> unit diff --git a/toplevel/record.ml b/toplevel/record.ml index ee9b8d66..86849cbb 100644 --- a/toplevel/record.ml +++ b/toplevel/record.ml @@ -1,20 +1,17 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* let impl, t' = interp_evars evars env impls Pretyping.IsType t in @@ -44,12 +41,12 @@ let interp_fields_evars evars env nots l = let impls = match i with | Anonymous -> impls - | Name id -> (id, compute_internalization_data env Constrintern.Method t' impl) :: impls + | Name id -> Idmap.add id (compute_internalization_data env Constrintern.Method t' impl) impls in let d = (i,b',t') in List.iter (Metasyntax.set_notation_for_interpretation impls) no; (push_rel d env, impl :: uimpls, d::params, impls)) - (env, [], [], []) nots l + (env, [], [], impls_env) nots l let binder_of_decl = function | Vernacexpr.AssumExpr(n,t) -> (n,None,t) @@ -60,11 +57,23 @@ let binders_of_decls = List.map binder_of_decl let typecheck_params_and_fields id t ps nots fs = let env0 = Global.env () in let evars = ref Evd.empty in - let (env1,newps), imps = interp_context_evars evars env0 ps in - let fullarity = it_mkProd_or_LetIn (Option.cata (fun x -> x) (new_Type ()) t) newps in + let _ = + let error bk (loc, name) = + match bk with + | Default _ -> + if name = Anonymous then + user_err_loc (loc, "record", str "Record parameters must be named") + | _ -> () + in + List.iter + (function LocalRawDef (b, _) -> error default_binder_kind b + | LocalRawAssum (ls, bk, ce) -> List.iter (error bk) ls) ps + in + let impls_env, ((env1,newps), imps) = interp_context_evars evars env0 ps in + let fullarity = it_mkProd_or_LetIn (Option.cata (fun x -> x) (Termops.new_Type ()) t) newps in let env_ar = push_rel_context newps (push_rel (Name id,None,fullarity) env0) in let env2,impls,newfs,data = - interp_fields_evars evars env_ar nots (binders_of_decls fs) + interp_fields_evars evars env_ar impls_env nots (binders_of_decls fs) in let evars = Evarconv.consider_remaining_unif_problems env_ar !evars in let evars = Typeclasses.resolve_typeclasses env_ar evars in @@ -153,7 +162,7 @@ let subst_projection fid l c = let instantiate_possibly_recursive_type indsp paramdecls fields = let subst = list_map_i (fun i _ -> mkRel i) 1 paramdecls in - substl_rel_context (subst@[mkInd indsp]) fields + Termops.substl_rel_context (subst@[mkInd indsp]) fields (* We build projections *) let declare_projections indsp ?(kind=StructureComponent) ?name coers fieldimpls fields = @@ -161,11 +170,11 @@ let declare_projections indsp ?(kind=StructureComponent) ?name coers fieldimpls let (mib,mip) = Global.lookup_inductive indsp in let paramdecls = mib.mind_params_ctxt in let r = mkInd indsp in - let rp = applist (r, extended_rel_list 0 paramdecls) in - let paramargs = extended_rel_list 1 paramdecls in (*def in [[params;x:rp]]*) + let rp = applist (r, Termops.extended_rel_list 0 paramdecls) in + let paramargs = Termops.extended_rel_list 1 paramdecls in (*def in [[params;x:rp]]*) let x = match name with Some n -> Name n | None -> Namegen.named_hd (Global.env()) r Anonymous in let fields = instantiate_possibly_recursive_type indsp paramdecls fields in - let lifted_fields = lift_rel_context 1 fields in + let lifted_fields = Termops.lift_rel_context 1 fields in let (_,kinds,sp_projs,_) = list_fold_left3 (fun (nfi,kinds,sp_projs,subst) coe (fi,optci,ti) impls -> @@ -194,11 +203,11 @@ let declare_projections indsp ?(kind=StructureComponent) ?name coers fieldimpls try let cie = { const_entry_body = proj; + const_entry_secctx = None; const_entry_type = Some projtyp; - const_entry_opaque = false; - const_entry_boxed = Flags.boxed_definitions() } in + const_entry_opaque = false } in let k = (DefinitionEntry cie,IsDefinition kind) in - let kn = declare_internal_constant fid k in + let kn = declare_constant ~internal:KernelSilent fid k in Flags.if_verbose message (string_of_id fid ^" is defined"); kn with Type_errors.TypeError (ctx,te) -> @@ -208,7 +217,7 @@ let declare_projections indsp ?(kind=StructureComponent) ?name coers fieldimpls Impargs.maybe_declare_manual_implicits false refi impls; if coe then begin let cl = Class.class_of_global (IndRef indsp) in - Class.try_add_new_coercion_with_source refi Global cl + Class.try_add_new_coercion_with_source refi Global ~source:cl end; let proj_args = (*Rel 1 refers to "x"*) paramargs@[mkRel 1] in let constr_fip = applist (constr_fi,proj_args) in @@ -239,7 +248,7 @@ open Typeclasses let declare_structure finite infer id idbuild paramimpls params arity fieldimpls fields ?(kind=StructureComponent) ?name is_coe coers sign = let nparams = List.length params and nfields = List.length fields in - let args = extended_rel_list nfields params in + let args = Termops.extended_rel_list nfields params in let ind = applist (mkRel (1+nparams+nfields), args) in let type_constructor = it_mkProd_or_LetIn ind fields in let mie_ind = @@ -253,7 +262,7 @@ let declare_structure finite infer id idbuild paramimpls params arity fieldimpls (* there is probably a way to push this to "declare_mutual" *) begin match finite with | BiFinite -> - if dependent (mkRel (nparams+1)) (it_mkProd_or_LetIn mkProp fields) then + if Termops.dependent (mkRel (nparams+1)) (it_mkProd_or_LetIn mkProp fields) then error "Records declared with the keyword Record or Structure cannot be recursive. Maybe you meant to define an Inductive or CoInductive record." | _ -> () end; @@ -282,18 +291,15 @@ let implicits_of_context ctx = in ExplByPos (i, explname), (true, true, true)) 1 (List.rev (Anonymous :: (List.map pi1 ctx))) -let qualid_of_con c = - Qualid (dummy_loc, shortest_qualid_of_global Idset.empty (ConstRef c)) - -let declare_instance_cst glob con = +let declare_instance_cst glob con pri = let instance = Typeops.type_of_constant (Global.env ()) con in let _, r = decompose_prod_assum instance in match class_of_constr r with - | Some tc -> add_instance (new_instance tc None glob (ConstRef con)) + | Some (_, (tc, _)) -> add_instance (new_instance tc pri glob (ConstRef con)) | None -> errorlabstrm "" (Pp.strbrk "Constant does not build instances of a declared type class.") let declare_class finite def infer id idbuild paramimpls params arity fieldimpls fields - ?(kind=StructureComponent) ?name is_coe coers sign = + ?(kind=StructureComponent) ?name is_coe coers priorities sign = let fieldimpls = (* Make the class and all params implicits in the projections *) let ctx_impls = implicits_of_context params in @@ -307,21 +313,21 @@ let declare_class finite def infer id idbuild paramimpls params arity fieldimpls let class_type = Option.map (fun ar -> it_mkProd_or_LetIn ar params) arity in let class_entry = { const_entry_body = class_body; + const_entry_secctx = None; const_entry_type = class_type; - const_entry_opaque = false; - const_entry_boxed = false } + const_entry_opaque = false } in let cst = Declare.declare_constant (snd id) (DefinitionEntry class_entry, IsDefinition Definition) in - let inst_type = appvectc (mkConst cst) (rel_vect 0 (List.length params)) in + let inst_type = appvectc (mkConst cst) (Termops.rel_vect 0 (List.length params)) in let proj_type = it_mkProd_or_LetIn (mkProd(Name (snd id), inst_type, lift 1 field)) params in let proj_body = it_mkLambda_or_LetIn (mkLambda (Name (snd id), inst_type, mkRel 1)) params in let proj_entry = { const_entry_body = proj_body; + const_entry_secctx = None; const_entry_type = Some proj_type; - const_entry_opaque = false; - const_entry_boxed = false } + const_entry_opaque = false } in let proj_cst = Declare.declare_constant proj_name (DefinitionEntry proj_entry, IsDefinition Definition) @@ -329,22 +335,27 @@ let declare_class finite def infer id idbuild paramimpls params arity fieldimpls let cref = ConstRef cst in Impargs.declare_manual_implicits false cref [paramimpls]; Impargs.declare_manual_implicits false (ConstRef proj_cst) [List.hd fieldimpls]; - Classes.set_typeclass_transparency (EvalConstRef cst) false; + Classes.set_typeclass_transparency (EvalConstRef cst) false false; if infer then Evd.fold (fun ev evi _ -> Recordops.declare_method (ConstRef cst) ev sign) sign (); - cref, [proj_name, Some proj_cst] + let sub = match List.hd coers with Some b -> Some ((if b then Backward else Forward), List.hd priorities) | None -> None in + cref, [Name proj_name, sub, Some proj_cst] | _ -> - let idarg = Namegen.next_ident_away (snd id) (ids_of_context (Global.env())) in + let idarg = Namegen.next_ident_away (snd id) (Termops.ids_of_context (Global.env())) in let ind = declare_structure BiFinite infer (snd id) idbuild paramimpls - params (Option.cata (fun x -> x) (new_Type ()) arity) fieldimpls fields + params (Option.default (Termops.new_Type ()) arity) fieldimpls fields ~kind:Method ~name:idarg false (List.map (fun _ -> false) fields) sign in - IndRef ind, (List.map2 (fun (id, _, _) y -> (Nameops.out_name id, y)) - (List.rev fields) (Recordops.lookup_projections ind)) + let coers = List.map2 (fun coe pri -> + Option.map (fun b -> if b then Backward, pri else Forward, pri) coe) + coers priorities + in + IndRef ind, (list_map3 (fun (id, _, _) b y -> (id, b, y)) + (List.rev fields) coers (Recordops.lookup_projections ind)) in let ctx_context = List.map (fun (na, b, t) -> match Typeclasses.class_of_constr t with - | Some cl -> Some (cl.cl_impl, true) (*List.exists (fun (_, n) -> n = na) supnames)*) + | Some (_, (cl, _)) -> Some (cl.cl_impl, true) (*List.exists (fun (_, n) -> n = na) supnames)*) | None -> None) params, params in @@ -354,9 +365,9 @@ let declare_class finite def infer id idbuild paramimpls params arity fieldimpls cl_props = fields; cl_projs = projs } in - List.iter2 (fun p sub -> - if sub then match snd p with Some p -> declare_instance_cst true p | None -> ()) - k.cl_projs coers; +(* list_iter3 (fun p sub pri -> *) +(* if sub then match p with (_, _, Some p) -> declare_instance_cst true p pri | _ -> ()) *) +(* k.cl_projs coers priorities; *) add_class k; impl let interp_and_check_sort sort = @@ -369,10 +380,12 @@ let interp_and_check_sort sort = open Vernacexpr open Autoinstance -(* [fs] corresponds to fields and [ps] to parameters; [coers] is a boolean - list telling if the corresponding fields must me declared as coercion *) +(* [fs] corresponds to fields and [ps] to parameters; [coers] is a + list telling if the corresponding fields must me declared as coercions + or subinstances *) let definition_structure (kind,finite,infer,(is_coe,(loc,idstruc)),ps,cfs,idbuild,s) = let cfs,notations = List.split cfs in + let cfs,priorities = List.split cfs in let coers,fs = List.split cfs in let extract_name acc = function Vernacexpr.AssumExpr((_,Name id),_) -> id::acc @@ -380,6 +393,8 @@ let definition_structure (kind,finite,infer,(is_coe,(loc,idstruc)),ps,cfs,idbuil | _ -> acc in let allnames = idstruc::(List.fold_left extract_name [] fs) in if not (list_distinct allnames) then error "Two objects have the same name"; + if not (kind = Class false) && List.exists ((<>) None) priorities then + error "Priorities only allowed for type class substructures"; (* Now, younger decl in params and fields is on top *) let sc = interp_and_check_sort s in let implpars, params, implfs, fields = @@ -389,13 +404,14 @@ let definition_structure (kind,finite,infer,(is_coe,(loc,idstruc)),ps,cfs,idbuil match kind with | Class def -> let gr = declare_class finite def infer (loc,idstruc) idbuild - implpars params sc implfs fields is_coe coers sign in + implpars params sc implfs fields is_coe coers priorities sign in if infer then search_record declare_class_instance gr sign; gr | _ -> - let arity = Option.default (new_Type ()) sc in + let arity = Option.default (Termops.new_Type ()) sc in let implfs = List.map (fun impls -> implpars @ Impargs.lift_implicits (succ (List.length params)) impls) implfs in - let ind = declare_structure finite infer idstruc idbuild implpars params arity implfs fields is_coe coers sign in + let ind = declare_structure finite infer idstruc idbuild implpars params arity implfs + fields is_coe (List.map (fun coe -> coe <> None) coers) sign in if infer then search_record declare_record_instance (ConstructRef (ind,1)) sign; IndRef ind diff --git a/toplevel/record.mli b/toplevel/record.mli index 44b34550..45670f1f 100644 --- a/toplevel/record.mli +++ b/toplevel/record.mli @@ -1,14 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* ?kind:Decl_kinds.definition_object_kind -> ?name:identifier -> - bool list -> manual_explicitation list list -> rel_context -> + coercion_flag list -> manual_explicitation list list -> rel_context -> (name * bool) list * constant option list val declare_structure : Decl_kinds.recursivity_kind -> - bool (*infer?*) -> identifier -> identifier -> - manual_explicitation list -> rel_context -> (* params *) constr -> (* arity *) - Impargs.manual_explicitation list list -> rel_context -> (* fields *) + bool (**infer?*) -> identifier -> identifier -> + manual_explicitation list -> rel_context -> (** params *) constr -> (** arity *) + Impargs.manual_explicitation list list -> rel_context -> (** fields *) ?kind:Decl_kinds.definition_object_kind -> ?name:identifier -> - bool -> (* coercion? *) - bool list -> (* field coercions *) + bool -> (** coercion? *) + bool list -> (** field coercions *) Evd.evar_map -> inductive val definition_structure : - inductive_kind * Decl_kinds.recursivity_kind * bool(*infer?*)* lident with_coercion * local_binder list * - (local_decl_expr with_coercion with_notation) list * + inductive_kind * Decl_kinds.recursivity_kind * bool(**infer?*)* lident with_coercion * local_binder list * + (local_decl_expr with_instance with_priority with_notation) list * identifier * constr_expr option -> global_reference diff --git a/toplevel/search.ml b/toplevel/search.ml index fd3024a4..33e8e51d 100644 --- a/toplevel/search.ml +++ b/toplevel/search.ml @@ -1,19 +1,17 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* env -> constr -> unit) = fn (VarRef id) env typ with Not_found -> (* we are in a section *) ()) | "CONSTANT" -> - let cst = Global.constant_of_delta(constant_of_kn kn) in + let cst = Global.constant_of_delta_kn kn in let typ = Typeops.type_of_constant env cst in if refopt = None || head_const typ = constr_of_global (Option.get refopt) then fn (ConstRef cst) env typ | "INDUCTIVE" -> - let mind = Global.mind_of_delta(mind_of_kn kn) in + let mind = Global.mind_of_delta_kn kn in let mib = Global.lookup_mind mind in (match refopt with | Some (IndRef ((kn',tyi) as ind)) when eq_mind mind kn' -> @@ -95,10 +103,6 @@ let rec head c = | LetIn (_,_,_,c) -> head c | _ -> c -let constr_to_full_path c = match kind_of_term c with - | Const sp -> sp - | _ -> raise No_full_path - let xor a b = (a or b) & (not (a & b)) let plain_display ref a c = @@ -170,6 +174,10 @@ let raw_search_by_head extra_filter display_function pattern = let name_of_reference ref = string_of_id (basename_of_global ref) +let full_name_of_reference ref = + let (dir,id) = repr_path (path_of_global ref) in + string_of_dirpath dir ^ "." ^ string_of_id id + (* * functions to use the new Libtypes facility *) @@ -196,20 +204,21 @@ let filter_by_module_from_list = function | [], _ -> (fun _ _ _ -> true) | l, outside -> filter_by_module l (not outside) -let filter_subproof gr _ _ = - not (string_string_contains (name_of_reference gr) "_subproof") && - not (string_string_contains (name_of_reference gr) "_admitted") +let filter_blacklist gr _ _ = + let name = full_name_of_reference gr in + let l = SearchBlacklist.elements () in + List.for_all (fun str -> not (string_string_contains ~where:name ~what:str)) l let (&&&&&) f g x y z = f x y z && g x y z let search_by_head pat inout = - text_search_by_head (filter_by_module_from_list inout &&&&& filter_subproof) pat + text_search_by_head (filter_by_module_from_list inout &&&&& filter_blacklist) pat let search_rewrite pat inout = - text_search_rewrite (filter_by_module_from_list inout &&&&& filter_subproof) pat + text_search_rewrite (filter_by_module_from_list inout &&&&& filter_blacklist) pat let search_pattern pat inout = - text_pattern_search (filter_by_module_from_list inout &&&&& filter_subproof) pat + text_pattern_search (filter_by_module_from_list inout &&&&& filter_blacklist) pat let gen_filtered_search filter_function display_function = gen_crible None @@ -223,13 +232,13 @@ type glob_search_about_item = let search_about_item (itemref,typ) = function | GlobSearchSubPattern pat -> is_matching_appsubterm ~closed:false pat typ - | GlobSearchString s -> string_string_contains (name_of_reference itemref) s + | GlobSearchString s -> string_string_contains ~where:(name_of_reference itemref) ~what:s let raw_search_about filter_modules display_function l = let filter ref' env typ = filter_modules ref' env typ && List.for_all (fun (b,i) -> b = search_about_item (ref',typ) i) l && - filter_subproof ref' () () + filter_blacklist ref' () () in gen_filtered_search filter display_function diff --git a/toplevel/search.mli b/toplevel/search.mli index 6a85a12f..d2d5c538 100644 --- a/toplevel/search.mli +++ b/toplevel/search.mli @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* dir_path list * bool -> unit val search_about : (bool * glob_search_about_item) list -> dir_path list * bool -> unit -(* The filtering function that is by standard search facilities. +(** The filtering function that is by standard search facilities. It can be passed as argument to the raw search functions. It is used in pcoq. *) val filter_by_module_from_list : dir_path list * bool -> global_reference -> env -> 'a -> bool -(* raw search functions can be used for various extensions. +(** raw search functions can be used for various extensions. They are also used for pcoq. *) val gen_filtered_search : (global_reference -> env -> constr -> bool) -> (global_reference -> env -> constr -> unit) -> unit diff --git a/toplevel/toplevel.ml b/toplevel/toplevel.ml index 9954ff56..699fd12f 100644 --- a/toplevel/toplevel.ml +++ b/toplevel/toplevel.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* () -(* emacs special character for prompt end (fast) detection. Prefer - (Char.chr 6) since it does not interfere with utf8. For - compatibility we let (Char.chr 249) as default for a while. *) +(* emacs special prompt tag for easy detection. No special character, + to avoid interfering with utf8. Compatibility code removed. *) -let emacs_prompt_startstring() = Printer.emacs_str "" "" +let emacs_prompt_startstring() = Printer.emacs_str "" -let emacs_prompt_endstring() = Printer.emacs_str (String.make 1 (Char.chr 249)) "" +let emacs_prompt_endstring() = Printer.emacs_str "" (* Read a char in an input channel, displaying a prompt at every beginning of line. *) @@ -165,26 +163,26 @@ let print_location_in_file s inlibrary fname loc = hov 0 (errstrm ++ str"Module " ++ str ("\""^fname^"\"") ++ spc() ++ str"characters " ++ Cerrors.print_loc loc) ++ fnl () else - let (bp,ep) = unloc loc in - let ic = open_in fname in - let rec line_of_pos lin bol cnt = - if cnt < bp then - if input_char ic == '\n' - then line_of_pos (lin + 1) (cnt +1) (cnt+1) - else line_of_pos lin bol (cnt+1) - else (lin, bol) - in - try - let (line, bol) = line_of_pos 1 0 0 in - close_in ic; - hov 0 (* No line break so as to follow emacs error message format *) - (errstrm ++ str"File " ++ str ("\""^fname^"\"") ++ - str", line " ++ int line ++ str", characters " ++ - Cerrors.print_loc (make_loc (bp-bol,ep-bol))) ++ str":" ++ - fnl () - with e -> - (close_in ic; - hov 1 (errstrm ++ spc() ++ str"(invalid location):") ++ fnl ()) + let (bp,ep) = unloc loc in + let ic = open_in fname in + let rec line_of_pos lin bol cnt = + if cnt < bp then + if input_char ic == '\n' + then line_of_pos (lin + 1) (cnt +1) (cnt+1) + else line_of_pos lin bol (cnt+1) + else (lin, bol) + in + try + let (line, bol) = line_of_pos 1 0 0 in + close_in ic; + hov 0 (* No line break so as to follow emacs error message format *) + (errstrm ++ str"File " ++ str ("\""^fname^"\"") ++ + str", line " ++ int line ++ str", characters " ++ + Cerrors.print_loc (make_loc (bp-bol,ep-bol))) ++ str":" ++ + fnl () + with e -> + (close_in ic; + hov 1 (errstrm ++ spc() ++ str"(invalid location):") ++ fnl ()) let print_command_location ib dloc = match dloc with @@ -274,7 +272,7 @@ let set_prompt prompt = let rec is_pervasive_exn = function | Out_of_memory | Stack_overflow | Sys.Break -> true | Error_in_file (_,_,e) -> is_pervasive_exn e - | Stdpp.Exc_located (_,e) -> is_pervasive_exn e + | Loc.Exc_located (_,e) -> is_pervasive_exn e | DuringCommandInterp (_,e) -> is_pervasive_exn e | _ -> false @@ -290,7 +288,7 @@ let print_toplevel_error exc = in let (locstrm,exc) = match exc with - | Stdpp.Exc_located (loc, ie) -> + | Loc.Exc_located (loc, ie) -> if valid_buffer_loc top_buffer dloc loc then (print_highlight_location top_buffer loc, ie) else @@ -310,13 +308,13 @@ let print_toplevel_error exc = raise Vernacexpr.Quit | _ -> (if is_pervasive_exn exc then (mt ()) else locstrm) ++ - Cerrors.explain_exn exc + Errors.print exc (* Read the input stream until a dot is encountered *) let parse_to_dot = - let rec dot st = match Stream.next st with - | ("", ".") -> () - | ("EOI", "") -> raise End_of_input + let rec dot st = match get_tok (Stream.next st) with + | Tok.KEYWORD "." -> () + | Tok.EOI -> raise End_of_input | _ -> dot st in Gram.Entry.of_parser "Coqtoplevel.dot" dot @@ -324,8 +322,8 @@ let parse_to_dot = (* We assume that when a lexer error occurs, at least one char was eaten *) let rec discard_to_dot () = try - Gram.Entry.parse parse_to_dot top_buffer.tokens - with Stdpp.Exc_located(_,(Token.Error _|Lexer.Error _)) -> + Gram.entry_parse parse_to_dot top_buffer.tokens + with Loc.Exc_located(_,(Token.Error _|Lexer.Error.E _)) -> discard_to_dot() diff --git a/toplevel/toplevel.mli b/toplevel/toplevel.mli index 022a6541..757aab1a 100644 --- a/toplevel/toplevel.mli +++ b/toplevel/toplevel.mli @@ -1,46 +1,42 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* string; - mutable str : string; (* buffer of already read characters *) - mutable len : int; (* number of chars in the buffer *) - mutable bols : int list; (* offsets in str of begining of lines *) - mutable tokens : Pcoq.Gram.parsable; (* stream of tokens *) - mutable start : int } (* stream count of the first char of the buffer *) + mutable str : string; (** buffer of already read characters *) + mutable len : int; (** number of chars in the buffer *) + mutable bols : int list; (** offsets in str of begining of lines *) + mutable tokens : Pcoq.Gram.parsable; (** stream of tokens *) + mutable start : int } (** stream count of the first char of the buffer *) -(* The input buffer of stdin. *) +(** The input buffer of stdin. *) val top_buffer : input_buffer val set_prompt : (unit -> string) -> unit -(* Toplevel error explanation, dealing with locations, Drop, Ctrl-D +(** Toplevel error explanation, dealing with locations, Drop, Ctrl-D May raise only the following exceptions: [Drop] and [End_of_input], meaning we get out of the Coq loop. *) val print_toplevel_error : exn -> std_ppcmds -(* Parse and execute a vernac command. *) +(** Parse and execute a vernac command. *) val do_vernac : unit -> unit -(* Main entry point of Coq: read and execute vernac commands. *) +(** Main entry point of Coq: read and execute vernac commands. *) val loop : unit -> unit diff --git a/toplevel/toplevel.mllib b/toplevel/toplevel.mllib index 4c229d16..8b03e938 100644 --- a/toplevel/toplevel.mllib +++ b/toplevel/toplevel.mllib @@ -18,6 +18,8 @@ Mltop Vernacentries Whelp Vernac +Ide_intf +Ide_slave Toplevel Usage Coqinit diff --git a/toplevel/usage.ml b/toplevel/usage.ml index 0282f30a..8c9b1078 100644 --- a/toplevel/usage.ml +++ b/toplevel/usage.ml @@ -1,18 +1,16 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* \n\n" let print_usage_coqc () = - print_usage "Usage: coqc file...\n -options are: - -verbose compile verbosely - -image f specify an alternative executable for Coq - -t keep temporary files\n\n" + print_usage "Usage: coqc file...\n\ +\noptions are:\ +\n -verbose compile verbosely\ +\n -image f specify an alternative executable for Coq\ +\n -t keep temporary files\n\n" (* Print the configuration information *) let print_config () = if Coq_config.local then Printf.printf "LOCAL=1\n" else Printf.printf "LOCAL=0\n"; - Printf.printf "COQLIB=%s/\n" Coq_config.coqlib; - Printf.printf "COQSRC=%s/\n" Coq_config.coqsrc; - Printf.printf "CAMLBIN=%s/\n" Coq_config.camlbin; - Printf.printf "CAMLLIB=%s/\n" Coq_config.camllib; + Printf.printf "COQLIB=%s/\n" (Envars.coqlib ()); + Printf.printf "DOCDIR=%s/\n" (Envars.docdir ()); + Printf.printf "OCAMLDEP=%s\n" Coq_config.ocamldep; + Printf.printf "OCAMLC=%s\n" Coq_config.ocamlc; + Printf.printf "OCAMLOPT=%s\n" Coq_config.ocamlopt; + Printf.printf "OCAMLDOC=%s\n" Coq_config.ocamldoc; + Printf.printf "CAMLBIN=%s/\n" (Envars.camlbin ()); + Printf.printf "CAMLLIB=%s/\n" (Envars.camllib ()); Printf.printf "CAMLP4=%s\n" Coq_config.camlp4; - Printf.printf "CAMLP4BIN=%s\n" Coq_config.camlp4bin; - Printf.printf "CAMLP4LIB=%s\n" Coq_config.camlp4lib - - + Printf.printf "CAMLP4BIN=%s/\n" (Envars.camlp4bin ()); + Printf.printf "CAMLP4LIB=%s\n" (Envars.camlp4lib ()); + Printf.printf "HASNATDYNLINK=%s\n" (if Coq_config.has_natdynlink then "true" else "false") diff --git a/toplevel/usage.mli b/toplevel/usage.mli index 721edccb..0b98f061 100644 --- a/toplevel/usage.mli +++ b/toplevel/usage.mli @@ -1,23 +1,21 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* 'a -val version : unit -> 'a - -(*s Prints the usage on the error output, preceeded by a user-provided message. *) +(** {6 Prints the usage on the error output, preceeded by a user-provided message. } *) val print_usage : string -> unit -(*s Prints the usage on the error output. *) +(** {6 Prints the usage on the error output. } *) val print_usage_coqtop : unit -> unit val print_usage_coqc : unit -> unit -(*s Prints the configuration information *) +(** {6 Prints the configuration information } *) val print_config : unit -> unit diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml index a7aef93f..84e20f5e 100644 --- a/toplevel/vernac.ml +++ b/toplevel/vernac.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* dummy_loc -> ((b, f, loc), e) - | Stdpp.Exc_located (loc, e) when loc <> dummy_loc -> + | Loc.Exc_located (loc, e) when loc <> dummy_loc -> ((false,file, loc), e) - | Stdpp.Exc_located (_, e) | e -> ((false,file,cmdloc), e) + | Loc.Exc_located (_, e) | e -> ((false,file,cmdloc), e) in raise (Error_in_file (file, inner, disable_drop inex)) let real_error = function - | Stdpp.Exc_located (_, e) -> e + | Loc.Exc_located (_, e) -> e | Error_in_file (_, _, e) -> e | e -> e @@ -62,6 +61,7 @@ let default_timeout = ref None let _ = Goptions.declare_int_option { Goptions.optsync = true; + Goptions.optdepr = false; Goptions.optname = "the default timeout"; Goptions.optkey = ["Default";"Timeout"]; Goptions.optread = (fun () -> !default_timeout); @@ -133,8 +133,8 @@ let verbose_phrase verbch loc = exception End_of_input -let parse_phrase (po, verbch) = - match Pcoq.Gram.Entry.parse Pcoq.main_entry po with +let parse_sentence (po, verbch) = + match Pcoq.Gram.entry_parse Pcoq.main_entry po with | Some (loc,_ as com) -> verbose_phrase verbch loc; com | None -> raise End_of_input @@ -211,10 +211,11 @@ let rec vernac_com interpfun (loc,com) = | HasNotFailed -> errorlabstrm "Fail" (str "The command has not failed !") | e -> - (* if [e] is an anomaly, the next function will re-raise it *) - let msg = Cerrors.explain_exn_no_anomaly e in - if_verbose msgnl (str "The command has indeed failed with message:" ++ - fnl () ++ str "=> " ++ hov 0 msg) + (* Anomalies are re-raised by the next line *) + let msg = Errors.print_no_anomaly e in + if_verbose msgnl + (str "The command has indeed failed with message:" ++ + fnl () ++ str "=> " ++ hov 0 msg) end | VernacTime v -> @@ -249,22 +250,21 @@ let rec vernac_com interpfun (loc,com) = Format.set_formatter_out_channel stdout; raise (DuringCommandInterp (loc, e)) -and vernac interpfun input = - vernac_com interpfun (parse_phrase input) - and read_vernac_file verbosely s = Flags.make_warn verbosely; let interpfun = - if verbosely then - Vernacentries.interp - else - Flags.silently Vernacentries.interp + if verbosely then Vernacentries.interp + else Flags.silently Vernacentries.interp in - let (in_chan, fname, input) = open_file_twice_if verbosely s in + let (in_chan, fname, input) = + open_file_twice_if verbosely s in try (* we go out of the following infinite loop when a End_of_input is * raised, which means that we raised the end of the file being loaded *) - while true do vernac interpfun input; pp_flush () done + while true do + vernac_com interpfun (parse_sentence input); + pp_flush () + done with e -> (* whatever the exception *) Format.set_formatter_out_channel stdout; close_input in_chan input; (* we must close the file first *) @@ -273,17 +273,20 @@ and read_vernac_file verbosely s = if do_beautify () then pr_new_syntax (make_loc (max_int,max_int)) None | _ -> raise_with_file fname e -(* raw_do_vernac : char Stream.t -> unit - * parses and executes one command of the vernacular char stream. - * Marks the end of the command in the lib_stk with a new label to - * make vernac undoing easier. Also freeze state to speed up - * backtracking. *) -let raw_do_vernac po = - vernac Vernacentries.interp (po,None); +(* eval_expr : Util.loc * Vernacexpr.vernac_expr -> unit + * execute one vernacular command. Marks the end of the command in the lib_stk + * with a new label to make vernac undoing easier. Also freeze state to speed up + * backtracking. *) +let eval_expr last = + vernac_com Vernacentries.interp last; Lib.add_frozen_state(); Lib.mark_end_of_command() +(* raw_do_vernac : Pcoq.Gram.parsable -> unit + * vernac_step . parse_sentence *) +let raw_do_vernac po = eval_expr (parse_sentence (po,None)) + (* XML output hooks *) let xml_start_library = ref (fun _ -> ()) let xml_end_library = ref (fun _ -> ()) @@ -305,15 +308,14 @@ let load_vernac verb file = (* Compile a vernac file (f is assumed without .v suffix) *) let compile verbosely f = let ldir,long_f_dot_v = Flags.verbosely Library.start_library f in - if Dumpglob.multi_dump () then - Dumpglob.open_glob_file (f ^ ".glob"); - Dumpglob.dump_string ("F" ^ Names.string_of_dirpath ldir ^ "\n"); - if !Flags.xml_export then !xml_start_library (); - let _ = load_vernac verbosely long_f_dot_v in - if Pfedit.get_all_proof_names () <> [] then - (message "Error: There are pending proofs"; exit 1); - if !Flags.xml_export then !xml_end_library (); - if Dumpglob.multi_dump () then Dumpglob.close_glob_file (); - Library.save_library_to ldir (long_f_dot_v ^ "o") + Dumpglob.start_dump_glob long_f_dot_v; + Dumpglob.dump_string ("F" ^ Names.string_of_dirpath ldir ^ "\n"); + if !Flags.xml_export then !xml_start_library (); + let _ = load_vernac verbosely long_f_dot_v in + if Pfedit.get_all_proof_names () <> [] then + (message "Error: There are pending proofs"; exit 1); + if !Flags.xml_export then !xml_end_library (); + Dumpglob.end_dump_glob (); + Library.save_library_to ldir (long_f_dot_v ^ "o") diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli index 54ce9244..d89e90d0 100644 --- a/toplevel/vernac.mli +++ b/toplevel/vernac.mli @@ -1,46 +1,39 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* - Util.loc * Vernacexpr.vernac_expr +val parse_sentence : Pcoq.Gram.parsable * in_channel option -> + Util.loc * Vernacexpr.vernac_expr -(* Reads and executes vernac commands from a stream. +(** Reads and executes vernac commands from a stream. The boolean [just_parsing] disables interpretation of commands. *) exception DuringCommandInterp of Util.loc * exn exception End_of_input val just_parsing : bool ref +val eval_expr : Util.loc * Vernacexpr.vernac_expr -> unit val raw_do_vernac : Pcoq.Gram.parsable -> unit -(* Set XML hooks *) +(** Set XML hooks *) val set_xml_start_library : (unit -> unit) -> unit val set_xml_end_library : (unit -> unit) -> unit -(* Load a vernac file, verbosely or not. Errors are annotated with file +(** Load a vernac file, verbosely or not. Errors are annotated with file and location *) val load_vernac : bool -> string -> unit -(* Compile a vernac file, verbosely or not (f is assumed without .v suffix) *) +(** Compile a vernac file, verbosely or not (f is assumed without .v suffix) *) val compile : bool -> string -> unit - -(* Interpret a vernac AST *) - -val vernac_com : - (Vernacexpr.vernac_expr -> unit) -> - Util.loc * Vernacexpr.vernac_expr -> unit diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml index 3be3c6db..5787feb0 100644 --- a/toplevel/vernacentries.ml +++ b/toplevel/vernacentries.ml @@ -1,13 +1,11 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* Environ.unsafe_judgment -> unit; print_eval : Reductionops.reduction_function -> Environ.env -> Evd.evar_map -> constr_expr -> Environ.unsafe_judgment -> unit; - show_goal : int option -> unit + show_goal : goal_reference -> unit } let pcoq = ref None @@ -66,52 +62,34 @@ let cl_of_qualid = function (* "Show" commands *) let show_proof () = - let pts = get_pftreestate () in - let cursor = cursor_of_pftreestate pts in - let evc = evc_of_pftreestate pts in - let (pfterm,meta_types) = extract_open_pftreestate pts in - msgnl (str"LOC: " ++ - prlist_with_sep pr_spc pr_int (List.rev cursor) ++ fnl () ++ - str"Subgoals" ++ fnl () ++ - prlist (fun (mv,ty) -> Nameops.pr_meta mv ++ str" -> " ++ - pr_ltype ty ++ fnl ()) - meta_types - ++ str"Proof: " ++ pr_lconstr (Evarutil.nf_evar evc pfterm)) + (* spiwack: this would probably be cooler with a bit of polishing. *) + let p = Proof_global.give_me_the_proof () in + let pprf = Proof.partial_proof p in + msgnl (Util.prlist_with_sep Pp.fnl Printer.pr_constr pprf) let show_node () = - let pts = get_pftreestate () in - let pf = proof_of_pftreestate pts - and cursor = cursor_of_pftreestate pts in - msgnl (prlist_with_sep pr_spc pr_int (List.rev cursor) ++ fnl () ++ - pr_goal (goal_of_proof pf) ++ fnl () ++ - (match pf.Proof_type.ref with - | None -> (str"BY ") - | Some(r,spfl) -> - (str"BY " ++ pr_rule r ++ fnl () ++ - str" " ++ - hov 0 (prlist_with_sep pr_fnl pr_goal - (List.map goal_of_proof spfl))))) + (* spiwack: I'm have little clue what this function used to do. I deactivated it, + could, possibly, be cleaned away. (Feb. 2010) *) + () let show_script () = - let pts = get_pftreestate () in - let pf = proof_of_pftreestate pts - and evc = evc_of_pftreestate pts in - msgnl_with !Pp_control.deep_ft (print_treescript evc pf) + (* spiwack: show_script is currently not working *) + () let show_thesis () = msgnl (anomaly "TODO" ) let show_top_evars () = + (* spiwack: new as of Feb. 2010: shows goal evars in addition to non-goal evars. *) let pfts = get_pftreestate () in - let gls = top_goal_of_pftreestate pfts in - let sigma = project gls in + let gls = Proof.V82.subgoals pfts in + let sigma = gls.Evd.sigma in msg (pr_evars_int 1 (Evarutil.non_instantiated sigma)) + let show_prooftree () = - let pts = get_pftreestate () in - let pf = proof_of_pftreestate pts - and evc = evc_of_pftreestate pts in - msg (print_proof evc (Global.named_context()) pf) + (* Spiwack: proof tree is currently not working *) + () let print_subgoals () = if_verbose (fun () -> msg (pr_open_subgoals ())) () @@ -119,7 +97,8 @@ let print_subgoals () = if_verbose (fun () -> msg (pr_open_subgoals ())) () let show_intro all = let pf = get_pftreestate() in - let gl = nth_goal_of_pftreestate 1 pf in + let {Evd.it=gls ; sigma=sigma} = Proof.V82.subgoals pf in + let gl = {Evd.it=List.hd gls ; sigma = sigma} in let l,_= decompose_prod_assum (strip_outer_cast (pf_concl gl)) in if all then @@ -131,13 +110,12 @@ let show_intro all = msgnl (pr_id (List.hd (Tactics.find_intro_names [n] gl))) with Failure "list_last" -> message "" -let id_of_name = function - | Names.Anonymous -> id_of_string "x" - | Names.Name x -> x - +(** Prepare a "match" template for a given inductive type. + For each branch of the match, we list the constructor name + followed by enough pattern variables. + [Not_found] is raised if the given string isn't the qualid of + a known inductive type. *) -(* Building of match expression *) -(* From ide/coq.ml *) let make_cases s = let qualified_name = Libnames.qualid_of_string s in let glob_ref = Nametab.locate qualified_name in @@ -147,36 +125,31 @@ let make_cases s = , {Declarations.mind_consnames = carr ; Declarations.mind_nf_lc = tarr } = Global.lookup_inductive i in Util.array_fold_right2 - (fun n t l -> - let (al,_) = Term.decompose_prod t in - let al,_ = Util.list_chop (List.length al - np) al in + (fun consname typ l -> + let al = List.rev (fst (Term.decompose_prod typ)) in + let al = Util.list_skipn np al in let rec rename avoid = function | [] -> [] | (n,_)::l -> - let n' = Namegen.next_ident_away_in_goal (id_of_name n) avoid in + let n' = Namegen.next_name_away_in_cases_pattern n avoid in string_of_id n' :: rename (n'::avoid) l in - let al' = rename [] (List.rev al) in - (string_of_id n :: al') :: l) + let al' = rename [] al in + (string_of_id consname :: al') :: l) carr tarr [] | _ -> raise Not_found +(** Textual display of a generic "match" template *) let show_match id = - try - let s = string_of_id (snd id) in - let patterns = List.rev (make_cases s) in - let cases = - List.fold_left - (fun acc x -> - match x with - | [] -> assert false - | [x] -> "| "^ x ^ " => \n" ^ acc - | x::l -> - "| " ^ List.fold_left (fun acc s -> acc ^ " " ^ s) x l - ^ " => \n" ^ acc) - "end" patterns in - msg (str ("match # with\n" ^ cases)) - with Not_found -> error "Unknown inductive type." + let patterns = + try make_cases (string_of_id (snd id)) + with Not_found -> error "Unknown inductive type." + in + let pr_branch l = + str "| " ++ hov 1 (prlist_with_sep spc str l) ++ str " =>" + in + msg (v 1 (str "match # with" ++ fnl () ++ + prlist_with_sep fnl pr_branch patterns ++ fnl ())) (* "Print" commands *) @@ -220,18 +193,55 @@ let print_modtype r = let (loc,qid) = qualid_of_reference r in try let kn = Nametab.locate_modtype qid in - msgnl (Printmod.print_modtype kn) - with - Not_found -> msgnl (str"Unknown Module Type " ++ pr_qualid qid) + msgnl (Printmod.print_modtype kn) + with Not_found -> + (* Is there a module of this name ? If yes we display its type *) + try + let mp = Nametab.locate_module qid in + msgnl (Printmod.print_module false mp) + with Not_found -> + msgnl (str"Unknown Module Type or Module " ++ pr_qualid qid) -let dump_universes s = +let dump_universes_gen g s = let output = open_out s in + let output_constraint, close = + if Filename.check_suffix s ".dot" || Filename.check_suffix s ".gv" then begin + (* the lazy unit is to handle errors while printing the first line *) + let init = lazy (Printf.fprintf output "digraph universes {\n") in + begin fun kind left right -> + let () = Lazy.force init in + match kind with + | Univ.Lt -> + Printf.fprintf output " \"%s\" -> \"%s\" [style=bold];\n" right left + | Univ.Le -> + Printf.fprintf output " \"%s\" -> \"%s\" [style=solid];\n" right left + | Univ.Eq -> + Printf.fprintf output " \"%s\" -> \"%s\" [style=dashed];\n" left right + end, begin fun () -> + if Lazy.lazy_is_val init then Printf.fprintf output "}\n"; + close_out output + end + end else begin + begin fun kind left right -> + let kind = match kind with + | Univ.Lt -> "<" + | Univ.Le -> "<=" + | Univ.Eq -> "=" + in Printf.fprintf output "%s %s %s ;\n" left kind right + end, (fun () -> close_out output) + end + in try - Univ.dump_universes output (Global.universes ()); - close_out output; + Univ.dump_universes output_constraint g; + close (); msgnl (str ("Universes written to file \""^s^"\".")) with - e -> close_out output; raise e + e -> close (); raise e + +let dump_universes sorted s = + let g = Global.universes () in + let g = if sorted then Univ.sort_universes g else g in + dump_universes_gen g s (*********************) (* "Locate" commands *) @@ -318,7 +328,7 @@ let start_proof_and_print k l hook = print_subgoals (); if !pcoq <> None then (Option.get !pcoq).start_proof () -let vernac_definition (local,boxed,k) (loc,id as lid) def hook = +let vernac_definition (local,k) (loc,id as lid) def hook = if local = Local then Dumpglob.dump_definition lid true "var" else Dumpglob.dump_definition lid false "def"; (match def with @@ -332,7 +342,7 @@ let vernac_definition (local,boxed,k) (loc,id as lid) def hook = | Some r -> let (evc,env)= get_current_context () in Some (interp_redexp env evc r) in - let ce,imps = interp_definition boxed bl red_option c typ_opt in + let ce,imps = interp_definition bl red_option c typ_opt in declare_definition id (local,k) ce imps hook) let vernac_start_proof kind l lettop hook = @@ -360,14 +370,10 @@ let vernac_end_proof = function the theories [??] *) let vernac_exact_proof c = - let pfs = top_of_tree (get_pftreestate()) in - let pf = proof_of_pftreestate pfs in - if (is_leaf_proof pf) then begin - by (Tactics.exact_proof c); - save_named true end - else - errorlabstrm "Vernacentries.ExactProof" - (strbrk "Command 'Proof ...' can only be used at the beginning of the proof.") + (* spiwack: for simplicity I do not enforce that "Proof proof_term" is + called only at the begining of a proof. *) + by (Tactics.exact_proof c); + save_named true let vernac_assumption kind l nl= let global = fst kind = Global in @@ -386,7 +392,7 @@ let vernac_record k finite infer struc binders sort nameopt cfs = Dumpglob.dump_definition lid false "constr"; id in if Dumpglob.dump () then ( Dumpglob.dump_definition (snd struc) false "rec"; - List.iter (fun ((_, x), _) -> + List.iter (fun (((_, x), _), _) -> match x with | Vernacexpr.AssumExpr ((loc, Name id), _) -> Dumpglob.dump_definition (loc,id) false "proj" | _ -> ()) cfs); @@ -409,7 +415,8 @@ let vernac_inductive finite infer indl = | [ ( id , bl , c , Class true, Constructors [l]), _ ] -> let f = let (coe, ((loc, id), ce)) = l in - ((coe, AssumExpr ((loc, Name id), ce)), []) + let coe' = if coe then Some true else None in + (((coe', AssumExpr ((loc, Name id), ce)), None), []) in vernac_record (Class true) finite infer id bl c None [f] | [ ( id , bl , c , Class true, _), _ ] -> Util.error "Definitional classes must have a single method" @@ -424,15 +431,15 @@ let vernac_inductive finite infer indl = let indl = List.map unpack indl in do_mutual_inductive indl (recursivity_flag_of_kind finite) -let vernac_fixpoint l b = +let vernac_fixpoint l = if Dumpglob.dump () then List.iter (fun ((lid, _, _, _, _), _) -> Dumpglob.dump_definition lid false "def") l; - do_fixpoint l b + do_fixpoint l -let vernac_cofixpoint l b = +let vernac_cofixpoint l = if Dumpglob.dump () then List.iter (fun ((lid, _, _, _), _) -> Dumpglob.dump_definition lid false "def") l; - do_cofixpoint l b + do_cofixpoint l let vernac_scheme = Indschemes.do_scheme @@ -585,10 +592,10 @@ let vernac_end_section (loc,_) = let vernac_end_segment (_,id as lid) = check_no_pending_proofs (); match Lib.find_opening_node id with - | Lib.OpenedModule (export,_,_) -> vernac_end_module export lid - | Lib.OpenedModtype _ -> vernac_end_modtype lid + | Lib.OpenedModule (false,export,_,_) -> vernac_end_module export lid + | Lib.OpenedModule (true,_,_,_) -> vernac_end_modtype lid | Lib.OpenedSection _ -> vernac_end_section lid - | _ -> anomaly "No more opened things" + | _ -> assert false (* Libraries *) @@ -608,13 +615,13 @@ let vernac_coercion stre ref qids qidt = let target = cl_of_qualid qidt in let source = cl_of_qualid qids in let ref' = smart_global ref in - Class.try_add_new_coercion_with_target ref' stre source target; + Class.try_add_new_coercion_with_target ref' stre ~source ~target; if_verbose msgnl (pr_global ref' ++ str " is now a coercion") let vernac_identity_coercion stre id qids qidt = let target = cl_of_qualid qidt in let source = cl_of_qualid qids in - Class.try_add_new_identity_coercion id stre source target + Class.try_add_new_identity_coercion id stre ~source ~target (* Type classes *) @@ -625,32 +632,32 @@ let vernac_instance abst glob sup inst props pri = let vernac_context l = Classes.context l -let vernac_declare_instance glob id = - Classes.declare_instance glob id +let vernac_declare_instances glob ids = + List.iter (fun (id) -> Classes.existing_instance glob id) ids let vernac_declare_class id = Classes.declare_class id (***********) (* Solving *) + +let command_focus = Proof.new_focus_kind () +let focus_command_cond = Proof.no_cond command_focus + + let vernac_solve n tcom b = if not (refining ()) then error "Unknown command of the non proof-editing mode."; - Decl_mode.check_not_proof_mode "Unknown proof instruction"; - begin - if b then - solve_nth n (Tacinterp.hide_interp tcom (get_end_tac ())) - else solve_nth n (Tacinterp.hide_interp tcom None) - end; - (* in case a strict subtree was completed, - go back to the top of the prooftree *) - if subtree_solved () then begin - Flags.if_verbose msgnl (str "Subgoal proved"); - make_focus 0; - reset_top_of_script () - end; - print_subgoals(); - if !pcoq <> None then (Option.get !pcoq).solve n + let p = Proof_global.give_me_the_proof () in + Proof.transaction p begin fun () -> + solve_nth n (Tacinterp.hide_interp tcom None) ~with_end_tac:b; + (* in case a strict subtree was completed, + go back to the top of the prooftree *) + Proof_global.maximal_unfocus command_focus p; + print_subgoals(); + if !pcoq <> None then (Option.get !pcoq).solve n + end + (* A command which should be a tactic. It has been added by Christine to patch an error in the design of the proof @@ -666,32 +673,15 @@ let vernac_set_end_tac tac = if tac <> (Tacexpr.TacId []) then set_end_tac (Tacinterp.interp tac) else () (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*) -(***********************) -(* Proof Language Mode *) - -let vernac_decl_proof () = - check_not_proof_mode "Already in Proof Mode"; - if tree_solved () then - error "Nothing left to prove here." - else - begin - Decl_proof_instr.go_to_proof_mode (); - print_subgoals () - end - -let vernac_return () = - match get_current_mode () with - Mode_tactic -> - Decl_proof_instr.return_from_tactic_mode (); - print_subgoals () - | Mode_proof -> - error "\"return\" is only used after \"escape\"." - | Mode_none -> - error "There is no proof to end." - -let vernac_proof_instr instr = - Decl_proof_instr.proof_instr instr; - print_subgoals () +let vernac_set_used_variables l = + let l = List.map snd l in + if not (list_distinct l) then error "Used variables list contains duplicates"; + let vars = Environ.named_context (Global.env ()) in + List.iter (fun id -> + if not (List.exists (fun (id',_,_) -> id = id') vars) then + error ("Unknown variable: " ^ string_of_id id)) + l; + set_used_variables l (*****************************) (* Auxiliary file management *) @@ -706,7 +696,7 @@ let vernac_add_loadpath isrec pdir ldiropt = let alias = match ldiropt with | None -> Nameops.default_root_prefix | Some ldir -> ldir in - (if isrec then Mltop.add_rec_path else Mltop.add_path) pdir alias + (if isrec then Mltop.add_rec_path else Mltop.add_path) ~unix_path:pdir ~coq_root:alias let vernac_remove_loadpath path = Library.remove_load_path (System.expand_path_macros path) @@ -764,6 +754,9 @@ let vernac_declare_tactic_definition (local,x,def) = let vernac_create_hintdb local id b = Auto.create_hint_db local id full_transparent_state b +let vernac_remove_hints local dbs ids = + Auto.remove_hints local dbs (List.map Smartlocate.global_with_alias ids) + let vernac_hints local lb h = Auto.add_hints local lb (Auto.interp_hints h) @@ -778,11 +771,89 @@ let vernac_declare_implicits local r = function Impargs.declare_manual_implicits local (smart_global r) ~enriching:false (List.map (List.map (fun (ex,b,f) -> ex, (b,true,f))) imps) +let vernac_declare_arguments local r l nargs flags = + let names = List.map (List.map (fun (id, _,_,_,_) -> id)) l in + let names, rest = List.hd names, List.tl names in + if List.exists ((<>) names) rest then + error "All arguments lists must declare the same names."; + if not (Util.list_distinct (List.filter ((<>) Anonymous) names)) then + error "Arguments names must be distinct."; + let sr = smart_global r in + let inf_names = + Impargs.compute_implicits_names (Global.env()) (Global.type_of_global sr) in + let string_of_name = function Anonymous -> "_" | Name id -> string_of_id id in + let rec check li ld = match li, ld with + | [], [] -> () + | [], x::_ -> error ("Extra argument " ^ string_of_name x ^ ".") + | l, [] -> error ("The following arguments are not declared: " ^ + (String.concat ", " (List.map string_of_name l)) ^ ".") + | _::li, _::ld -> check li ld in + if l <> [[]] then + List.iter (fun l -> check inf_names l) (names :: rest); + (* we interpret _ as the inferred names *) + let l = if l = [[]] then l else + let name_anons = function + | (Anonymous, a,b,c,d), Name id -> Name id, a,b,c,d + | x, _ -> x in + List.map (fun ns -> List.map name_anons (List.combine ns inf_names)) l in + let names_decl = List.map (List.map (fun (id, _,_,_,_) -> id)) l in + let some_renaming_specified = + try Arguments_renaming.arguments_names sr <> names_decl + with Not_found -> false in + let some_renaming_specified, implicits = + if l = [[]] then false, [[]] else + Util.list_fold_map (fun sr il -> + let sr', impl = Util.list_fold_map (fun b -> function + | (Anonymous, _,_, true, max), Name id -> assert false + | (Name x, _,_, true, _), Anonymous -> + error ("Argument "^string_of_id x^" cannot be declared implicit.") + | (Name iid, _,_, true, max), Name id -> + b || iid <> id, Some (ExplByName id, max, false) + | (Name iid, _,_, _, _), Name id -> b || iid <> id, None + | _ -> b, None) + sr (List.combine il inf_names) in + sr || sr', Util.list_map_filter (fun x -> x) impl) + some_renaming_specified l in + if some_renaming_specified then + if not (List.mem `Rename flags) then + error "To rename arguments the \"rename\" flag must be specified." + else Arguments_renaming.rename_arguments local sr names_decl; + (* All other infos are in the first item of l *) + let l = List.hd l in + let some_implicits_specified = implicits <> [[]] in + let scopes = List.map (function + | (_,_, None,_,_) -> None + | (_,_, Some (o, k), _,_) -> + try Some(ignore(Notation.find_scope k); k) + with _ -> Some (Notation.find_delimiters_scope o k)) l in + let some_scopes_specified = List.exists ((<>) None) scopes in + let rargs = + Util.list_map_filter (function (n, true) -> Some n | _ -> None) + (Util.list_map_i (fun i (_, b, _,_,_) -> i, b) 0 l) in + if some_scopes_specified || List.mem `ClearScopes flags then + vernac_arguments_scope local r scopes; + if not some_implicits_specified && List.mem `DefaultImplicits flags then + vernac_declare_implicits local r [] + else if some_implicits_specified || List.mem `ClearImplicits flags then + vernac_declare_implicits local r implicits; + if nargs >= 0 && nargs < List.fold_left max 0 rargs then + error "The \"/\" option must be placed after the last \"!\"."; + let rec narrow = function + | #Tacred.simpl_flag as x :: tl -> x :: narrow tl + | [] -> [] | _ :: tl -> narrow tl in + let flags = narrow flags in + if rargs <> [] || nargs >= 0 || flags <> [] then + match sr with + | ConstRef _ as c -> + Tacred.set_simpl_behaviour local c (rargs, nargs, flags) + | _ -> errorlabstrm "" (strbrk "Modifiers of the behavior of the simpl tactic are relevant for constants only.") + let vernac_reserve bl = let sb_decl = (fun (idl,c) -> let t = Constrintern.interp_type Evd.empty (Global.env()) c in - let t = Detyping.detype false [] [] t in - List.iter (fun id -> Reserve.declare_reserved_type id t) idl) + let t = Detyping.detype false [] [] t in + let t = aconstr_of_glob_constr [] [] t in + Reserve.declare_reserved_type idl t) in List.iter sb_decl bl let vernac_generalizable = Implicit_quantifiers.declare_generalizable @@ -795,6 +866,7 @@ let make_silent_if_not_pcoq b = let _ = declare_bool_option { optsync = false; + optdepr = false; optname = "silent"; optkey = ["Silent"]; optread = is_silent; @@ -803,6 +875,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "implicit arguments"; optkey = ["Implicit";"Arguments"]; optread = Impargs.is_implicit_args; @@ -811,6 +884,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "strict implicit arguments"; optkey = ["Strict";"Implicit"]; optread = Impargs.is_strict_implicit_args; @@ -819,6 +893,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "strong strict implicit arguments"; optkey = ["Strongly";"Strict";"Implicit"]; optread = Impargs.is_strongly_strict_implicit_args; @@ -827,22 +902,16 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "contextual implicit arguments"; optkey = ["Contextual";"Implicit"]; optread = Impargs.is_contextual_implicit_args; optwrite = Impargs.make_contextual_implicit_args } -(* let _ = *) -(* declare_bool_option *) -(* { optsync = true; *) -(* optname = "forceable implicit arguments"; *) -(* optkey = ["Forceable";"Implicit")); *) -(* optread = Impargs.is_forceable_implicit_args; *) -(* optwrite = Impargs.make_forceable_implicit_args } *) - let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "implicit status of reversible patterns"; optkey = ["Reversible";"Pattern";"Implicit"]; optread = Impargs.is_reversible_pattern_implicit_args; @@ -851,6 +920,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "maximal insertion of implicit"; optkey = ["Maximal";"Implicit";"Insertion"]; optread = Impargs.is_maximal_implicit_args; @@ -859,6 +929,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "automatic introduction of variables"; optkey = ["Automatic";"Introduction"]; optread = Flags.is_auto_intros; @@ -867,6 +938,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "coercion printing"; optkey = ["Printing";"Coercions"]; optread = (fun () -> !Constrextern.print_coercions); @@ -875,6 +947,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "printing of existential variable instances"; optkey = ["Printing";"Existential";"Instances"]; optread = (fun () -> !Constrextern.print_evar_arguments); @@ -882,6 +955,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "implicit arguments printing"; optkey = ["Printing";"Implicit"]; optread = (fun () -> !Constrextern.print_implicits); @@ -890,6 +964,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "implicit arguments defensive printing"; optkey = ["Printing";"Implicit";"Defensive"]; optread = (fun () -> !Constrextern.print_implicits_defensive); @@ -898,6 +973,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "projection printing using dot notation"; optkey = ["Printing";"Projections"]; optread = (fun () -> !Constrextern.print_projections); @@ -906,6 +982,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "notations printing"; optkey = ["Printing";"Notations"]; optread = (fun () -> not !Constrextern.print_no_symbol); @@ -914,6 +991,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "raw printing"; optkey = ["Printing";"All"]; optread = (fun () -> !Flags.raw_print); @@ -922,38 +1000,57 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; + optname = "record printing"; + optkey = ["Printing";"Records"]; + optread = (fun () -> !Flags.record_print); + optwrite = (fun b -> Flags.record_print := b) } + +let _ = + declare_bool_option + { optsync = true; + optdepr = false; optname = "use of virtual machine inside the kernel"; optkey = ["Virtual";"Machine"]; optread = (fun () -> Vconv.use_vm ()); optwrite = (fun b -> Vconv.set_use_vm b) } let _ = - declare_bool_option + declare_int_option { optsync = true; - optname = "use of boxed definitions"; - optkey = ["Boxed";"Definitions"]; - optread = Flags.boxed_definitions; - optwrite = (fun b -> Flags.set_boxed_definitions b) } + optdepr = false; + optname = "the level of inling duging functor application"; + optkey = ["Inline";"Level"]; + optread = (fun () -> Some (Flags.get_inline_level ())); + optwrite = (fun o -> + let lev = Option.default Flags.default_inline_level o in + Flags.set_inline_level lev) } let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "use of boxed values"; optkey = ["Boxed";"Values"]; optread = (fun _ -> not (Vm.transp_values ())); optwrite = (fun b -> Vm.set_transp_values (not b)) } +(* No more undo limit in the new proof engine. + The command still exists for compatibility (e.g. with ProofGeneral) *) + let _ = declare_int_option { optsync = false; - optname = "the undo limit"; + optdepr = true; + optname = "the undo limit (OBSOLETE)"; optkey = ["Undo"]; - optread = Pfedit.get_undo; - optwrite = Pfedit.set_undo } + optread = (fun _ -> None); + optwrite = (fun _ -> ()) } let _ = declare_int_option { optsync = false; + optdepr = false; optname = "the hypotheses limit"; optkey = ["Hyps";"Limit"]; optread = Flags.print_hyps_limit; @@ -962,6 +1059,7 @@ let _ = let _ = declare_int_option { optsync = true; + optdepr = false; optname = "the printing depth"; optkey = ["Printing";"Depth"]; optread = Pp_control.get_depth_boxes; @@ -970,6 +1068,7 @@ let _ = let _ = declare_int_option { optsync = true; + optdepr = false; optname = "the printing width"; optkey = ["Printing";"Width"]; optread = Pp_control.get_margin; @@ -978,6 +1077,7 @@ let _ = let _ = declare_bool_option { optsync = true; + optdepr = false; optname = "printing of universes"; optkey = ["Printing";"Universes"]; optread = (fun () -> !Constrextern.print_universes); @@ -989,6 +1089,7 @@ let vernac_debug b = let _ = declare_bool_option { optsync = false; + optdepr = false; optname = "Ltac debug"; optkey = ["Ltac";"Debug"]; optread = (fun () -> get_debug () <> Tactic_debug.DebugOff); @@ -1006,7 +1107,7 @@ let vernac_set_opacity local str = let vernac_set_option locality key = function | StringValue s -> set_string_option_value_gen locality key s - | IntValue n -> set_int_option_value_gen locality key (Some n) + | IntValue n -> set_int_option_value_gen locality key n | BoolValue b -> set_bool_option_value_gen locality key b let vernac_unset_option locality key = @@ -1046,18 +1147,25 @@ let get_current_context_of_args = function | None -> get_current_context () let vernac_check_may_eval redexp glopt rc = - let (evmap,env) = get_current_context_of_args glopt in - let c = interp_constr evmap env rc in - let j = Typeops.typing env c in + let module P = Pretype_errors in + let (sigma, env) = get_current_context_of_args glopt in + let sigma', c = interp_open_constr sigma env rc in + let j = + try + Evarutil.check_evars env sigma sigma' c; + Arguments_renaming.rename_typing env c + with P.PretypeError (_,_,P.UnsolvableImplicit _) + | Compat.Loc.Exc_located (_,P.PretypeError (_,_,P.UnsolvableImplicit _)) -> + Evarutil.j_nf_evar sigma' (Retyping.get_judgment_of env sigma' c) in match redexp with | None -> if !pcoq <> None then (Option.get !pcoq).print_check env j else msg (print_judgment env j) | Some r -> - let redfun = fst (reduction_of_red_expr (interp_redexp env evmap r)) in + let redfun = fst (reduction_of_red_expr (interp_redexp env sigma' r)) in if !pcoq <> None - then (Option.get !pcoq).print_eval redfun env evmap rc j - else msg (print_eval redfun env evmap rc j) + then (Option.get !pcoq).print_eval redfun env sigma' rc j + else msg (print_eval redfun env sigma' rc j) let vernac_declare_reduction locality s r = declare_red_expr locality s (interp_redexp (Global.env()) Evd.empty r) @@ -1095,19 +1203,22 @@ let vernac_print = function | PrintCoercionPaths (cls,clt) -> ppnl (Prettyp.print_path_between (cl_of_qualid cls) (cl_of_qualid clt)) | PrintCanonicalConversions -> ppnl (Prettyp.print_canonical_projections ()) - | PrintUniverses None -> pp (Univ.pr_universes (Global.universes ())) - | PrintUniverses (Some s) -> dump_universes s + | PrintUniverses (b, None) -> + let univ = Global.universes () in + let univ = if b then Univ.sort_universes univ else univ in + pp (Univ.pr_universes univ) + | PrintUniverses (b, Some s) -> dump_universes b s | PrintHint r -> Auto.print_hint_ref (smart_global r) | PrintHintGoal -> Auto.print_applicable_hint () | PrintHintDbName s -> Auto.print_hint_db_by_name s | PrintRewriteHintDbName s -> Autorewrite.print_rewrite_hintdb s | PrintHintDb -> Auto.print_searchtable () | PrintScopes -> - pp (Notation.pr_scopes (Constrextern.without_symbols pr_lrawconstr)) + pp (Notation.pr_scopes (Constrextern.without_symbols pr_lglob_constr)) | PrintScope s -> - pp (Notation.pr_scope (Constrextern.without_symbols pr_lrawconstr) s) + pp (Notation.pr_scope (Constrextern.without_symbols pr_lglob_constr) s) | PrintVisibility s -> - pp (Notation.pr_visibility (Constrextern.without_symbols pr_lrawconstr) s) + pp (Notation.pr_visibility (Constrextern.without_symbols pr_lglob_constr) s) | PrintAbout qid -> msg (print_about qid) | PrintImplicit qid -> msg (print_impargs qid) | PrintAssumptions (o,r) -> @@ -1145,7 +1256,7 @@ let interp_search_about_item = function (fun _ -> true) s sc in GlobSearchSubPattern (Pattern.PRef ref) with UserError _ -> - error ("Unable to interp \""^s^"\" either as a reference or + error ("Unable to interp \""^s^"\" either as a reference or \ as an identifier component") let vernac_search s r = @@ -1169,7 +1280,7 @@ let vernac_locate = function | LocateTerm (Genarg.ByNotation (_,ntn,sc)) -> ppnl (Notation.locate_notation - (Constrextern.without_symbols pr_lrawconstr) ntn sc) + (Constrextern.without_symbols pr_lglob_constr) ntn sc) | LocateLibrary qid -> print_located_library qid | LocateModule qid -> print_located_module qid | LocateTactic qid -> print_located_tactic qid @@ -1178,16 +1289,6 @@ let vernac_locate = function (********************) (* Proof management *) -let vernac_goal = function - | None -> () - | Some c -> - if not (refining()) then begin - let unnamed_kind = Lemma (* Arbitrary *) in - start_proof_com (Global, Proof unnamed_kind) [None,c] (fun _ _ ->()); - print_subgoals () - end else - error "repeated Goal not permitted in refining mode." - let vernac_abort = function | None -> delete_current_proof (); @@ -1229,48 +1330,58 @@ let vernac_backtrack snum pnum naborts = vernac_backto snum; Pp.flush_all(); (* there may be no proof in progress, even if no abort *) - (try print_subgoals () with UserError _ -> ()) + (try print_subgoals () with Proof_global.NoCurrentProof | UserError _ -> ()) let vernac_focus gln = - check_not_proof_mode "No focussing or Unfocussing in Proof Mode."; + let p = Proof_global.give_me_the_proof () in match gln with - | None -> traverse_nth_goal 1; print_subgoals () - | Some n -> traverse_nth_goal n; print_subgoals () + | None -> Proof.focus focus_command_cond () 1 p; print_subgoals () + | Some n -> Proof.focus focus_command_cond () n p; print_subgoals () + - (* Reset the focus to the top of the tree *) + (* Unfocuses one step in the focus stack. *) let vernac_unfocus () = - check_not_proof_mode "No focussing or Unfocussing in Proof Mode."; - make_focus 0; reset_top_of_script (); print_subgoals () - -let vernac_go = function - | GoTo n -> Pfedit.traverse n;show_node() - | GoTop -> Pfedit.reset_top_of_tree ();show_node() - | GoNext -> Pfedit.traverse_next_unproven ();show_node() - | GoPrev -> Pfedit.traverse_prev_unproven ();show_node() - -let apply_subproof f occ = - let pts = get_pftreestate() in - let evc = evc_of_pftreestate pts in - let rec aux pts = function - | [] -> pts - | (n::l) -> aux (Tacmach.traverse n pts) occ in - let pts = aux pts (occ@[-1]) in - let pf = proof_of_pftreestate pts in - f evc (Global.named_context()) pf - -let explain_proof occ = - msg (apply_subproof (fun evd _ -> print_treescript evd) occ) - -let explain_tree occ = - msg (apply_subproof print_proof occ) + let p = Proof_global.give_me_the_proof () in + Proof.unfocus command_focus p; print_subgoals () + +(* BeginSubproof / EndSubproof. + BeginSubproof (vernac_subproof) focuses on the first goal, or the goal + given as argument. + EndSubproof (vernac_end_subproof) unfocuses from a BeginSubproof, provided + that the proof of the goal has been completed. +*) +let subproof_kind = Proof.new_focus_kind () +let subproof_cond = Proof.done_cond subproof_kind + +let vernac_subproof gln = + let p = Proof_global.give_me_the_proof () in + begin match gln with + | None -> Proof.focus subproof_cond () 1 p + | Some n -> Proof.focus subproof_cond () n p + end ; + print_subgoals () + +let vernac_end_subproof () = + let p = Proof_global.give_me_the_proof () in + Proof.unfocus subproof_kind p ; print_subgoals () + + +let vernac_bullet (bullet:Proof_global.Bullet.t) = + let p = Proof_global.give_me_the_proof () in + Proof.transaction p + (fun () -> Proof_global.Bullet.put p bullet); + (* Makes the focus visible in emacs by re-printing the goal. *) + if !Flags.print_emacs then print_subgoals () + let vernac_show = function - | ShowGoal nopt -> - if !pcoq <> None then (Option.get !pcoq).show_goal nopt - else msg (match nopt with - | None -> pr_open_subgoals () - | Some n -> pr_nth_open_subgoal n) + | ShowGoal goalref -> + if !pcoq <> None then (Option.get !pcoq).show_goal goalref + else msg (match goalref with + | OpenSubgoals -> pr_open_subgoals () + | NthGoal n -> pr_nth_open_subgoal n + | GoalId id -> pr_goal_by_id id) | ShowGoalImplicitly None -> Constrextern.with_implicits msg (pr_open_subgoals ()) | ShowGoalImplicitly (Some n) -> @@ -1285,17 +1396,15 @@ let vernac_show = function | ShowIntros all -> show_intro all | ShowMatch id -> show_match id | ShowThesis -> show_thesis () - | ExplainProof occ -> explain_proof occ - | ExplainTree occ -> explain_tree occ let vernac_check_guard () = let pts = get_pftreestate () in - let pf = proof_of_pftreestate pts in - let (pfterm,_) = extract_open_pftreestate pts in + let pfterm = List.hd (Proof.partial_proof pts) in let message = try - Inductiveops.control_only_guard (Evd.evar_env (goal_of_proof pf)) + let { Evd.it=gl ; sigma=sigma } = Proof.V82.top_goal pts in + Inductiveops.control_only_guard (Goal.V82.env sigma gl) pfterm; (str "The condition holds up to here") with UserError(_,s) -> @@ -1325,8 +1434,8 @@ let interp c = match c with | VernacExactProof c -> vernac_exact_proof c | VernacAssumption (stre,nl,l) -> vernac_assumption stre l nl | VernacInductive (finite,infer,l) -> vernac_inductive finite infer l - | VernacFixpoint (l,b) -> vernac_fixpoint l b - | VernacCoFixpoint (l,b) -> vernac_cofixpoint l b + | VernacFixpoint l -> vernac_fixpoint l + | VernacCoFixpoint l -> vernac_cofixpoint l | VernacScheme l -> vernac_scheme l | VernacCombinedScheme (id, l) -> vernac_combined_scheme id l @@ -1354,21 +1463,13 @@ let interp c = match c with | VernacInstance (abst, glob, sup, inst, props, pri) -> vernac_instance abst glob sup inst props pri | VernacContext sup -> vernac_context sup - | VernacDeclareInstance (glob, id) -> vernac_declare_instance glob id + | VernacDeclareInstances (glob, ids) -> vernac_declare_instances glob ids | VernacDeclareClass id -> vernac_declare_class id (* Solving *) | VernacSolve (n,tac,b) -> vernac_solve n tac b | VernacSolveExistential (n,c) -> vernac_solve_existential n c - (* MMode *) - - | VernacDeclProof -> vernac_decl_proof () - | VernacReturn -> vernac_return () - | VernacProofInstr stp -> vernac_proof_instr stp - - (* /MMode *) - (* Auxiliary file and library management *) | VernacRequireFrom (exp,spec,f) -> vernac_require_from exp spec f | VernacAddLoadPath (isrec,s,alias) -> vernac_add_loadpath isrec s alias @@ -1391,9 +1492,11 @@ let interp c = match c with (* Commands *) | VernacDeclareTacticDefinition def -> vernac_declare_tactic_definition def | VernacCreateHintDb (local,dbname,b) -> vernac_create_hintdb local dbname b + | VernacRemoveHints (local,dbnames,ids) -> vernac_remove_hints local dbnames ids | VernacHints (local,dbnames,hints) -> vernac_hints local dbnames hints | VernacSyntacticDefinition (id,c,l,b) ->vernac_syntactic_definition id c l b | VernacDeclareImplicits (local,qid,l) ->vernac_declare_implicits local qid l + | VernacArguments (local, qid, l, narg, flags) -> vernac_declare_arguments local qid l narg flags | VernacReserve bl -> vernac_reserve bl | VernacGeneralizable (local,gen) -> vernac_generalizable local gen | VernacSetOpacity (local,qidl) -> vernac_set_opacity local qidl @@ -1424,10 +1527,17 @@ let interp c = match c with | VernacBacktrack (snum,pnum,naborts) -> vernac_backtrack snum pnum naborts | VernacFocus n -> vernac_focus n | VernacUnfocus -> vernac_unfocus () - | VernacGo g -> vernac_go g + | VernacBullet b -> vernac_bullet b + | VernacSubproof n -> vernac_subproof n + | VernacEndSubproof -> vernac_end_subproof () | VernacShow s -> vernac_show s | VernacCheckGuard -> vernac_check_guard () - | VernacProof tac -> vernac_set_end_tac tac + | VernacProof (None, None) -> () + | VernacProof (Some tac, None) -> vernac_set_end_tac tac + | VernacProof (None, Some l) -> vernac_set_used_variables l + | VernacProof (Some tac, Some l) -> + vernac_set_end_tac tac; vernac_set_used_variables l + | VernacProofMode mn -> Proof_global.set_proof_mode mn (* Toplevel control *) | VernacToplevelControl e -> raise e diff --git a/toplevel/vernacentries.mli b/toplevel/vernacentries.mli index 1cca3540..8fb6f466 100644 --- a/toplevel/vernacentries.mli +++ b/toplevel/vernacentries.mli @@ -1,34 +1,31 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* unit val show_prooftree : unit -> unit val show_node : unit -> unit -(* This function can be used by any command that want to observe terms +(** This function can be used by any command that want to observe terms in the context of the current goal, as for instance in pcoq *) val get_current_context_of_args : int option -> Evd.evar_map * Environ.env (*i -(* this function is used to analyse the extra arguments in search commands. + +(** this function is used to analyse the extra arguments in search commands. It is used in pcoq. *) (*i anciennement: inside_outside i*) val interp_search_restriction : search_restriction -> dir_path list * bool i*) @@ -42,12 +39,12 @@ type pcoq_hook = { print_check : Environ.env -> Environ.unsafe_judgment -> unit; print_eval : Reductionops.reduction_function -> Environ.env -> Evd.evar_map -> constr_expr -> Environ.unsafe_judgment -> unit; - show_goal : int option -> unit + show_goal : goal_reference -> unit } val set_pcoq_hook : pcoq_hook -> unit -(* This function makes sure that the function given in argument is preceded +(** This function makes sure that the function given in argument is preceded by a command aborting all proofs if necessary. It is used in pcoq. *) val abort_refine : ('a -> unit) -> 'a -> unit;; @@ -55,3 +52,17 @@ val abort_refine : ('a -> unit) -> 'a -> unit;; val interp : Vernacexpr.vernac_expr -> unit val vernac_reset_name : identifier Util.located -> unit + +val vernac_backtrack : int -> int -> int -> unit + +(* Print subgoals when the verbose flag is on. Meant to be used inside + vernac commands from plugins. *) +val print_subgoals : unit -> unit + +(** Prepare a "match" template for a given inductive type. + For each branch of the match, we list the constructor name + followed by enough pattern variables. + [Not_found] is raised if the given string isn't the qualid of + a known inductive type. *) + +val make_cases : string -> string list list diff --git a/toplevel/vernacexpr.ml b/toplevel/vernacexpr.ml index 31c46a54..850bc111 100644 --- a/toplevel/vernacexpr.ml +++ b/toplevel/vernacexpr.ml @@ -1,13 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(* "Prop" - | RProp Pos -> "Set" - | RType _ -> "Type" +let whelp_of_glob_sort = function + | GProp Null -> "Prop" + | GProp Pos -> "Set" + | GType _ -> "Type" let uri_int n = Buffer.add_string b (string_of_int n) @@ -130,9 +129,9 @@ let uri_params f = function let get_discharged_hyp_names sp = List.map basename (get_discharged_hyps sp) let section_parameters = function - | RRef (_,(ConstructRef ((induri,_),_) | IndRef (induri,_))) -> + | GRef (_,(ConstructRef ((induri,_),_) | IndRef (induri,_))) -> get_discharged_hyp_names (path_of_global (IndRef(induri,0))) - | RRef (_,(ConstRef cst as ref)) -> + | GRef (_,(ConstRef cst as ref)) -> get_discharged_hyp_names (path_of_global ref) | _ -> [] @@ -144,33 +143,33 @@ let merge vl al = let rec uri_of_constr c = match c with - | RVar (_,id) -> url_id id - | RRef (_,ref) -> uri_of_global ref - | RHole _ | REvar _ -> url_string "?" - | RSort (_,s) -> url_string (whelp_of_rawsort s) + | GVar (_,id) -> url_id id + | GRef (_,ref) -> uri_of_global ref + | GHole _ | GEvar _ -> url_string "?" + | GSort (_,s) -> url_string (whelp_of_glob_sort s) | _ -> url_paren (fun () -> match c with - | RApp (_,f,args) -> + | GApp (_,f,args) -> let inst,rest = merge (section_parameters f) args in uri_of_constr f; url_char ' '; uri_params uri_of_constr inst; url_list_with_sep " " uri_of_constr rest - | RLambda (_,na,k,ty,c) -> + | GLambda (_,na,k,ty,c) -> url_string "\\lambda "; url_of_name na; url_string ":"; uri_of_constr ty; url_string "."; uri_of_constr c - | RProd (_,Anonymous,k,ty,c) -> + | GProd (_,Anonymous,k,ty,c) -> uri_of_constr ty; url_string "\\to "; uri_of_constr c - | RProd (_,Name id,k,ty,c) -> + | GProd (_,Name id,k,ty,c) -> url_string "\\forall "; url_id id; url_string ":"; uri_of_constr ty; url_string "."; uri_of_constr c - | RLetIn (_,na,b,c) -> + | GLetIn (_,na,b,c) -> url_string "let "; url_of_name na; url_string "\\def "; uri_of_constr b; url_string " in "; uri_of_constr c - | RCast (_,c, CastConv (_,t)) -> + | GCast (_,c, CastConv (_,t)) -> uri_of_constr c; url_string ":"; uri_of_constr t - | RRec _ | RIf _ | RLetTuple _ | RCases _ -> + | GRec _ | GIf _ | GLetTuple _ | GCases _ -> error "Whelp does not support pattern-matching and (co-)fixpoint." - | RVar _ | RRef _ | RHole _ | REvar _ | RSort _ | RCast (_,_, CastCoerce) -> + | GVar _ | GRef _ | GHole _ | GEvar _ | GSort _ | GCast (_,_, CastCoerce) -> anomaly "Written w/o parenthesis" - | RPatVar _ | RDynamic _ -> + | GPatVar _ -> anomaly "Found constructors not supported in constr") () let make_string f x = Buffer.reset b; f x; Buffer.contents b @@ -196,8 +195,9 @@ let whelp_elim ind = send_whelp "elim" (make_string uri_of_global (IndRef ind)) let on_goal f = - let gls = nth_goal_of_pftreestate 1 (get_pftreestate ()) in - f (it_mkNamedProd_or_LetIn (pf_concl gls) (pf_hyps gls)) + let { Evd.it=goals ; sigma=sigma } = Proof.V82.subgoals (get_pftreestate ()) in + let gls = { Evd.it=List.hd goals ; sigma = sigma } in + f (Termops.it_mkNamedProd_or_LetIn (pf_concl gls) (pf_hyps gls)) type whelp_request = | Locate of string diff --git a/toplevel/whelp.mli b/toplevel/whelp.mli index 75e9ad49..b0fb5491 100644 --- a/toplevel/whelp.mli +++ b/toplevel/whelp.mli @@ -1,14 +1,12 @@ (************************************************************************) (* v * The Coq Proof Assistant / The Coq Development Team *) -(*